summaryrefslogtreecommitdiff
path: root/lisp/vc
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/vc')
-rw-r--r--lisp/vc/add-log.el89
-rw-r--r--lisp/vc/diff-mode.el245
-rw-r--r--lisp/vc/ediff-diff.el6
-rw-r--r--lisp/vc/ediff-init.el2
-rw-r--r--lisp/vc/ediff-mult.el6
-rw-r--r--lisp/vc/ediff-ptch.el32
-rw-r--r--lisp/vc/ediff-util.el47
-rw-r--r--lisp/vc/ediff.el36
-rw-r--r--lisp/vc/emerge.el37
-rw-r--r--lisp/vc/log-view.el9
-rw-r--r--lisp/vc/pcvs-info.el7
-rw-r--r--lisp/vc/smerge-mode.el179
-rw-r--r--lisp/vc/vc-bzr.el12
-rw-r--r--lisp/vc/vc-cvs.el6
-rw-r--r--lisp/vc/vc-dispatcher.el3
-rw-r--r--lisp/vc/vc-git.el37
-rw-r--r--lisp/vc/vc-hg.el621
-rw-r--r--lisp/vc/vc-hooks.el39
-rw-r--r--lisp/vc/vc-rcs.el11
-rw-r--r--lisp/vc/vc-src.el2
20 files changed, 1103 insertions, 323 deletions
diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el
index fb78086e72e..52be9c5a2be 100644
--- a/lisp/vc/add-log.el
+++ b/lisp/vc/add-log.el
@@ -171,56 +171,55 @@ Note: The search is conducted only within 10%, at the beginning of the file."
:type '(repeat regexp)
:group 'change-log)
+(defcustom change-log-directory-files '(".bzr" ".git" ".hg" ".svn")
+ "List of files that cause `find-change-log' to stop in containing directory.
+This applies if no pre-existing ChangeLog is found. If nil, then in such
+a case simply use the directory containing the changed file."
+ :version "26.1"
+ :type '(repeat file)
+ :group 'change-log)
+
(defface change-log-date
'((t (:inherit font-lock-string-face)))
"Face used to highlight dates in date lines."
:version "21.1"
:group 'change-log)
-(define-obsolete-face-alias 'change-log-date-face 'change-log-date "22.1")
(defface change-log-name
'((t (:inherit font-lock-constant-face)))
"Face for highlighting author names."
:version "21.1"
:group 'change-log)
-(define-obsolete-face-alias 'change-log-name-face 'change-log-name "22.1")
(defface change-log-email
'((t (:inherit font-lock-variable-name-face)))
"Face for highlighting author email addresses."
:version "21.1"
:group 'change-log)
-(define-obsolete-face-alias 'change-log-email-face 'change-log-email "22.1")
(defface change-log-file
'((t (:inherit font-lock-function-name-face)))
"Face for highlighting file names."
:version "21.1"
:group 'change-log)
-(define-obsolete-face-alias 'change-log-file-face 'change-log-file "22.1")
(defface change-log-list
'((t (:inherit font-lock-keyword-face)))
"Face for highlighting parenthesized lists of functions or variables."
:version "21.1"
:group 'change-log)
-(define-obsolete-face-alias 'change-log-list-face 'change-log-list "22.1")
(defface change-log-conditionals
'((t (:inherit font-lock-variable-name-face)))
"Face for highlighting conditionals of the form `[...]'."
:version "21.1"
:group 'change-log)
-(define-obsolete-face-alias 'change-log-conditionals-face
- 'change-log-conditionals "22.1")
(defface change-log-function
'((t (:inherit font-lock-variable-name-face)))
"Face for highlighting items of the form `<....>'."
:version "21.1"
:group 'change-log)
-(define-obsolete-face-alias 'change-log-function-face
- 'change-log-function "22.1")
(defface change-log-acknowledgment
'((t (:inherit font-lock-comment-face)))
@@ -229,8 +228,6 @@ Note: The search is conducted only within 10%, at the beginning of the file."
:group 'change-log)
(define-obsolete-face-alias 'change-log-acknowledgement
'change-log-acknowledgment "24.3")
-(define-obsolete-face-alias 'change-log-acknowledgement-face
- 'change-log-acknowledgment "22.1")
(defconst change-log-file-names-re "^\\( +\\|\t\\)\\* \\([^ ,:([\n]+\\)")
(defconst change-log-start-entry-re "^\\sw.........[0-9:+ ]*")
@@ -582,25 +579,14 @@ If a string, interpret as the ZONE argument of `format-time-string'.")
(lambda (x) (or (booleanp x) (stringp x))))
(defun add-log-iso8601-time-zone (&optional time zone)
- (let* ((utc-offset (or (car (current-time-zone time zone)) 0))
- (sign (if (< utc-offset 0) ?- ?+))
- (sec (abs utc-offset))
- (ss (% sec 60))
- (min (/ sec 60))
- (mm (% min 60))
- (hh (/ min 60)))
- (format (cond ((not (zerop ss)) "%c%02d:%02d:%02d")
- ((not (zerop mm)) "%c%02d:%02d")
- (t "%c%02d"))
- sign hh mm ss)))
+ (declare (obsolete nil "26.1"))
+ (format-time-string "%:::z" time zone))
(defvar add-log-iso8601-with-time-zone nil)
(defun add-log-iso8601-time-string (&optional time zone)
- (let ((date (format-time-string "%Y-%m-%d" time zone)))
- (if add-log-iso8601-with-time-zone
- (concat date " " (add-log-iso8601-time-zone time zone))
- date)))
+ (format-time-string
+ (if add-log-iso8601-with-time-zone "%Y-%m-%d %:::z" "%Y-%m-%d") time zone))
(defun change-log-name ()
"Return (system-dependent) default name for a change log file."
@@ -690,7 +676,11 @@ If `change-log-default-name' is nil, behave as though it were \"ChangeLog\"
If `change-log-default-name' contains a leading directory component, then
simply find it in the current directory. Otherwise, search in the current
-directory and its successive parents for a file so named.
+directory and its successive parents for a file so named. Stop at the first
+such file that exists (or has a buffer visiting it), or the first directory
+that contains any of `change-log-directory-files'. If no match is found,
+use the current directory. To override the choice of this function,
+simply create an empty ChangeLog file first by hand in the desired place.
Once a file is found, `change-log-default-name' is set locally in the
current buffer to the complete file name.
@@ -723,24 +713,27 @@ Optional arg BUFFER-FILE overrides `buffer-file-name'."
;; for several related directories.
(setq file-name (file-chase-links file-name))
(setq file-name (expand-file-name file-name))
- ;; Move up in the dir hierarchy till we find a change log file.
- (let ((file1 file-name)
- parent-dir)
- (while (and (not (or (get-file-buffer file1) (file-exists-p file1)))
- (progn (setq parent-dir
- (file-name-directory
- (directory-file-name
- (file-name-directory file1))))
- ;; Give up if we are already at the root dir.
- (not (string= (file-name-directory file1)
- parent-dir))))
- ;; Move up to the parent dir and try again.
- (setq file1 (expand-file-name
- (file-name-nondirectory (change-log-name))
- parent-dir)))
- ;; If we found a change log in a parent, use that.
- (if (or (get-file-buffer file1) (file-exists-p file1))
- (setq file-name file1)))))
+ (let* ((cbase (file-name-nondirectory (change-log-name)))
+ (root
+ (locate-dominating-file
+ file-name
+ (lambda (dir)
+ (or
+ (let ((clog (expand-file-name cbase dir)))
+ (or (get-file-buffer clog) (file-exists-p clog)))
+ ;; Stop at VCS root?
+ (and change-log-directory-files
+ (let ((files change-log-directory-files)
+ found)
+ (while
+ (and
+ (not
+ (setq found
+ (file-exists-p
+ (expand-file-name (car files) dir))))
+ (setq files (cdr files))))
+ found)))))))
+ (if root (setq file-name (expand-file-name cbase root))))))
;; Make a local variable in this buffer so we needn't search again.
(set (make-local-variable 'change-log-default-name) file-name))
file-name)
@@ -895,8 +888,10 @@ non-nil, otherwise in local time."
"\\(\\s \\|[(),:]\\)")
bound t)))
;; Add to the existing item for the same file.
- (re-search-forward "^\\s *$\\|^\\s \\*")
- (goto-char (match-beginning 0))
+ (if (re-search-forward "^\\s *$\\|^\\s \\*" nil t)
+ (goto-char (match-beginning 0))
+ (goto-char (point-max))
+ (insert "\n"))
;; Delete excess empty lines; make just 2.
(while (and (not (eobp)) (looking-at "^\\s *$"))
(delete-region (point) (line-beginning-position 2)))
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index 1c7f5cb20e3..9dfcd944bbd 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -243,8 +243,6 @@ well."
(t :weight bold))
"`diff-mode' face inherited by hunk and index header faces."
:group 'diff-mode)
-(define-obsolete-face-alias 'diff-header-face 'diff-header "22.1")
-(defvar diff-header-face 'diff-header)
(defface diff-file-header
'((((class color) (min-colors 88) (background light))
@@ -256,22 +254,16 @@ well."
(t :weight bold)) ; :height 1.3
"`diff-mode' face used to highlight file header lines."
:group 'diff-mode)
-(define-obsolete-face-alias 'diff-file-header-face 'diff-file-header "22.1")
-(defvar diff-file-header-face 'diff-file-header)
(defface diff-index
'((t :inherit diff-file-header))
"`diff-mode' face used to highlight index header lines."
:group 'diff-mode)
-(define-obsolete-face-alias 'diff-index-face 'diff-index "22.1")
-(defvar diff-index-face 'diff-index)
(defface diff-hunk-header
'((t :inherit diff-header))
"`diff-mode' face used to highlight hunk header lines."
:group 'diff-mode)
-(define-obsolete-face-alias 'diff-hunk-header-face 'diff-hunk-header "22.1")
-(defvar diff-hunk-header-face 'diff-hunk-header)
(defface diff-removed
'((default
@@ -284,8 +276,6 @@ well."
:foreground "red"))
"`diff-mode' face used to highlight removed lines."
:group 'diff-mode)
-(define-obsolete-face-alias 'diff-removed-face 'diff-removed "22.1")
-(defvar diff-removed-face 'diff-removed)
(defface diff-added
'((default
@@ -298,16 +288,12 @@ well."
:foreground "green"))
"`diff-mode' face used to highlight added lines."
:group 'diff-mode)
-(define-obsolete-face-alias 'diff-added-face 'diff-added "22.1")
-(defvar diff-added-face 'diff-added)
(defface diff-changed
'((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)
(defface diff-indicator-removed
'((t :inherit diff-removed))
@@ -334,8 +320,6 @@ well."
'((t :inherit diff-header))
"`diff-mode' face used to highlight function names produced by \"diff -p\"."
:group 'diff-mode)
-(define-obsolete-face-alias 'diff-function-face 'diff-function "22.1")
-(defvar diff-function-face 'diff-function)
(defface diff-context
'((((class color grayscale) (min-colors 88) (background light))
@@ -345,15 +329,11 @@ well."
"`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)
(defface diff-nonexistent
'((t :inherit diff-file-header))
"`diff-mode' face used to highlight nonexistent files in recursive diffs."
:group 'diff-mode)
-(define-obsolete-face-alias 'diff-nonexistent-face 'diff-nonexistent "22.1")
-(defvar diff-nonexistent-face 'diff-nonexistent)
(defconst diff-yank-handler '(diff-yank-function))
(defun diff-yank-function (text)
@@ -382,57 +362,57 @@ well."
(defconst diff-context-mid-hunk-header-re
"--- \\([0-9]+\\)\\(?:,\\([0-9]+\\)\\)? ----$")
-(defvar diff-use-changed-face (and (face-differs-from-default-p diff-changed-face)
- (not (face-equal diff-changed-face diff-added-face))
- (not (face-equal diff-changed-face diff-removed-face)))
+(defvar diff-use-changed-face (and (face-differs-from-default-p 'diff-changed)
+ (not (face-equal 'diff-changed 'diff-added))
+ (not (face-equal 'diff-changed 'diff-removed)))
"If non-nil, use the face `diff-changed' for changed lines in context diffs.
Otherwise, use the face `diff-removed' for removed lines,
and the face `diff-added' for added lines.")
(defvar diff-font-lock-keywords
`((,(concat "\\(" diff-hunk-header-re-unified "\\)\\(.*\\)$")
- (1 diff-hunk-header-face) (6 diff-function-face))
+ (1 'diff-hunk-header) (6 'diff-function))
("^\\(\\*\\{15\\}\\)\\(.*\\)$" ;context
- (1 diff-hunk-header-face) (2 diff-function-face))
- ("^\\*\\*\\* .+ \\*\\*\\*\\*". diff-hunk-header-face) ;context
- (,diff-context-mid-hunk-header-re . diff-hunk-header-face) ;context
- ("^[0-9,]+[acd][0-9,]+$" . diff-hunk-header-face) ;normal
- ("^---$" . diff-hunk-header-face) ;normal
+ (1 'diff-hunk-header) (2 'diff-function))
+ ("^\\*\\*\\* .+ \\*\\*\\*\\*". 'diff-hunk-header) ;context
+ (,diff-context-mid-hunk-header-re . 'diff-hunk-header) ;context
+ ("^[0-9,]+[acd][0-9,]+$" . 'diff-hunk-header) ;normal
+ ("^---$" . 'diff-hunk-header) ;normal
;; For file headers, accept files with spaces, but be careful to rule
;; out false-positives when matching hunk headers.
("^\\(---\\|\\+\\+\\+\\|\\*\\*\\*\\) \\([^\t\n]+?\\)\\(?:\t.*\\| \\(\\*\\*\\*\\*\\|----\\)\\)?\n"
- (0 diff-header-face)
- (2 (if (not (match-end 3)) diff-file-header-face) prepend))
+ (0 'diff-header)
+ (2 (if (not (match-end 3)) 'diff-file-header) prepend))
("^\\([-<]\\)\\(.*\n\\)"
- (1 diff-indicator-removed-face) (2 diff-removed-face))
+ (1 diff-indicator-removed-face) (2 'diff-removed))
("^\\([+>]\\)\\(.*\n\\)"
- (1 diff-indicator-added-face) (2 diff-added-face))
+ (1 diff-indicator-added-face) (2 'diff-added))
("^\\(!\\)\\(.*\n\\)"
(1 (if diff-use-changed-face
diff-indicator-changed-face
;; Otherwise, search for `diff-context-mid-hunk-header-re' and
- ;; if the line of context diff is above, use `diff-removed-face';
- ;; if below, use `diff-added-face'.
+ ;; if the line of context diff is above, use `diff-removed';
+ ;; if below, use `diff-added'.
(save-match-data
(let ((limit (save-excursion (diff-beginning-of-hunk))))
(if (save-excursion (re-search-backward diff-context-mid-hunk-header-re limit t))
diff-indicator-added-face
diff-indicator-removed-face)))))
(2 (if diff-use-changed-face
- diff-changed-face
+ 'diff-changed
;; Otherwise, use the same method as above.
(save-match-data
(let ((limit (save-excursion (diff-beginning-of-hunk))))
(if (save-excursion (re-search-backward diff-context-mid-hunk-header-re limit t))
- diff-added-face
- diff-removed-face))))))
+ 'diff-added
+ 'diff-removed))))))
("^\\(?:Index\\|revno\\): \\(.+\\).*\n"
- (0 diff-header-face) (1 diff-index-face prepend))
- ("^Only in .*\n" . diff-nonexistent-face)
+ (0 'diff-header) (1 'diff-index prepend))
+ ("^Only in .*\n" . 'diff-nonexistent)
("^\\(#\\)\\(.*\\)"
(1 font-lock-comment-delimiter-face)
(2 font-lock-comment-face))
- ("^[^-=+*!<>#].*\n" (0 diff-context-face))))
+ ("^[^-=+*!<>#].*\n" (0 'diff-context))))
(defconst diff-font-lock-defaults
'(diff-font-lock-keywords t nil nil nil (font-lock-multiline . nil)))
@@ -571,26 +551,124 @@ next hunk if TRY-HARDER is non-nil; otherwise signal an error."
;; Define diff-{hunk,file}-{prev,next}
(easy-mmode-define-navigation
- diff-hunk diff-hunk-header-re "hunk" diff-end-of-hunk diff-restrict-view
- (when diff-auto-refine-mode
- (unless (prog1 diff--auto-refine-data
- (setq diff--auto-refine-data
- (cons (current-buffer) (point-marker))))
- (run-at-time 0.0 nil
- (lambda ()
- (when diff--auto-refine-data
- (let ((buffer (car diff--auto-refine-data))
- (point (cdr diff--auto-refine-data)))
- (setq diff--auto-refine-data nil)
- (with-local-quit
- (when (buffer-live-p buffer)
- (with-current-buffer buffer
- (save-excursion
- (goto-char point)
- (diff-refine-hunk))))))))))))
+ diff--internal-hunk diff-hunk-header-re "hunk" diff-end-of-hunk diff-restrict-view)
(easy-mmode-define-navigation
- diff-file diff-file-header-re "file" diff-end-of-file)
+ diff--internal-file diff-file-header-re "file" diff-end-of-file)
+
+(defun diff--wrap-navigation (skip-hunk-start
+ what orig
+ header-re goto-start-func count)
+ "Wrap diff-{hunk,file}-{next,prev} for more intuitive behavior.
+Override the default diff-{hunk,file}-{next,prev} implementation
+by skipping any lines that are associated with this hunk/file but
+precede the hunk-start marker. For instance, a diff file could
+contain
+
+diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
+index 923de9a..6b1c24f 100644
+--- a/lisp/vc/diff-mode.el
++++ b/lisp/vc/diff-mode.el
+@@ -590,6 +590,22 @@
+.......
+
+If a point is on 'index', then the point is considered to be in
+this first hunk. Move the point to the @@... marker before
+executing the default diff-hunk-next/prev implementation to move
+to the NEXT marker."
+ (if (not skip-hunk-start)
+ (funcall orig count)
+
+ (let ((start (point)))
+ (funcall goto-start-func)
+
+ ;; Trap the error.
+ (condition-case nil
+ (funcall orig count)
+ (error nil))
+
+ (when (not (looking-at header-re))
+ (goto-char start)
+ (user-error (format "No %s" what)))
+
+ ;; We successfully moved to the next/prev hunk/file. Apply the
+ ;; auto-refinement if needed
+ (when diff-auto-refine-mode
+ (unless (prog1 diff--auto-refine-data
+ (setq diff--auto-refine-data
+ (cons (current-buffer) (point-marker))))
+ (run-at-time 0.0 nil
+ (lambda ()
+ (when diff--auto-refine-data
+ (let ((buffer (car diff--auto-refine-data))
+ (point (cdr diff--auto-refine-data)))
+ (setq diff--auto-refine-data nil)
+ (with-local-quit
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (save-excursion
+ (goto-char point)
+ (diff-refine-hunk))))))))))))))
+
+;; These functions all take a skip-hunk-start argument which controls
+;; whether we skip pre-hunk-start text or not. In interactive uses we
+;; always want to do this, but the simple behavior is still necessary
+;; to, for example, avoid an infinite loop:
+;;
+;; diff-hunk-next calls
+;; diff--wrap-navigation calls
+;; diff-bounds-of-hunk calls
+;; diff-beginning-of-hunk calls
+;; diff-hunk-next
+;;
+;; Here the outer diff-hunk-next has skip-hunk-start set to t, but the
+;; inner one does not, which breaks the loop.
+(defun diff-hunk-prev (&optional count skip-hunk-start)
+ "Go to the previous COUNT'th hunk."
+ (interactive (list (prefix-numeric-value current-prefix-arg) t))
+ (diff--wrap-navigation
+ skip-hunk-start
+ "prev hunk"
+ 'diff--internal-hunk-prev
+ diff-hunk-header-re
+ (lambda () (goto-char (car (diff-bounds-of-hunk))))
+ count))
+
+(defun diff-hunk-next (&optional count skip-hunk-start)
+ "Go to the next COUNT'th hunk."
+ (interactive (list (prefix-numeric-value current-prefix-arg) t))
+ (diff--wrap-navigation
+ skip-hunk-start
+ "next hunk"
+ 'diff--internal-hunk-next
+ diff-hunk-header-re
+ (lambda () (goto-char (car (diff-bounds-of-hunk))))
+ count))
+
+(defun diff-file-prev (&optional count skip-hunk-start)
+ "Go to the previous COUNT'th file."
+ (interactive (list (prefix-numeric-value current-prefix-arg) t))
+ (diff--wrap-navigation
+ skip-hunk-start
+ "prev file"
+ 'diff--internal-file-prev
+ diff-file-header-re
+ (lambda () (goto-char (car (diff-bounds-of-file))) (diff--internal-hunk-next))
+ count))
+
+(defun diff-file-next (&optional count skip-hunk-start)
+ "Go to the next COUNT'th file."
+ (interactive (list (prefix-numeric-value current-prefix-arg) t))
+ (diff--wrap-navigation
+ skip-hunk-start
+ "next file"
+ 'diff--internal-file-next
+ diff-file-header-re
+ (lambda () (goto-char (car (diff-bounds-of-file))) (diff--internal-hunk-next))
+ count))
+
+
+
(defun diff-bounds-of-hunk ()
"Return the bounds of the diff hunk at point.
@@ -601,12 +679,13 @@ point is in a file header, return the bounds of the next hunk."
(let ((pos (point))
(beg (diff-beginning-of-hunk t))
(end (diff-end-of-hunk)))
- (cond ((>= end pos)
+ (cond ((> end pos)
(list beg end))
;; If this hunk ends above POS, consider the next hunk.
((re-search-forward diff-hunk-header-re nil t)
(list (match-beginning 0) (diff-end-of-hunk)))
- (t (error "No hunk found"))))))
+ ;; There's no next hunk, so just take the one we have.
+ (t (list beg end))))))
(defun diff-bounds-of-file ()
"Return the bounds of the file segment at point.
@@ -692,7 +771,7 @@ data such as \"Index: ...\" and such."
(setq prevfile nextfile))
(if (and previndex (numberp prevfile) (< previndex prevfile))
(setq prevfile previndex))
- (if (and (numberp prevfile) (<= prevfile start))
+ (if (numberp prevfile)
(progn
(goto-char prevfile)
;; Now skip backward over the leading junk we may have before the
@@ -820,7 +899,7 @@ If the OLD prefix arg is passed, tell the file NAME of the old file."
(error (point-min)))))
(header-files
;; handle filenames with spaces;
- ;; cf. diff-font-lock-keywords / diff-file-header-face
+ ;; cf. diff-font-lock-keywords / diff-file-header
(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)))
@@ -1685,8 +1764,9 @@ SRC and DST are the two variants of text as returned by `diff-hunk-text'.
SWITCHED is non-nil if the patch is already applied.
NOPROMPT, if non-nil, means not to prompt the user."
(save-excursion
- (let* ((other (diff-xor other-file diff-jump-to-old-file))
- (char-offset (- (point) (diff-beginning-of-hunk t)))
+ (let* ((hunk-bounds (diff-bounds-of-hunk))
+ (other (diff-xor other-file diff-jump-to-old-file))
+ (char-offset (- (point) (goto-char (car hunk-bounds))))
;; Check that the hunk is well-formed. Otherwise diff-mode and
;; the user may disagree on what constitutes the hunk
;; (e.g. because an empty line truncates the hunk mid-course),
@@ -1695,7 +1775,7 @@ NOPROMPT, if non-nil, means not to prompt the user."
;; Suppress check when NOPROMPT is non-nil (Bug#3033).
(_ (unless noprompt (diff-sanity-check-hunk)))
(hunk (buffer-substring
- (point) (save-excursion (diff-end-of-hunk) (point))))
+ (point) (cadr hunk-bounds)))
(old (diff-hunk-text hunk reverse char-offset))
(new (diff-hunk-text hunk (not reverse) char-offset))
;; Find the location specification.
@@ -1803,8 +1883,15 @@ With a prefix argument, REVERSE the hunk."
;; Display BUF in a window
(set-window-point (display-buffer buf) (+ (car pos) (cdr new)))
(diff-hunk-status-msg line-offset (diff-xor switched reverse) nil)
+
+ ;; Advance to the next hunk with skip-hunk-start set to t
+ ;; because we want the behavior of moving to the next logical
+ ;; hunk, not the original behavior where were would sometimes
+ ;; stay on the current hunk. This is the behavior we get when
+ ;; navigating through hunks interactively, and we want it when
+ ;; applying hunks too (see http://debbugs.gnu.org/17544).
(when diff-advance-after-apply-hunk
- (diff-hunk-next))))))
+ (diff-hunk-next nil t))))))
(defun diff-test-hunk (&optional reverse)
@@ -1885,14 +1972,15 @@ For use in `add-log-current-defun-function'."
(defun diff-ignore-whitespace-hunk ()
"Re-diff the current hunk, ignoring whitespace differences."
(interactive)
- (let* ((char-offset (- (point) (diff-beginning-of-hunk t)))
+ (let* ((hunk-bounds (diff-bounds-of-hunk))
+ (char-offset (- (point) (goto-char (car hunk-bounds))))
(opts (pcase (char-after) (?@ "-bu") (?* "-bc") (_ "-b")))
(line-nb (and (or (looking-at "[^0-9]+\\([0-9]+\\)")
(error "Can't find line number"))
(string-to-number (match-string 1))))
(inhibit-read-only t)
(hunk (delete-and-extract-region
- (point) (save-excursion (diff-end-of-hunk) (point))))
+ (point) (cadr hunk-bounds)))
(lead (make-string (1- line-nb) ?\n)) ;Line nums start at 1.
(file1 (make-temp-file "diff1"))
(file2 (make-temp-file "diff2"))
@@ -1936,11 +2024,10 @@ For use in `add-log-current-defun-function'."
(t :inverse-video t))
"Face used for char-based changes shown by `diff-refine-hunk'."
:group 'diff-mode)
-(define-obsolete-face-alias 'diff-refine-change 'diff-refine-changed "24.5")
(defface diff-refine-removed
'((default
- :inherit diff-refine-change)
+ :inherit diff-refine-changed)
(((class color) (min-colors 88) (background light))
:background "#ffbbbb")
(((class color) (min-colors 88) (background dark))
@@ -1951,7 +2038,7 @@ For use in `add-log-current-defun-function'."
(defface diff-refine-added
'((default
- :inherit diff-refine-change)
+ :inherit diff-refine-changed)
(((class color) (min-colors 88) (background light))
:background "#aaffaa")
(((class color) (min-colors 88) (background dark))
@@ -1980,16 +2067,14 @@ For use in `add-log-current-defun-function'."
(interactive)
(require 'smerge-mode)
(save-excursion
- (diff-beginning-of-hunk t)
- (let* ((start (point))
- (style (diff-hunk-style)) ;Skips the hunk header as well.
+ (let* ((hunk-bounds (diff-bounds-of-hunk))
+ (style (progn (goto-char (car hunk-bounds))
+ (diff-hunk-style))) ;Skips the hunk header as well.
(beg (point))
- (props-c '((diff-mode . fine) (face diff-refine-change)))
+ (end (cadr hunk-bounds))
+ (props-c '((diff-mode . fine) (face diff-refine-changed)))
(props-r '((diff-mode . fine) (face diff-refine-removed)))
- (props-a '((diff-mode . fine) (face diff-refine-added)))
- ;; Be careful to go back to `start' so diff-end-of-hunk gets
- ;; to read the hunk header's line info.
- (end (progn (goto-char start) (diff-end-of-hunk) (point))))
+ (props-a '((diff-mode . fine) (face diff-refine-added))))
(remove-overlays beg end 'diff-mode 'fine)
diff --git a/lisp/vc/ediff-diff.el b/lisp/vc/ediff-diff.el
index b1a89b71dc3..37f22340d71 100644
--- a/lisp/vc/ediff-diff.el
+++ b/lisp/vc/ediff-diff.el
@@ -1347,10 +1347,8 @@ arguments to `skip-chars-forward'."
;; located on the same remote host.
(apply 'process-file ediff-cmp-program nil nil nil
(append ediff-cmp-options
- (list (or (file-remote-p f1 'localname)
- (expand-file-name f1))
- (or (file-remote-p f2 'localname)
- (expand-file-name f2)))))
+ (list (expand-file-name (file-local-name f1))
+ (expand-file-name (file-local-name f2)))))
))
(and (numberp res) (eq res 0)))
diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el
index 4fa080c46b7..95568b29c7c 100644
--- a/lisp/vc/ediff-init.el
+++ b/lisp/vc/ediff-init.el
@@ -318,7 +318,7 @@ It needs to be killed when we quit the session.")
(defsubst ediff-patch-metajob (&optional metajob)
(memq (or metajob ediff-metajob-name)
'(ediff-multifile-patch)))
-;; metajob involving only one group of files, such as multipatch or directory
+;; metajob involving only one group of files, such as multi-patch or directory
;; revision
(defsubst ediff-one-filegroup-metajob (&optional metajob)
(or (ediff-revision-metajob metajob)
diff --git a/lisp/vc/ediff-mult.el b/lisp/vc/ediff-mult.el
index 82be2a8d47c..41015f704df 100644
--- a/lisp/vc/ediff-mult.el
+++ b/lisp/vc/ediff-mult.el
@@ -1846,9 +1846,9 @@ all marked sessions must be active."
(read-string
(if (stringp default-regexp)
(format
- "Filter through regular expression (default %s): "
+ "Filter filenames through regular expression (default %s): "
default-regexp)
- "Filter through regular expression: ")
+ "Filter filenames through regular expression: ")
nil
'ediff-filtering-regexp-history
(eval ediff-default-filtering-regexp)))
@@ -1872,7 +1872,7 @@ all marked sessions must be active."
(file-directory-p file1))
(if (ediff-buffer-live-p session-buf)
(ediff-show-meta-buffer session-buf)
- (setq regexp (read-string "Filter through regular expression: "
+ (setq regexp (read-string "Filter filenames through regular expression: "
nil 'ediff-filtering-regexp-history))
(ediff-directory-revisions-internal
file1 regexp
diff --git a/lisp/vc/ediff-ptch.el b/lisp/vc/ediff-ptch.el
index 749ccd2516c..9d2ec51b596 100644
--- a/lisp/vc/ediff-ptch.el
+++ b/lisp/vc/ediff-ptch.el
@@ -120,11 +120,12 @@ patch. So, don't change these variables, unless the default doesn't work."
;; This context diff does not recognize spaces inside files, but removing ' '
;; from [^ \t] breaks normal patches for some reason
(defcustom ediff-context-diff-label-regexp
- (concat "\\(" ; context diff 2-liner
- "^\\*\\*\\* +\\([^ \t]+\\)[^*]+[\t ]*\n--- +\\([^ \t]+\\)"
- "\\|" ; unified format diff 2-liner
- "^--- +\\([^ \t]+\\).*\n\\+\\+\\+ +\\([^ \t]+\\)"
- "\\)")
+ (let ((stuff "\\([^ \t\n]+\\)"))
+ (concat "\\(" ; context diff 2-liner
+ "^\\*\\*\\* +" stuff "[^*]+[\t ]*\n--- +" stuff
+ "\\|" ; unified format diff 2-liner
+ "^--- +" stuff ".*\n\\+\\+\\+ +" stuff
+ "\\)"))
"Regexp matching filename 2-liners at the start of each context diff.
You probably don't want to change that, unless you are using an obscure patch
program."
@@ -268,6 +269,7 @@ program."
;; directory part of filename
(file-name-as-directory filename)
(file-name-directory filename)))
+ (multi-patch-p (cdr ediff-patch-map))
;; In case 2 files are possible patch targets, the user will be offered
;; to choose file1 or file2. In a multifile patch, if the user chooses
;; 1 or 2, this choice is preserved to decide future alternatives.
@@ -429,6 +431,16 @@ Please advise:
(f2-exists (setcar session-file-object file2))
(f1-exists (setcar session-file-object file1))
(t
+ ;; TODO: Often for multi-patches the file doesn't exist
+ ;; because the directory part is wrong; for instance, if the
+ ;; patch needs to be applied into
+ ;; (expand-file-name "lisp/vc/ediff-ptch.el" source-directory)
+ ;; and default-directory is
+ ;; (expand-file-name "lisp" source-directory)
+ ;; then Ediff assumes the wrong file:
+ ;; (expand-file-name "lisp/ediff-ptch.el" source-directory).
+ ;; We might identify these common failures and suggest
+ ;; in the prompt the possible corrected file. --Tino
(with-output-to-temp-buffer ediff-msg-buffer
(ediff-with-current-buffer standard-output
(fundamental-mode))
@@ -436,13 +448,15 @@ Please advise:
(if (string= file1 file2)
(princ (format "
%s
-is assumed to be the target for this patch. However, this file does not exist."
- file1))
+is assumed to be %s target for this %spatch. However, this file does not exist."
+ file1
+ (if multi-patch-p "one" "the")
+ (if multi-patch-p "multi-" "")))
(princ (format "
%s
%s
-are two possible targets for this patch. However, these files do not exist."
- file1 file2)))
+are two possible targets for this %spatch. However, these files do not exist."
+ file1 file2 (if multi-patch-p "multi-" ""))))
(princ "
\nPlease enter an alternative patch target ...\n"))
(let ((directory t)
diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el
index 26c284165b1..f81397950dd 100644
--- a/lisp/vc/ediff-util.el
+++ b/lisp/vc/ediff-util.el
@@ -1,4 +1,4 @@
-;;; ediff-util.el --- the core commands and utilities of ediff
+;;; ediff-util.el --- the core commands and utilities of ediff -*- lexical-binding:t -*-
;; Copyright (C) 1994-2017 Free Software Foundation, Inc.
@@ -517,7 +517,7 @@ to invocation.")
(select-window ediff-control-window)
(ediff-visible-region)
- (run-hooks 'startup-hooks)
+ (mapc #'funcall startup-hooks)
(ediff-arrange-autosave-in-merge-jobs merge-buffer-file)
(ediff-refresh-mode-lines)
@@ -1141,11 +1141,8 @@ of the current buffer."
))
(defun ediff-file-compressed-p (file)
- (condition-case nil
- (require 'jka-compr)
- (error))
- (if (featurep 'jka-compr)
- (string-match (jka-compr-build-file-regexp) file)))
+ (require 'jka-compr)
+ (string-match (jka-compr-build-file-regexp) file))
(defun ediff-swap-buffers ()
@@ -1293,7 +1290,8 @@ which see."
(cond ((eq ediff-window-setup-function 'ediff-setup-windows-multiframe)
(setq ediff-multiframe nil)
- (setq window-setup-func 'ediff-setup-windows-plain))
+ (setq window-setup-func 'ediff-setup-windows-plain)
+ (message "ediff is now in 'plain' mode"))
((eq ediff-window-setup-function 'ediff-setup-windows-plain)
(if (ediff-in-control-buffer-p)
(ediff-kill-bottom-toolbar))
@@ -1301,14 +1299,15 @@ which see."
(window-live-p ediff-control-window))
(set-window-dedicated-p ediff-control-window nil))
(setq ediff-multiframe t)
- (setq window-setup-func 'ediff-setup-windows-multiframe))
+ (setq window-setup-func 'ediff-setup-windows-multiframe)
+ (message "ediff is now in 'multiframe' mode"))
(t
(if (and (ediff-buffer-live-p ediff-control-buffer)
(window-live-p ediff-control-window))
(set-window-dedicated-p ediff-control-window nil))
(setq ediff-multiframe t)
(setq window-setup-func 'ediff-setup-windows-multiframe))
- )
+ (message "ediff is now in 'multiframe' mode"))
;; change default
(setq-default ediff-window-setup-function window-setup-func)
@@ -1643,8 +1642,8 @@ the width of the A/B/C windows."
(or ctl-buf (setq ctl-buf ediff-control-buffer))
(ediff-with-current-buffer ctl-buf
(let* ((buf (ediff-get-buffer buf-type))
- (wind (eval (ediff-get-symbol-from-alist
- buf-type ediff-window-alist)))
+ (wind (symbol-value (ediff-get-symbol-from-alist
+ buf-type ediff-window-alist)))
(beg (window-start wind))
(end (ediff-get-diff-posn buf-type 'end))
lines)
@@ -1661,8 +1660,8 @@ the width of the A/B/C windows."
(or ctl-buf (setq ctl-buf ediff-control-buffer))
(ediff-with-current-buffer ctl-buf
(let* ((buf (ediff-get-buffer buf-type))
- (wind (eval (ediff-get-symbol-from-alist
- buf-type ediff-window-alist)))
+ (wind (symbol-value (ediff-get-symbol-from-alist
+ buf-type ediff-window-alist)))
(end (or (window-end wind) (window-end wind t)))
(beg (ediff-get-diff-posn buf-type 'beg diff-num)))
(ediff-with-current-buffer buf
@@ -2440,7 +2439,9 @@ temporarily reverses the meaning of this variable."
;; restore buffer mode line id's in buffer-A/B/C
(let ((control-buffer ediff-control-buffer)
(meta-buffer ediff-meta-buffer)
- (after-quit-hook-internal ediff-after-quit-hook-internal)
+ ;; FIXME: Here we ignore the global part of the
+ ;; ediff-after-quit-hook-internal hook.
+ (after-quit-hook-internal (remq t ediff-after-quit-hook-internal))
(session-number ediff-meta-session-number)
;; suitable working frame
(warp-frame (if (and (ediff-window-display-p) (eq ediff-grab-mouse t))
@@ -2523,7 +2524,7 @@ temporarily reverses the meaning of this variable."
(frame-selected-window warp-frame))
2 1))
- (run-hooks 'after-quit-hook-internal)
+ (mapc #'funcall after-quit-hook-internal)
))
;; Returns frame under mouse, if this frame is not a minibuffer
@@ -3482,6 +3483,7 @@ 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.
@@ -3529,7 +3531,7 @@ Ediff Control Panel to restore highlighting."
(while (cond ((memq answer possibilities)
(setq possibilities (delq answer possibilities))
(setq bufA
- (eval
+ (symbol-value
(ediff-get-symbol-from-alist
answer ediff-buffer-alist)))
nil)
@@ -3548,7 +3550,7 @@ Ediff Control Panel to restore highlighting."
(while (cond ((memq answer possibilities)
(setq possibilities (delq answer possibilities))
(setq bufB
- (eval
+ (symbol-value
(ediff-get-symbol-from-alist
answer ediff-buffer-alist)))
nil)
@@ -3947,15 +3949,18 @@ Ediff Control Panel to restore highlighting."
(setq n (1+ n)))
(format "%s<%d>%s" prefix n suffix))))
+(defvar reporter-prompt-for-summary-p)
(defun ediff-submit-report ()
"Submit bug report on Ediff."
(interactive)
(ediff-barf-if-not-control-buffer)
+ (defvar ediff-device-type)
+ (defvar ediff-buffer-name)
(let ((reporter-prompt-for-summary-p t)
(ctl-buf ediff-control-buffer)
(ediff-device-type (ediff-device-type))
- varlist salutation buffer-name)
+ varlist salutation ediff-buffer-name)
(setq varlist '(ediff-diff-program ediff-diff-options
ediff-diff3-program ediff-diff3-options
ediff-patch-program ediff-patch-options
@@ -3972,7 +3977,7 @@ Ediff Control Panel to restore highlighting."
ediff-split-window-function
ediff-job-name
ediff-word-mode
- buffer-name
+ ediff-buffer-name
ediff-device-type
))
(setq salutation "
@@ -4027,7 +4032,7 @@ Mail anyway? (y or n) ")
(progn
(if (ediff-buffer-live-p ctl-buf)
(set-buffer ctl-buf))
- (setq buffer-name (buffer-name))
+ (setq ediff-buffer-name (buffer-name))
(require 'reporter)
(reporter-submit-bug-report "kifer@cs.stonybrook.edu, bug-gnu-emacs@gnu.org"
(ediff-version)
diff --git a/lisp/vc/ediff.el b/lisp/vc/ediff.el
index afd9edd4991..07c5ceadc6c 100644
--- a/lisp/vc/ediff.el
+++ b/lisp/vc/ediff.el
@@ -553,9 +553,9 @@ expression; only file names that match the regexp are considered."
nil 'must-match)
(read-string
(if (stringp default-regexp)
- (format "Filter through regular expression (default %s): "
+ (format "Filter filenames through regular expression (default %s): "
default-regexp)
- "Filter through regular expression: ")
+ "Filter filenames through regular expression: ")
nil
'ediff-filtering-regexp-history
(eval ediff-default-filtering-regexp))
@@ -581,9 +581,9 @@ names. Only the files that are under revision control are taken into account."
"Directory to compare with revision:" dir-A nil 'must-match)
(read-string
(if (stringp default-regexp)
- (format "Filter through regular expression (default %s): "
+ (format "Filter filenames through regular expression (default %s): "
default-regexp)
- "Filter through regular expression: ")
+ "Filter filenames through regular expression: ")
nil
'ediff-filtering-regexp-history
(eval ediff-default-filtering-regexp))
@@ -619,9 +619,9 @@ regular expression; only file names that match the regexp are considered."
nil 'must-match)
(read-string
(if (stringp default-regexp)
- (format "Filter through regular expression (default %s): "
+ (format "Filter filenames through regular expression (default %s): "
default-regexp)
- "Filter through regular expression: ")
+ "Filter filenames through regular expression: ")
nil
'ediff-filtering-regexp-history
(eval ediff-default-filtering-regexp))
@@ -651,9 +651,9 @@ expression; only file names that match the regexp are considered."
nil 'must-match)
(read-string
(if (stringp default-regexp)
- (format "Filter through regular expression (default %s): "
+ (format "Filter filenames through regular expression (default %s): "
default-regexp)
- "Filter through regular expression: ")
+ "Filter filenames through regular expression: ")
nil
'ediff-filtering-regexp-history
(eval ediff-default-filtering-regexp))
@@ -692,9 +692,9 @@ only file names that match the regexp are considered."
nil 'must-match)
(read-string
(if (stringp default-regexp)
- (format "Filter through regular expression (default %s): "
+ (format "Filter filenames through regular expression (default %s): "
default-regexp)
- "Filter through regular expression: ")
+ "Filter filenames through regular expression: ")
nil
'ediff-filtering-regexp-history
(eval ediff-default-filtering-regexp))
@@ -719,9 +719,9 @@ names. Only the files that are under revision control are taken into account."
"Directory to merge with revisions:" dir-A nil 'must-match)
(read-string
(if (stringp default-regexp)
- (format "Filter through regular expression (default %s): "
+ (format "Filter filenames through regular expression (default %s): "
default-regexp)
- "Filter through regular expression: ")
+ "Filter filenames through regular expression: ")
nil
'ediff-filtering-regexp-history
(eval ediff-default-filtering-regexp))
@@ -750,9 +750,9 @@ names. Only the files that are under revision control are taken into account."
dir-A nil 'must-match)
(read-string
(if (stringp default-regexp)
- (format "Filter through regular expression (default %s): "
+ (format "Filter filenames through regular expression (default %s): "
default-regexp)
- "Filter through regular expression: ")
+ "Filter filenames through regular expression: ")
nil
'ediff-filtering-regexp-history
(eval ediff-default-filtering-regexp))
@@ -1367,7 +1367,8 @@ buffer. If odd -- assume it is in a file."
(require 'ediff-ptch)
(setq patch-buf
(ediff-get-patch-buffer
- (if arg (prefix-numeric-value arg)) patch-buf))
+ (and arg (prefix-numeric-value arg))
+ (and patch-buf (get-buffer patch-buf))))
(setq source-dir (cond (ediff-use-last-dir ediff-last-dir-patch)
((and (not ediff-patch-default-directory)
(buffer-file-name patch-buf))
@@ -1401,9 +1402,8 @@ patch. If not given, the user is prompted according to the prefix argument."
(if arg (prefix-numeric-value arg)) patch-buf))
(ediff-patch-buffer-internal
patch-buf
- (read-buffer
- "Which buffer to patch? "
- (ediff-other-buffer patch-buf))))
+ (read-buffer "Which buffer to patch? " (ediff-other-buffer patch-buf)
+ 'require-match)))
;;;###autoload
diff --git a/lisp/vc/emerge.el b/lisp/vc/emerge.el
index de25cbafb0d..9c25ec43321 100644
--- a/lisp/vc/emerge.el
+++ b/lisp/vc/emerge.el
@@ -621,9 +621,10 @@ This is *not* a user option, since Emerge uses it for its own processing.")
(erase-buffer)
(shell-command
(format "%s %s %s %s"
- emerge-diff-program emerge-diff-options
- (emerge-protect-metachars file-A)
- (emerge-protect-metachars file-B))
+ (shell-quote-argument emerge-diff-program)
+ emerge-diff-options
+ (shell-quote-argument file-A)
+ (shell-quote-argument file-B))
t))
(emerge-prepare-error-list emerge-diff-ok-lines-regexp)
(emerge-convert-diffs-to-markers
@@ -792,10 +793,11 @@ This is *not* a user option, since Emerge uses it for its own processing.")
(erase-buffer)
(shell-command
(format "%s %s %s %s %s"
- emerge-diff3-program emerge-diff-options
- (emerge-protect-metachars file-A)
- (emerge-protect-metachars file-ancestor)
- (emerge-protect-metachars file-B))
+ (shell-quote-argument emerge-diff3-program)
+ emerge-diff-options
+ (shell-quote-argument file-A)
+ (shell-quote-argument file-ancestor)
+ (shell-quote-argument file-B))
t))
(emerge-prepare-error-list emerge-diff3-ok-lines-regexp)
(emerge-convert-diffs-to-markers
@@ -3171,26 +3173,11 @@ See also `auto-save-file-name-p'."
;; Metacharacters that have to be protected from the shell when executing
;; a diff/diff3 command.
-(defcustom emerge-metachars
- (if (memq system-type '(ms-dos windows-nt))
- "[ \t\"<>|?*^&=]"
- "[ \t\n!\"#$&'()*;<=>?[\\^`{|~]")
- "Characters that must be quoted when used in a shell command line.
-More precisely, a [...] regexp to match any one such character."
+(defcustom emerge-metachars nil
+ "Obsolete, emerge now uses `shell-quote-argument'."
:type 'regexp
:group 'emerge)
-
-;; Quote metacharacters (using \) when executing a diff/diff3 command.
-(defun emerge-protect-metachars (s)
- (if (memq system-type '(ms-dos windows-nt))
- (shell-quote-argument s)
- (let ((limit 0))
- (while (string-match emerge-metachars s limit)
- (setq s (concat (substring s 0 (match-beginning 0))
- "\\"
- (substring s (match-beginning 0))))
- (setq limit (1+ (match-end 0)))))
- s))
+(make-obsolete-variable 'emerge-metachars nil "26.1")
(provide 'emerge)
diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el
index 7dd130a3c59..e8efc1e6e09 100644
--- a/lisp/vc/log-view.el
+++ b/lisp/vc/log-view.el
@@ -200,8 +200,6 @@ If it is nil, `log-view-toggle-entry-display' does nothing.")
(t (:weight bold)))
"Face for the file header line in `log-view-mode'."
:group 'log-view)
-(define-obsolete-face-alias 'log-view-file-face 'log-view-file "22.1")
-(defvar log-view-file-face 'log-view-file)
(defface log-view-message
'((((class color) (background light))
@@ -209,9 +207,6 @@ If it is nil, `log-view-toggle-entry-display' does nothing.")
(t (:weight bold)))
"Face for the message header line in `log-view-mode'."
:group 'log-view)
-;; backward-compatibility alias
-(define-obsolete-face-alias 'log-view-message-face 'log-view-message "22.1")
-(defvar log-view-message-face 'log-view-message)
(defvar log-view-file-re
(concat "^\\(?:Working file: \\(?1:.+\\)" ;RCS and CVS.
@@ -246,8 +241,8 @@ The match group number 1 should match the revision number itself.")
;; and log-view-message-re, if applicable.
'((eval . `(,log-view-file-re
(1 (if (boundp 'cvs-filename-face) cvs-filename-face))
- (0 log-view-file-face append)))
- (eval . `(,log-view-message-re . log-view-message-face))))
+ (0 'log-view-file append)))
+ (eval . `(,log-view-message-re . 'log-view-message))))
(defconst log-view-font-lock-defaults
'(log-view-font-lock-keywords t nil nil nil))
diff --git a/lisp/vc/pcvs-info.el b/lisp/vc/pcvs-info.el
index 5a97714f024..8dd513c81fa 100644
--- a/lisp/vc/pcvs-info.el
+++ b/lisp/vc/pcvs-info.el
@@ -69,7 +69,6 @@ to confuse some users sometimes."
(t (:weight bold)))
"PCL-CVS face used to highlight directory changes."
:group 'pcl-cvs)
-(define-obsolete-face-alias 'cvs-header-face 'cvs-header "22.1")
(defface cvs-filename
'((((class color) (background dark))
@@ -79,7 +78,6 @@ to confuse some users sometimes."
(t ()))
"PCL-CVS face used to highlight file names."
:group 'pcl-cvs)
-(define-obsolete-face-alias 'cvs-filename-face 'cvs-filename "22.1")
(defface cvs-unknown
'((((class color) (background dark))
@@ -89,7 +87,6 @@ to confuse some users sometimes."
(t (:slant italic)))
"PCL-CVS face used to highlight unknown file status."
:group 'pcl-cvs)
-(define-obsolete-face-alias 'cvs-unknown-face 'cvs-unknown "22.1")
(defface cvs-handled
'((((class color) (background dark))
@@ -99,7 +96,6 @@ to confuse some users sometimes."
(t ()))
"PCL-CVS face used to highlight handled file status."
:group 'pcl-cvs)
-(define-obsolete-face-alias 'cvs-handled-face 'cvs-handled "22.1")
(defface cvs-need-action
'((((class color) (background dark))
@@ -109,7 +105,6 @@ to confuse some users sometimes."
(t (:slant italic)))
"PCL-CVS face used to highlight status of files needing action."
:group 'pcl-cvs)
-(define-obsolete-face-alias 'cvs-need-action-face 'cvs-need-action "22.1")
(defface cvs-marked
'((((min-colors 88) (class color) (background dark))
@@ -121,13 +116,11 @@ to confuse some users sometimes."
(t (:weight bold)))
"PCL-CVS face used to highlight marked file indicator."
:group 'pcl-cvs)
-(define-obsolete-face-alias 'cvs-marked-face 'cvs-marked "22.1")
(defface cvs-msg
'((t :slant italic))
"PCL-CVS face used to highlight CVS messages."
:group 'pcl-cvs)
-(define-obsolete-face-alias 'cvs-msg-face 'cvs-msg "22.1")
(defvar cvs-fi-up-to-date-face 'cvs-handled)
(defvar cvs-fi-unknown-face 'cvs-unknown)
diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el
index 7b2920a4971..de40b99b941 100644
--- a/lisp/vc/smerge-mode.el
+++ b/lisp/vc/smerge-mode.el
@@ -67,34 +67,34 @@
(append '("-d" "-b")
(if (listp diff-switches) diff-switches (list diff-switches)))
"A list of strings specifying switches to be passed to diff.
-Used in `smerge-diff-base-mine' and related functions."
+Used in `smerge-diff-base-upper' and related functions."
:type '(repeat string))
(defcustom smerge-auto-leave t
"Non-nil means to leave `smerge-mode' when the last conflict is resolved."
:type 'boolean)
-(defface smerge-mine
+(defface smerge-upper
'((((class color) (min-colors 88) (background light))
:background "#ffdddd")
(((class color) (min-colors 88) (background dark))
:background "#553333")
(((class color))
:foreground "red"))
- "Face for your code.")
-(define-obsolete-face-alias 'smerge-mine-face 'smerge-mine "22.1")
-(defvar smerge-mine-face 'smerge-mine)
+ "Face for the `upper' version of a conflict.")
+(define-obsolete-face-alias 'smerge-mine 'smerge-upper "26.1")
+(defvar smerge-upper-face 'smerge-upper)
-(defface smerge-other
+(defface smerge-lower
'((((class color) (min-colors 88) (background light))
:background "#ddffdd")
(((class color) (min-colors 88) (background dark))
:background "#335533")
(((class color))
:foreground "green"))
- "Face for the other code.")
-(define-obsolete-face-alias 'smerge-other-face 'smerge-other "22.1")
-(defvar smerge-other-face 'smerge-other)
+ "Face for the `lower' version of a conflict.")
+(define-obsolete-face-alias 'smerge-other 'smerge-lower "26.1")
+(defvar smerge-lower-face 'smerge-lower)
(defface smerge-base
'((((class color) (min-colors 88) (background light))
@@ -149,16 +149,18 @@ Used in `smerge-diff-base-mine' and related functions."
("r" . smerge-resolve)
("a" . smerge-keep-all)
("b" . smerge-keep-base)
- ("o" . smerge-keep-other)
- ("m" . smerge-keep-mine)
+ ("o" . smerge-keep-lower) ; for the obsolete keep-other
+ ("l" . smerge-keep-lower)
+ ("m" . smerge-keep-upper) ; for the obsolete keep-mine
+ ("u" . smerge-keep-upper)
("E" . smerge-ediff)
("C" . smerge-combine-with-next)
("R" . smerge-refine)
("\C-m" . smerge-keep-current)
("=" . ,(make-sparse-keymap "Diff"))
- ("=<" "base-mine" . smerge-diff-base-mine)
- ("=>" "base-other" . smerge-diff-base-other)
- ("==" "mine-other" . smerge-diff-mine-other))
+ ("=<" "base-upper" . smerge-diff-base-upper)
+ ("=>" "base-lower" . smerge-diff-base-lower)
+ ("==" "upper-lower" . smerge-diff-upper-lower))
"The base keymap for `smerge-mode'.")
(defcustom smerge-command-prefix "\C-c^"
@@ -196,19 +198,19 @@ Used in `smerge-diff-base-mine' and related functions."
"--"
["Revert to Base" smerge-keep-base :help "Revert to base version"
:active (smerge-check 2)]
- ["Keep Other" smerge-keep-other :help "Keep `other' version"
- :active (smerge-check 3)]
- ["Keep Yours" smerge-keep-mine :help "Keep your version"
+ ["Keep Upper" smerge-keep-upper :help "Keep `upper' version"
:active (smerge-check 1)]
+ ["Keep Lower" smerge-keep-lower :help "Keep `lower' version"
+ :active (smerge-check 3)]
"--"
- ["Diff Base/Mine" smerge-diff-base-mine
- :help "Diff `base' and `mine' for current conflict"
+ ["Diff Base/Upper" smerge-diff-base-upper
+ :help "Diff `base' and `upper' for current conflict"
:active (smerge-check 2)]
- ["Diff Base/Other" smerge-diff-base-other
- :help "Diff `base' and `other' for current conflict"
+ ["Diff Base/Lower" smerge-diff-base-lower
+ :help "Diff `base' and `lower' for current conflict"
:active (smerge-check 2)]
- ["Diff Mine/Other" smerge-diff-mine-other
- :help "Diff `mine' and `other' for current conflict"
+ ["Diff Upper/Lower" smerge-diff-upper-lower
+ :help "Diff `upper' and `lower' for current conflict"
:active (smerge-check 1)]
"--"
["Invoke Ediff" smerge-ediff
@@ -223,7 +225,7 @@ Used in `smerge-diff-base-mine' and related functions."
))
(easy-menu-define smerge-context-menu nil
- "Context menu for mine area in `smerge-mode'."
+ "Context menu for upper area in `smerge-mode'."
'(nil
["Keep Current" smerge-keep-current :help "Use current (at point) version"]
["Kill Current" smerge-kill-current :help "Remove current (at point) version"]
@@ -234,9 +236,9 @@ Used in `smerge-diff-base-mine' and related functions."
(defconst smerge-font-lock-keywords
'((smerge-find-conflict
- (1 smerge-mine-face prepend t)
+ (1 smerge-upper-face prepend t)
(2 smerge-base-face prepend t)
- (3 smerge-other-face prepend t)
+ (3 smerge-lower-face prepend t)
;; FIXME: `keep' doesn't work right with syntactic fontification.
(0 smerge-markers-face keep)
(4 nil t t)
@@ -246,7 +248,7 @@ Used in `smerge-diff-base-mine' and related functions."
(defconst smerge-begin-re "^<<<<<<< \\(.*\\)\n")
(defconst smerge-end-re "^>>>>>>> \\(.*\\)\n")
(defconst smerge-base-re "^||||||| \\(.*\\)\n")
-(defconst smerge-other-re "^=======\n")
+(defconst smerge-lower-re "^=======\n")
(defvar smerge-conflict-style nil
"Keep track of which style of conflict is in use.
@@ -267,7 +269,7 @@ Can be nil if the style is undecided, or else:
(if diff-auto-refine-mode
(condition-case nil (smerge-refine) (error nil))))
-(defconst smerge-match-names ["conflict" "mine" "base" "other"])
+(defconst smerge-match-names ["conflict" "upper" "base" "lower"])
(defun smerge-ensure-match (n)
(unless (match-end n)
@@ -570,7 +572,7 @@ major modes. Uses `smerge-resolve-function' to do the actual work."
(zerop (call-process diff-command nil buf nil "-bc" b m)))
(set-match-data md)
(smerge-keep-n 3))
- ;; Try "diff -b BASE MINE | patch OTHER".
+ ;; Try "diff -b BASE UPPER | patch LOWER".
((when (and (not safe) m2e b
;; If the BASE is empty, this would just concatenate
;; the two, which is rarely right.
@@ -585,7 +587,7 @@ major modes. Uses `smerge-resolve-function' to do the actual work."
(narrow-to-region m0b m0e)
(smerge-remove-props m0b m0e)
(insert-file-contents o nil nil nil t)))
- ;; Try "diff -b BASE OTHER | patch MINE".
+ ;; Try "diff -b BASE LOWER | patch UPPER".
((when (and (not safe) m2e b
;; If the BASE is empty, this would just concatenate
;; the two, which is rarely right.
@@ -685,22 +687,40 @@ major modes. Uses `smerge-resolve-function' to do the actual work."
(smerge-keep-n 2)
(smerge-auto-leave))
-(defun smerge-keep-other ()
- "Use \"other\" version."
+(defun smerge-keep-lower ()
+ "Keep the \"lower\" version of a merge conflict.
+In a conflict that looks like:
+ <<<<<<<
+ UUU
+ =======
+ LLL
+ >>>>>>>
+this keeps \"LLL\"."
(interactive)
(smerge-match-conflict)
;;(smerge-ensure-match 3)
(smerge-keep-n 3)
(smerge-auto-leave))
-(defun smerge-keep-mine ()
- "Keep your version."
+(define-obsolete-function-alias 'smerge-keep-other 'smerge-keep-lower "26.1")
+
+(defun smerge-keep-upper ()
+ "Keep the \"upper\" version of a merge conflict.
+In a conflict that looks like:
+ <<<<<<<
+ UUU
+ =======
+ LLL
+ >>>>>>>
+this keeps \"UUU\"."
(interactive)
(smerge-match-conflict)
;;(smerge-ensure-match 1)
(smerge-keep-n 1)
(smerge-auto-leave))
+(define-obsolete-function-alias 'smerge-keep-mine 'smerge-keep-upper "26.1")
+
(defun smerge-get-current ()
(let ((i 3))
(while (or (not (match-end i))
@@ -734,28 +754,37 @@ major modes. Uses `smerge-resolve-function' to do the actual work."
(smerge-keep-n (car left))
(smerge-auto-leave))))))
-(defun smerge-diff-base-mine ()
- "Diff `base' and `mine' version in current conflict region."
+(defun smerge-diff-base-upper ()
+ "Diff `base' and `upper' version in current conflict region."
(interactive)
(smerge-diff 2 1))
-(defun smerge-diff-base-other ()
- "Diff `base' and `other' version in current conflict region."
+(define-obsolete-function-alias 'smerge-diff-base-mine
+ 'smerge-diff-base-upper "26.1")
+
+(defun smerge-diff-base-lower ()
+ "Diff `base' and `lower' version in current conflict region."
(interactive)
(smerge-diff 2 3))
-(defun smerge-diff-mine-other ()
- "Diff `mine' and `other' version in current conflict region."
+(define-obsolete-function-alias 'smerge-diff-base-other
+ 'smerge-diff-base-lower "26.1")
+
+(defun smerge-diff-upper-lower ()
+ "Diff `upper' and `lower' version in current conflict region."
(interactive)
(smerge-diff 1 3))
+(define-obsolete-function-alias 'smerge-diff-mine-other
+ 'smerge-diff-upper-lower "26.1")
+
(defun smerge-match-conflict ()
"Get info about the conflict. Puts the info in the `match-data'.
The submatches contain:
0: the whole conflict.
- 1: your code.
- 2: the base code.
- 3: other code.
+ 1: upper version of the code.
+ 2: base version of the code.
+ 3: lower version of the code.
An error is raised if not inside a conflict."
(save-excursion
(condition-case nil
@@ -765,26 +794,26 @@ An error is raised if not inside a conflict."
(_ (re-search-backward smerge-begin-re))
(start (match-beginning 0))
- (mine-start (match-end 0))
+ (upper-start (match-end 0))
(filename (or (match-string 1) ""))
(_ (re-search-forward smerge-end-re))
(_ (cl-assert (< orig-point (match-end 0))))
- (other-end (match-beginning 0))
+ (lower-end (match-beginning 0))
(end (match-end 0))
- (_ (re-search-backward smerge-other-re start))
+ (_ (re-search-backward smerge-lower-re start))
- (mine-end (match-beginning 0))
- (other-start (match-end 0))
+ (upper-end (match-beginning 0))
+ (lower-start (match-end 0))
base-start base-end)
;; handle the various conflict styles
(cond
((save-excursion
- (goto-char mine-start)
+ (goto-char upper-start)
(re-search-forward smerge-begin-re end t))
;; There's a nested conflict and we're after the beginning
;; of the outer one but before the beginning of the inner one.
@@ -797,8 +826,8 @@ An error is raised if not inside a conflict."
((re-search-backward smerge-base-re start t)
;; a 3-parts conflict
(set (make-local-variable 'smerge-conflict-style) 'diff3-A)
- (setq base-end mine-end)
- (setq mine-end (match-beginning 0))
+ (setq base-end upper-end)
+ (setq upper-end (match-beginning 0))
(setq base-start (match-end 0)))
((string= filename (file-name-nondirectory
@@ -811,17 +840,17 @@ An error is raised if not inside a conflict."
(equal filename "ANCESTOR")
(string-match "\\`[.0-9]+\\'" filename)))
;; a same-diff conflict
- (setq base-start mine-start)
- (setq base-end mine-end)
- (setq mine-start other-start)
- (setq mine-end other-end)))
+ (setq base-start upper-start)
+ (setq base-end upper-end)
+ (setq upper-start lower-start)
+ (setq upper-end lower-end)))
(store-match-data (list start end
- mine-start mine-end
+ upper-start upper-end
base-start base-end
- other-start other-end
+ lower-start lower-end
(when base-start (1- base-start)) base-start
- (1- other-start) other-start))
+ (1- lower-start) lower-start))
t)
(search-failed (user-error "Point not in conflict region")))))
@@ -1133,10 +1162,10 @@ repeating the command will highlight other two parts."
'((smerge . refine) (face . smerge-refined-added))))))
(defun smerge-swap ()
- "Swap the \"Mine\" and the \"Other\" chunks.
+ "Swap the \"Upper\" and the \"Lower\" 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."
+spacing of the \"Lower\" chunk."
(interactive)
(smerge-match-conflict)
(goto-char (match-beginning 3))
@@ -1205,9 +1234,9 @@ spacing of the \"Other\" chunk."
default)))
;;;###autoload
-(defun smerge-ediff (&optional name-mine name-other name-base)
+(defun smerge-ediff (&optional name-upper name-lower name-base)
"Invoke ediff to resolve the conflicts.
-NAME-MINE, NAME-OTHER, and NAME-BASE, if non-nil, are used for the
+NAME-UPPER, NAME-LOWER, and NAME-BASE, if non-nil, are used for the
buffer names."
(interactive)
(let* ((buf (current-buffer))
@@ -1215,18 +1244,18 @@ buffer names."
;;(ediff-default-variant 'default-B)
(config (current-window-configuration))
(filename (file-name-nondirectory (or buffer-file-name "-")))
- (mine (generate-new-buffer
- (or name-mine
+ (upper (generate-new-buffer
+ (or name-upper
(concat "*" filename " "
- (smerge--get-marker smerge-begin-re "MINE")
+ (smerge--get-marker smerge-begin-re "UPPER")
"*"))))
- (other (generate-new-buffer
- (or name-other
+ (lower (generate-new-buffer
+ (or name-lower
(concat "*" filename " "
- (smerge--get-marker smerge-end-re "OTHER")
+ (smerge--get-marker smerge-end-re "LOWER")
"*"))))
base)
- (with-current-buffer mine
+ (with-current-buffer upper
(buffer-disable-undo)
(insert-buffer-substring buf)
(goto-char (point-min))
@@ -1237,7 +1266,7 @@ buffer names."
(set-buffer-modified-p nil)
(funcall mode))
- (with-current-buffer other
+ (with-current-buffer lower
(buffer-disable-undo)
(insert-buffer-substring buf)
(goto-char (point-min))
@@ -1269,9 +1298,9 @@ buffer names."
;; Fire up ediff.
(set-buffer
(if base
- (ediff-merge-buffers-with-ancestor mine other base)
+ (ediff-merge-buffers-with-ancestor upper lower base)
;; nil 'ediff-merge-revisions-with-ancestor buffer-file-name)
- (ediff-merge-buffers mine other)))
+ (ediff-merge-buffers upper lower)))
;; nil 'ediff-merge-revisions buffer-file-name)))
;; Ediff is now set up, and we are in the control buffer.
@@ -1313,21 +1342,21 @@ with a \\[universal-argument] prefix, makes up a 3-way conflict."
(pcase-let ((`(,pt1 ,pt2 ,pt3 ,pt4)
(sort `(,pt1 ,pt2 ,pt3 ,@(if pt4 (list pt4))) '>=)))
(goto-char pt1) (beginning-of-line)
- (insert ">>>>>>> OTHER\n")
+ (insert ">>>>>>> LOWER\n")
(goto-char pt2) (beginning-of-line)
(insert "=======\n")
(goto-char pt3) (beginning-of-line)
(when pt4
(insert "||||||| BASE\n")
(goto-char pt4) (beginning-of-line))
- (insert "<<<<<<< MINE\n"))
+ (insert "<<<<<<< UPPER\n"))
(if smerge-mode nil (smerge-mode 1))
(smerge-refine))
(defconst smerge-parsep-re
(concat smerge-begin-re "\\|" smerge-end-re "\\|"
- smerge-base-re "\\|" smerge-other-re "\\|"))
+ smerge-base-re "\\|" smerge-lower-re "\\|"))
;;;###autoload
(define-minor-mode smerge-mode
diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index ffd4f4db4e1..279d5ac9236 100644
--- a/lisp/vc/vc-bzr.el
+++ b/lisp/vc/vc-bzr.el
@@ -50,6 +50,11 @@
(require 'vc-dispatcher)
(require 'vc-dir)) ; vc-dir-at-event
+(declare-function vc-deduce-fileset "vc"
+ (&optional observer allow-unregistered
+ state-model-only-files))
+
+
;; Clear up the cache to force vc-call to check again and discover
;; new functions when we reload this file.
(put 'Bzr 'vc-functions nil)
@@ -367,7 +372,12 @@ If PROMPT is non-nil, prompt for the Bzr command to run."
args (cddr args)))
(require 'vc-dispatcher)
(let ((buf (apply 'vc-bzr-async-command command args)))
- (with-current-buffer buf (vc-run-delayed (vc-compilation-mode 'bzr)))
+ (with-current-buffer buf
+ (vc-run-delayed
+ (vc-compilation-mode 'bzr)
+ (setq-local compile-command
+ (concat vc-bzr-program " " command " "
+ (if args (mapconcat 'identity args " ") "")))))
(vc-set-async-update buf))))
(defun vc-bzr-pull (prompt)
diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el
index b087d6ad1b8..e54baaa269b 100644
--- a/lisp/vc/vc-cvs.el
+++ b/lisp/vc/vc-cvs.el
@@ -27,6 +27,12 @@
(eval-when-compile (require 'vc))
+(declare-function vc-branch-p "vc" (rev))
+(declare-function vc-checkout "vc" (file &optional rev))
+(declare-function vc-expand-dirs "vc" (file-or-dir-list backend))
+(declare-function vc-read-revision "vc"
+ (prompt &optional files backend default initial-input))
+
;; Clear up the cache to force vc-call to check again and discover
;; new functions when we reload this file.
(put 'CVS 'vc-functions nil)
diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el
index dcc6bb5e9b6..03af032cb2b 100644
--- a/lisp/vc/vc-dispatcher.el
+++ b/lisp/vc/vc-dispatcher.el
@@ -669,7 +669,7 @@ BACKEND, if non-nil, specifies a VC backend for the Log Edit buffer."
(make-local-variable 'vc-log-after-operation-hook)
(when after-hook
(setq vc-log-after-operation-hook after-hook))
- (setq vc-log-operation action)
+ (set (make-local-variable 'vc-log-operation) action)
(when comment
(erase-buffer)
(when (stringp comment) (insert comment)))
@@ -711,6 +711,7 @@ the buffer contents as a comment."
(funcall log-operation
log-fileset
log-entry))
+ (setq vc-log-operation nil)
;; Quit windows on logbuf.
(cond
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 46355b8af22..c6702800161 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -704,8 +704,10 @@ It is based on `log-edit-mode', and has Git-specific extensions.")
;; file, to work around the limitation that command-line
;; arguments must be in the system codepage, and therefore
;; might not support the non-ASCII characters in the log
- ;; message.
- (if (eq system-type 'windows-nt) (make-temp-file "git-msg"))))
+ ;; message. Handle also remote files.
+ (if (eq system-type 'windows-nt)
+ (let ((default-directory (file-name-directory file1)))
+ (file-local-name (make-nearby-temp-file "git-msg"))))))
(cl-flet ((boolean-arg-fn
(argument)
(lambda (value) (when (equal value "yes") (list argument)))))
@@ -790,7 +792,12 @@ If PROMPT is non-nil, prompt for the Git command to run."
args (cddr args)))
(require 'vc-dispatcher)
(apply 'vc-do-async-command buffer root git-program command args)
- (with-current-buffer buffer (vc-run-delayed (vc-compilation-mode 'git)))
+ (with-current-buffer buffer
+ (vc-run-delayed
+ (vc-compilation-mode 'git)
+ (setq-local compile-command
+ (concat git-program " " command " "
+ (if args (mapconcat 'identity args " ") "")))))
(vc-set-async-update buffer)))
(defun vc-git-pull (prompt)
@@ -881,6 +888,11 @@ This prompts for a branch to merge from."
(autoload 'vc-setup-buffer "vc-dispatcher")
+(defcustom vc-git-print-log-follow nil
+ "If true, follow renames in Git logs for files."
+ :type 'boolean
+ :version "26.1")
+
(defun vc-git-print-log (files buffer &optional shortlog start-revision limit)
"Print commit log associated with FILES into specified BUFFER.
If SHORTLOG is non-nil, use a short format based on `vc-git-root-log-format'.
@@ -901,6 +913,12 @@ If LIMIT is non-nil, show no more than this many entries."
'async files
(append
'("log" "--no-color")
+ (when (and vc-git-print-log-follow
+ (not (cl-some #'file-directory-p files)))
+ ;; "--follow" on directories is broken
+ ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=8756
+ ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=16422
+ (list "--follow"))
(when shortlog
`("--graph" "--decorate" "--date=short"
,(format "--pretty=tformat:%s"
@@ -1005,7 +1023,9 @@ or BRANCH^ (where \"^\" can be repeated)."
(goto-char (point-min))
(unless (eobp)
;; Indent the expanded log entry.
- (indent-region (point-min) (point-max) 2)
+ (while (re-search-forward "^ " nil t)
+ (replace-match "")
+ (forward-line))
(buffer-string))))
(defun vc-git-region-history (file buffer lfrom lto)
@@ -1084,6 +1104,13 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
(cons 'vc-git-region-history-font-lock-keywords
(cdr font-lock-defaults))))
+(defun vc-git--asciify-coding-system ()
+ ;; Try to reconcile the content encoding with the encoding of Git's
+ ;; auxiliary output (which is ASCII or ASCII-compatible), bug#23595.
+ (unless (let ((samp "Binary files differ"))
+ (string-equal samp (decode-coding-string
+ samp coding-system-for-read t)))
+ (setq coding-system-for-read 'undecided)))
(autoload 'vc-switches "vc")
@@ -1091,6 +1118,7 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
"Get a difference report using Git between two revisions of FILES."
(let (process-file-side-effects
(command "diff-tree"))
+ (vc-git--asciify-coding-system)
(if rev2
;; Diffing against the empty tree.
(unless rev1 (setq rev1 "4b825dc642cb6eb9a060e54bf8d69288fbee4904"))
@@ -1129,6 +1157,7 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
table))
(defun vc-git-annotate-command (file buf &optional rev)
+ (vc-git--asciify-coding-system)
(let ((name (file-relative-name file)))
(apply #'vc-git-command buf 'async nil "blame" "--date=short"
(append (vc-switches 'git 'annotate)
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index 3275a5456f5..fc072516924 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -48,7 +48,7 @@
;; - dir-printer (fileinfo) OK
;; * working-revision (file) OK
;; * checkout-model (files) OK
-;; - mode-line-string (file) NOT NEEDED
+;; - mode-line-string (file) OK
;; STATE-CHANGING FUNCTIONS
;; * register (files &optional rev comment) OK
;; * create-repo () OK
@@ -106,6 +106,8 @@
(require 'vc)
(require 'vc-dir))
+(declare-function vc-compilation-mode "vc-dispatcher" (backend))
+
;;; Customization options
(defgroup vc-hg nil
@@ -197,6 +199,11 @@ highlighting the Log View buffer."
(defun vc-hg-state (file)
"Hg-specific version of `vc-state'."
+ (let ((state (vc-hg-state-fast file)))
+ (if (eq state 'unsupported) (vc-hg-state-slow file) state)))
+
+(defun vc-hg-state-slow (file)
+ "Determine status of FILE by running hg."
(setq file (expand-file-name file))
(let*
((status nil)
@@ -245,6 +252,130 @@ highlighting the Log View buffer."
"parent" "--template" "{rev}")))
"0"))
+(defcustom vc-hg-symbolic-revision-styles
+ '(builtin-active-bookmark
+ "{if(bookmarks,sub(' ',',',bookmarks),if(phabdiff,phabdiff,shortest(node,6)))}")
+ "List of ways to present versions symbolically. The version
+that we use is the first one that successfully produces a
+non-empty string.
+
+Each entry in the list can be either:
+
+- The symbol `builtin-active-bookmark', which indicates that we
+should use the active bookmark if one exists. A template can
+supply this information as well, but `builtin-active-bookmark' is
+handled entirely inside Emacs and so is more efficient than using
+the generic Mercurial mechanism.
+
+- A string giving the Mercurial template to supply to \"hg
+parent\". \"hg help template\" may be useful reading.
+
+- A function to call; it should accept two arguments (a revision
+and an optional path to which to limit history) and produce a
+string. The function is called with `default-directory' set to
+within the repository.
+
+If no list entry produces a useful revision, return `nil'."
+ :type '(repeat (choice
+ (const :tag "Active bookmark" 'bookmark)
+ (string :tag "Hg template")
+ (function :tag "Custom")))
+ :version "26.1"
+ :group 'vc-hg)
+
+(defcustom vc-hg-use-file-version-for-mode-line-version nil
+ "When enabled, the modeline contains revision information for the visited file.
+When not, the revision in the modeline is for the repository
+working copy. `nil' is the much faster setting for
+large repositories."
+ :type 'boolean
+ :version "26.1"
+ :group 'vc-hg)
+
+(defun vc-hg--active-bookmark-internal (rev)
+ (when (equal rev ".")
+ (let* ((current-bookmarks-file ".hg/bookmarks.current"))
+ (when (file-exists-p current-bookmarks-file)
+ (ignore-errors
+ (with-temp-buffer
+ (insert-file-contents current-bookmarks-file)
+ (buffer-substring-no-properties
+ (point-min) (point-max))))))))
+
+(defun vc-hg--run-log (template rev path)
+ (ignore-errors
+ (with-output-to-string
+ (if path
+ (vc-hg-command
+ standard-output 0 nil
+ "log" "-f" "-l1" "--template" template path)
+ (vc-hg-command
+ standard-output 0 nil
+ "log" "-r" rev "-l1" "--template" template)))))
+
+(defun vc-hg--symbolic-revision (rev &optional path)
+ "Make a Mercurial revision human-readable.
+REV is a Mercurial revision. `default-directory' is assumed to
+be in the repository root of interest. PATH, if set, is a
+specific file to query."
+ (let ((symbolic-revision nil)
+ (styles vc-hg-symbolic-revision-styles))
+ (while (and (not symbolic-revision) styles)
+ (let ((style (pop styles)))
+ (setf symbolic-revision
+ (cond ((and (null path) (eq style 'builtin-active-bookmark))
+ (vc-hg--active-bookmark-internal rev))
+ ((stringp style)
+ (vc-hg--run-log style rev path))
+ ((functionp style)
+ (funcall style rev path))))))
+ symbolic-revision))
+
+(defun vc-hg-mode-line-string (file)
+ "Hg-specific version of `vc-mode-line-string'."
+ (let* ((backend-name "Hg")
+ (truename (file-truename file))
+ (state (vc-state truename))
+ (state-echo nil)
+ (face nil)
+ (rev (and state
+ (let ((default-directory
+ (expand-file-name (vc-hg-root truename))))
+ (vc-hg--symbolic-revision
+ "."
+ (and vc-hg-use-file-version-for-mode-line-version
+ truename)))))
+ (rev (or rev "???")))
+ (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))
+ ((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
+ (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"))))
+
;;; History functions
(defcustom vc-hg-log-switches nil
@@ -435,6 +566,488 @@ Optional arg REVISION is a revision to annotate from."
;; TODO: update *vc-change-log* buffer so can see @ if --graph
))
+;;; Native data structure reading
+
+(defcustom vc-hg-parse-hg-data-structures t
+ "If true, try directly parsing Mercurial data structures
+directly instead of always running Mercurial. We try to be safe
+against Mercurial data structure format changes and always fall
+back to running Mercurial directly."
+ :type 'boolean
+ :version "26.1"
+ :group 'vc-hg)
+
+(defsubst vc-hg--read-u8 ()
+ "Read and advance over an unsigned byte.
+Return a fixnum."
+ (prog1 (char-after)
+ (forward-char)))
+
+(defsubst vc-hg--read-u32-be ()
+ "Read and advance over a big-endian unsigned 32-bit integer.
+Return a fixnum; on overflow, result is undefined."
+ ;; Because elisp bytecode has an instruction for multiply and
+ ;; doesn't have one for lsh, it's somewhat counter-intuitively
+ ;; faster to multiply than to shift.
+ (+ (* (vc-hg--read-u8) (* 256 256 256))
+ (* (vc-hg--read-u8) (* 256 256))
+ (* (vc-hg--read-u8) 256)
+ (identity (vc-hg--read-u8))))
+
+(defun vc-hg--raw-dirstate-search (dirstate fname)
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert-file-contents-literally dirstate)
+ (let* ((result nil)
+ (flen (length fname))
+ (case-fold-search nil)
+ (inhibit-changing-match-data t)
+ ;; Find a conservative bound for the loop below by using
+ ;; Boyer-Moore on the raw dirstate without parsing it; we
+ ;; know we can't possibly find fname _after_ the last place
+ ;; it appears, so we can bail out early if we try to parse
+ ;; past it, which especially helps when the file we're
+ ;; trying to find isn't in dirstate at all. There's no way
+ ;; to similarly bound the starting search position, since
+ ;; the file format is such that we need to parse it from
+ ;; the beginning to find record boundaries.
+ (search-limit
+ (progn
+ (goto-char (point-max))
+ (or (search-backward fname (+ (point-min) 40) t)
+ (point-min)))))
+ ;; 40 is just after the header, which contains the working
+ ;; directory parents
+ (goto-char (+ (point-min) 40))
+ ;; Iterate over all dirstate entries; we might run this loop
+ ;; hundreds of thousands of times, so performance is important
+ ;; here
+ (while (< (point) search-limit)
+ ;; 1+4*4 is the length of the dirstate item header, which we
+ ;; spell as a literal for performance, since the elisp
+ ;; compiler lacks constant propagation
+ (forward-char (1+ (* 3 4)))
+ (let ((this-flen (vc-hg--read-u32-be)))
+ (if (and (or (eq this-flen flen)
+ (and (> this-flen flen)
+ (eq (char-after (+ (point) flen)) 0)))
+ (search-forward fname (+ (point) flen) t))
+ (progn
+ (backward-char (+ flen (1+ (* 4 4))))
+ (setf result
+ (list (vc-hg--read-u8) ; status
+ (vc-hg--read-u32-be) ; mode
+ (vc-hg--read-u32-be) ; size (of file)
+ (vc-hg--read-u32-be) ; mtime
+ ))
+ (goto-char (point-max)))
+ (forward-char this-flen))))
+ result)))
+
+(define-error 'vc-hg-unsupported-syntax "unsupported hgignore syntax")
+
+(defconst vc-hg--pcre-c-escapes
+ '((?a . ?\a)
+ (?b . ?\b)
+ (?f . ?\f)
+ (?n . ?\n)
+ (?r . ?\r)
+ (?t . ?\t)
+ (?n . ?\n)
+ (?r . ?\r)
+ (?t . ?\t)
+ (?v . ?\v)))
+
+(defconst vc-hg--pcre-metacharacters
+ '(?. ?^ ?$ ?* ?+ ?? ?{ ?\\ ?\[ ?\| ?\())
+
+(defconst vc-hg--elisp-metacharacters
+ '(?. ?* ?+ ?? ?\[ ?$ ?\\))
+
+(defun vc-hg--escape-for-pcre (c)
+ (if (memq c vc-hg--pcre-metacharacters)
+ (string ?\\ c)
+ c))
+
+(defun vc-hg--parts-to-string (parts)
+ "Build a string from list PARTS. Each element is a character or string."
+ (let ((parts2 nil))
+ (while parts
+ (let* ((partcell (prog1 parts (setf parts (cdr parts))))
+ (part (car partcell)))
+ (if (stringp part)
+ (setf parts2 (nconc (append part nil) parts2))
+ (setcdr partcell parts2)
+ (setf parts2 partcell))))
+ (apply #'string parts2)))
+
+(defun vc-hg--pcre-to-elisp-re (pcre prefix)
+ "Transform PCRE, a Mercurial file PCRE, into an elisp RE against PREFIX.
+PREFIX is the directory name of the directory against which these
+patterns are rooted. We understand only a subset of PCRE syntax;
+if we don't understand a construct, we signal
+`vc-hg-unsupported-syntax'."
+ (cl-assert (string-match "^/\\(.*/\\)?$" prefix))
+ (let ((parts nil)
+ (i 0)
+ (anchored nil)
+ (state 'normal)
+ (pcrelen (length pcre)))
+ (while (< i pcrelen)
+ (let ((c (aref pcre i)))
+ (cond ((eq state 'normal)
+ (cond ((string-match
+ (rx (| "}\\?" (: "(?" (not (any ":")))))
+ pcre i)
+ (signal 'vc-hg-unsupported-syntax (list pcre)))
+ ((eq c ?\\)
+ (setf state 'backslash))
+ ((eq c ?\[)
+ (setf state 'charclass-enter)
+ (push c parts))
+ ((eq c ?^)
+ (if (eq i 0) (setf anchored t)
+ (signal 'vc-hg-unsupported-syntax (list pcre))))
+ ((eq c ?$)
+ ;; Patterns can also match directories exactly,
+ ;; ignoring everything under a matched directory
+ (push "\\(?:$\\|/\\)" parts))
+ ((memq c '(?| ?\( ?\)))
+ (push ?\\ parts)
+ (push c parts))
+ (t (push c parts))))
+ ((eq state 'backslash)
+ (cond ((memq c '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9
+ ?A ?b ?B ?d ?D ?s ?S ?w ?W ?Z ?x))
+ (signal 'vc-hg-unsupported-syntax (list pcre)))
+ ((memq c vc-hg--elisp-metacharacters)
+ (push ?\\ parts)
+ (push c parts))
+ (t (push (or (cdr (assq c vc-hg--pcre-c-escapes)) c) parts)))
+ (setf state 'normal))
+ ((eq state 'charclass-enter)
+ (push c parts)
+ (setf state
+ (if (eq c ?\\)
+ 'charclass
+ 'charclass-backslash)))
+ ((eq state 'charclass-backslash)
+ (if (memq c '(?0 ?x))
+ (signal 'vc-hg-unsupported-syntax (list pcre)))
+ (push (or (cdr (assq c vc-hg--pcre-c-escapes)) c) parts)
+ (setf state 'charclass))
+ ((eq state 'charclass)
+ (push c parts)
+ (cond ((eq c ?\\) (setf state 'charclass-backslash))
+ ((eq c ?\]) (setf state 'normal))))
+ (t (error "invalid state")))
+ (setf i (1+ i))))
+ (unless (eq state 'normal)
+ (signal 'vc-hg-unsupported-syntax (list pcre)))
+ (concat
+ "^"
+ prefix
+ (if anchored "" "\\(?:.*/\\)?")
+ (vc-hg--parts-to-string parts))))
+
+(defun vc-hg--glob-to-pcre (glob)
+ "Transform a glob pattern into a Mercurial file pattern regex."
+ (let ((parts nil) (i 0) (n (length glob)) (group 0) c)
+ (cl-macrolet ((peek () '(and (< i n) (aref glob i))))
+ (while (< i n)
+ (setf c (aref glob i))
+ (cl-incf i)
+ (cond ((not (memq c '(?* ?? ?\[ ?\{ ?\} ?, ?\\)))
+ (push (vc-hg--escape-for-pcre c) parts))
+ ((eq c ?*)
+ (cond ((eq (peek) ?*)
+ (cl-incf i)
+ (cond ((eq (peek) ?/)
+ (cl-incf i)
+ (push "(?:.*/)?" parts))
+ (t
+ (push ".*" parts))))
+ (t (push "[^/]*" parts))))
+ ((eq c ??)
+ (push ?. parts))
+ ((eq c ?\[)
+ (let ((j i))
+ (when (and (< j n) (memq (aref glob j) '(?! ?\])))
+ (cl-incf j))
+ (while (and (< j n) (not (eq (aref glob j) ?\])))
+ (cl-incf j))
+ (cond ((>= j n)
+ (push "\\[" parts))
+ (t
+ (let ((x (substring glob i j)))
+ (setf x (replace-regexp-in-string
+ "\\\\" "\\\\" x t t))
+ (setf i (1+ j))
+ (cond ((eq (aref x 0) ?!)
+ (setf (aref x 0) ?^))
+ ((eq (aref x 0) ?^)
+ (setf x (concat "\\" x))))
+ (push ?\[ parts)
+ (push x parts)
+ (push ?\] parts))))))
+ ((eq c ?\{)
+ (cl-incf group)
+ (push "(?:" parts))
+ ((eq c ?\})
+ (push ?\) parts)
+ (cl-decf group))
+ ((and (eq c ?,) (> group 0))
+ (push ?| parts))
+ ((eq c ?\\)
+ (if (eq i n)
+ (push "\\\\" parts)
+ (cl-incf i)
+ (push ?\\ parts)
+ (push c parts)))
+ (t
+ (push (vc-hg--escape-for-pcre c) parts)))))
+ (concat (vc-hg--parts-to-string parts) "$")))
+
+(defvar vc-hg--hgignore-patterns)
+(defvar vc-hg--hgignore-filenames)
+
+(defun vc-hg--hgignore-add-pcre (pcre prefix)
+ (push (vc-hg--pcre-to-elisp-re pcre prefix) vc-hg--hgignore-patterns))
+
+(defun vc-hg--hgignore-add-glob (glob prefix)
+ (push (vc-hg--pcre-to-elisp-re (vc-hg--glob-to-pcre glob) prefix)
+ vc-hg--hgignore-patterns))
+
+(defun vc-hg--hgignore-add-path (path prefix)
+ (let ((parts nil))
+ (dotimes (i (length path))
+ (push (vc-hg--escape-for-pcre (aref path i)) parts))
+ (vc-hg--hgignore-add-pcre
+ (concat "^" (vc-hg--parts-to-string parts) "$")
+ prefix)))
+
+(defun vc-hg--slurp-hgignore-1 (hgignore prefix)
+ (let ((default-syntax 'vc-hg--hgignore-add-glob))
+ (with-temp-buffer
+ (let ((attr (file-attributes hgignore)))
+ (when attr (insert-file-contents hgignore))
+ (push (list hgignore (nth 5 attr) (nth 7 attr))
+ vc-hg--hgignore-filenames))
+ (while (not (eobp))
+ ;; This list of pattern-file commands isn't complete, but it
+ ;; should cover the common cases. Remember that we fall back
+ ;; to regular hg commands if we see something we don't like.
+ (save-restriction
+ (narrow-to-region (point) (point-at-eol))
+ (cond ((looking-at "[ \t]*\\(?:#.*\\)?$"))
+ ((looking-at "syntax:[ \t]*re[ \t]*$")
+ (setf default-syntax 'vc-hg--hgignore-add-pcre))
+ ((looking-at "syntax:[ \t]*glob[ \t]*$")
+ (setf default-syntax 'vc-hg--hgignore-add-glob))
+ ((looking-at "path:\\(.+?\\)[ \t]*$")
+ (vc-hg--hgignore-add-path (match-string 1) prefix))
+ ((looking-at "glob:\\(.+?\\)[ \t]*$")
+ (vc-hg--hgignore-add-glob (match-string 1) prefix))
+ ((looking-at "re:\\(.+?\\)[ \t]*$")
+ (vc-hg--hgignore-add-pcre (match-string 1) prefix))
+ ((looking-at "\\(sub\\)?include:\\(.+?\\)[ \t]*$")
+ (let* ((sub (equal (match-string 1) "sub"))
+ (arg (match-string 2))
+ (included-file
+ (if (string-match "^/" arg) arg
+ (concat (file-name-directory hgignore) arg))))
+ (vc-hg--slurp-hgignore-1
+ included-file
+ (if sub (file-name-directory included-file) prefix))))
+ ((looking-at "[a-zA-Z0-9_]*:")
+ (signal 'vc-hg-unsupported-syntax (list (match-string 0))))
+ ((looking-at ".*$")
+ (funcall default-syntax (match-string 0) prefix))))
+ (forward-line 1)))))
+
+(cl-defstruct (vc-hg--ignore-patterns
+ (:copier nil)
+ (:constructor vc-hg--ignore-patterns-make))
+ repo
+ ignore-patterns
+ file-sources)
+
+(defun vc-hg--slurp-hgignore (repo)
+ "Read hg ignore patterns from REPO.
+REPO must be the directory name of an hg repository."
+ (cl-assert (string-match "^/\\(.*/\\)?$" repo))
+ (let* ((hgignore (concat repo ".hgignore"))
+ (vc-hg--hgignore-patterns nil)
+ (vc-hg--hgignore-filenames nil))
+ (vc-hg--slurp-hgignore-1 hgignore repo)
+ (vc-hg--ignore-patterns-make
+ :repo repo
+ :ignore-patterns (nreverse vc-hg--hgignore-patterns)
+ :file-sources (nreverse vc-hg--hgignore-filenames))))
+
+(defun vc-hg--ignore-patterns-valid-p (hgip)
+ "Return whether the cached ignore patterns in HGIP are still valid"
+ (let ((valid t)
+ (file-sources (vc-hg--ignore-patterns-file-sources hgip)))
+ (while (and file-sources valid)
+ (let* ((fs (pop file-sources))
+ (saved-mtime (nth 1 fs))
+ (saved-size (nth 2 fs))
+ (attr (file-attributes (nth 0 fs)))
+ (current-mtime (nth 5 attr))
+ (current-size (nth 7 attr)))
+ (unless (and (equal saved-mtime current-mtime)
+ (equal saved-size current-size))
+ (setf valid nil))))
+ valid))
+
+(defun vc-hg--ignore-patterns-ignored-p (hgip filename)
+ "Test whether the ignore pattern set HGIP says to ignore FILENAME.
+FILENAME must be the file's true absolute name."
+ (let ((patterns (vc-hg--ignore-patterns-ignore-patterns hgip))
+ (inhibit-changing-match-data t)
+ (ignored nil))
+ (while (and patterns (not ignored))
+ (setf ignored (string-match (pop patterns) filename)))
+ ignored))
+
+(defun vc-hg--time-to-fixnum (ts)
+ (+ (* 65536 (car ts)) (cadr ts)))
+
+(defvar vc-hg--cached-ignore-patterns nil
+ "Cached pre-parsed hg ignore patterns.")
+
+(defun vc-hg--file-ignored-p (repo repo-relative-filename)
+ (let ((hgip vc-hg--cached-ignore-patterns))
+ (unless (and hgip
+ (equal repo (vc-hg--ignore-patterns-repo hgip))
+ (vc-hg--ignore-patterns-valid-p hgip))
+ (setf vc-hg--cached-ignore-patterns nil)
+ (setf hgip (vc-hg--slurp-hgignore repo))
+ (setf vc-hg--cached-ignore-patterns hgip))
+ (vc-hg--ignore-patterns-ignored-p
+ hgip
+ (concat repo repo-relative-filename))))
+
+(defun vc-hg--read-repo-requirements (repo)
+ (cl-assert (string-match "^/\\(.*/\\)?$" repo))
+ (let* ((requires-filename (concat repo ".hg/requires")))
+ (and (file-exists-p requires-filename)
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert-file-contents-literally requires-filename)
+ (split-string (buffer-substring-no-properties
+ (point-min) (point-max)))))))
+
+(defconst vc-hg-supported-requirements
+ '("dotencode"
+ "fncache"
+ "generaldelta"
+ "lz4revlog"
+ "remotefilelog"
+ "revlogv1"
+ "store")
+ "List of Mercurial repository requirements we understand; if a
+repository requires features not present in this list, we avoid
+attempting to parse Mercurial data structures.")
+
+(defun vc-hg--requirements-understood-p (repo)
+ "Check that we understand the format of the given repository.
+REPO is the directory name of a Mercurial repository."
+ (null (cl-set-difference (vc-hg--read-repo-requirements repo)
+ vc-hg-supported-requirements
+ :test #'equal)))
+
+(defvar vc-hg--dirstate-scan-cache nil
+ "Cache of the last result of `vc-hg--raw-dirstate-search'.
+Avoids the need to repeatedly scan dirstate on repeated calls to
+`vc-hg-state', as we see during registration queries.")
+
+(defun vc-hg--cached-dirstate-search (dirstate dirstate-attr ascii-fname)
+ (let* ((mtime (nth 5 dirstate-attr))
+ (size (nth 7 dirstate-attr))
+ (cache vc-hg--dirstate-scan-cache)
+ )
+ (if (and cache
+ (equal dirstate (pop cache))
+ (equal mtime (pop cache))
+ (equal size (pop cache))
+ (equal ascii-fname (pop cache)))
+ (pop cache)
+ (let ((result (vc-hg--raw-dirstate-search dirstate ascii-fname)))
+ (setf vc-hg--dirstate-scan-cache
+ (list dirstate mtime size ascii-fname result))
+ result))))
+
+(defun vc-hg-state-fast (filename)
+ "Like `vc-hg-state', but parse internal data structures directly.
+Returns one of the usual `vc-state' enumeration values or
+`unsupported' if we need to take the slow path and run the
+hg binary."
+ (let* (truename
+ repo
+ dirstate
+ dirstate-attr
+ repo-relative-filename
+ ascii-fname)
+ (if (or
+ ;; Explicit user disable
+ (not vc-hg-parse-hg-data-structures)
+ ;; It'll probably be faster to run hg remotely
+ (file-remote-p filename)
+ (progn
+ (setf truename (file-truename filename))
+ (file-remote-p truename))
+ (not (setf repo (vc-hg-root truename)))
+ ;; dirstate must exist
+ (not (progn
+ (setf repo (expand-file-name repo))
+ (cl-assert (string-match "^/\\(.*/\\)?$" repo))
+ (setf dirstate (concat repo ".hg/dirstate"))
+ (setf dirstate-attr (file-attributes dirstate))))
+ ;; Repository must be in an understood format
+ (not (vc-hg--requirements-understood-p repo))
+ ;; Dirstate too small to be valid
+ (< (nth 7 dirstate-attr) 40)
+ ;; We want to store 32-bit unsigned values in fixnums
+ (< most-positive-fixnum 4294967295)
+ (progn
+ (setf repo-relative-filename
+ (file-relative-name truename repo))
+ (setf ascii-fname
+ (string-as-unibyte
+ (let (last-coding-system-used)
+ (encode-coding-string
+ repo-relative-filename
+ 'us-ascii t))))
+ ;; We only try dealing with ASCII filenames
+ (not (equal ascii-fname repo-relative-filename))))
+ 'unsupported
+ (let* ((dirstate-entry
+ (vc-hg--cached-dirstate-search
+ dirstate dirstate-attr ascii-fname))
+ (state (car dirstate-entry))
+ (stat (file-attributes
+ (concat repo repo-relative-filename))))
+ (cond ((eq state ?r) 'removed)
+ ((and (not state) stat)
+ (condition-case nil
+ (if (vc-hg--file-ignored-p repo repo-relative-filename)
+ 'ignored
+ 'unregistered)
+ (vc-hg-unsupported-syntax 'unsupported)))
+ ((and state (not stat)) 'missing)
+ ((eq state ?n)
+ (let ((vc-hg-size (nth 2 dirstate-entry))
+ (vc-hg-mtime (nth 3 dirstate-entry))
+ (fs-size (nth 7 stat))
+ (fs-mtime (vc-hg--time-to-fixnum (nth 5 stat))))
+ (if (and (eql vc-hg-size fs-size) (eql vc-hg-mtime fs-mtime))
+ 'up-to-date
+ 'edited)))
+ ((eq state ?a) 'added)
+ (state 'unsupported))))))
+
;;; Miscellaneous
(defun vc-hg-previous-revision (_file rev)
@@ -734,7 +1347,11 @@ commands, which only operated on marked files."
args (cddr args)))
(apply 'vc-do-async-command buffer root hg-program command args)
(with-current-buffer buffer
- (vc-run-delayed (vc-compilation-mode 'hg)))
+ (vc-run-delayed
+ (vc-compilation-mode 'hg)
+ (setq-local compile-command
+ (concat hg-program " " command " "
+ (if args (mapconcat 'identity args " ") "")))))
(vc-set-async-update buffer)))))
(defun vc-hg-pull (prompt)
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el
index 136801531d2..47e923c2095 100644
--- a/lisp/vc/vc-hooks.el
+++ b/lisp/vc/vc-hooks.el
@@ -206,17 +206,17 @@ VC commands are globally reachable under the prefix `\\[vc-prefix-map]':
(not (memq property vc-touched-properties)))
(setq vc-touched-properties (append (list property)
vc-touched-properties)))
- (put (intern file vc-file-prop-obarray) property value))
+ (put (intern (expand-file-name file) vc-file-prop-obarray) property value))
(defun vc-file-getprop (file property)
"Get per-file VC PROPERTY for FILE."
- (get (intern file vc-file-prop-obarray) property))
+ (get (intern (expand-file-name file) vc-file-prop-obarray) property))
(defun vc-file-clearprops (file)
"Clear all VC properties of FILE."
(if (boundp 'vc-parent-buffer)
(kill-local-variable 'vc-parent-buffer))
- (setplist (intern file vc-file-prop-obarray) nil))
+ (setplist (intern (expand-file-name file) vc-file-prop-obarray) nil))
;; We keep properties on each symbol naming a backend as follows:
@@ -394,7 +394,7 @@ For registered files, the possible values are:
(defun vc-user-login-name (file)
"Return the name under which the user accesses the given FILE."
- (or (and (eq (string-match tramp-file-name-regexp file) 0)
+ (or (and (file-remote-p file)
;; tramp case: execute "whoami" via tramp
(let ((default-directory (file-name-directory file))
process-file-side-effects)
@@ -468,16 +468,20 @@ status of this file. Otherwise, the value returned is one of:
`unregistered' The file is not under version control."
- ;; Note: in Emacs 22 and older, return of nil meant the file was
- ;; unregistered. This is potentially a source of
- ;; backward-compatibility bugs.
+ ;; Note: we usually return nil here for unregistered files anyway
+ ;; when called with only one argument. This doesn't seem to cause
+ ;; any problems. But if we wanted to change that, we should
+ ;; probably opt for redefining the `registered' command to return
+ ;; non-nil even for unregistered files (maybe also rename it), and
+ ;; then make sure that all `state' implementations handle
+ ;; unregistered file appropriately.
;; FIXME: New (sub)states needed (?):
;; - `copied' and `moved' (might be handled by `removed' and `added')
(or (vc-file-getprop file 'vc-state)
(when (> (length file) 0) ;Why?? --Stef
- (setq backend (or backend (vc-backend file)))
- (when backend
+ (setq backend (or backend (vc-backend file)))
+ (when backend
(vc-state-refresh file backend)))))
(defun vc-state-refresh (file backend)
@@ -495,10 +499,11 @@ status of this file. Otherwise, the value returned is one of:
If FILE is not registered, this function always returns nil."
(or (vc-file-getprop file 'vc-working-revision)
(progn
- (setq backend (or backend (vc-backend file)))
- (when backend
- (vc-file-setprop file 'vc-working-revision
- (vc-call-backend backend 'working-revision 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
@@ -807,15 +812,15 @@ In the latter case, VC mode is deactivated for this buffer."
(add-hook 'vc-mode-line-hook 'vc-mode-line nil t)
(let (backend)
(cond
- ((setq backend (with-demoted-errors (vc-backend buffer-file-name)))
+ ((setq backend (with-demoted-errors (vc-backend buffer-file-name)))
+ ;; Let the backend setup any buffer-local things he needs.
+ (vc-call-backend backend 'find-file-hook)
;; Compute the state and put it in the mode line.
(vc-mode-line buffer-file-name backend)
(unless vc-make-backup-files
;; Use this variable, not make-backup-files,
;; because this is for things that depend on the file name.
- (set (make-local-variable 'backup-inhibited) t))
- ;; Let the backend setup any buffer-local things he needs.
- (vc-call-backend backend 'find-file-hook))
+ (set (make-local-variable 'backup-inhibited) t)))
((let* ((truename (and buffer-file-truename
(expand-file-name buffer-file-truename)))
(link-type (and truename
diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el
index da425db16cf..2dd8114c0de 100644
--- a/lisp/vc/vc-rcs.el
+++ b/lisp/vc/vc-rcs.el
@@ -41,6 +41,13 @@
(require 'cl-lib)
(require 'vc))
+(declare-function vc-branch-p "vc" (rev))
+(declare-function vc-read-revision "vc"
+ (prompt &optional files backend default initial-input))
+(declare-function vc-buffer-context "vc-dispatcher" ())
+(declare-function vc-restore-buffer-context "vc-dispatcher" (context))
+(declare-function vc-setup-buffer "vc-dispatcher" (buf))
+
(defgroup vc-rcs nil
"VC RCS backend."
:version "24.1"
@@ -120,7 +127,9 @@ For a description of possible values, see `vc-check-master-templates'."
(setq result (vc-file-getprop file 'vc-checkout-model)))
(or result
(progn (vc-rcs-fetch-master-state file)
- (vc-file-getprop file 'vc-checkout-model)))))
+ (vc-file-getprop file 'vc-checkout-model))
+ ;; For non-existing files we assume strict locking.
+ 'locking)))
;;;
;;; State-querying functions
diff --git a/lisp/vc/vc-src.el b/lisp/vc/vc-src.el
index 925166af3d3..598a3adc8f1 100644
--- a/lisp/vc/vc-src.el
+++ b/lisp/vc/vc-src.el
@@ -85,6 +85,8 @@
(require 'cl-lib)
(require 'vc))
+(declare-function vc-setup-buffer "vc-dispatcher" (buf))
+
(defgroup vc-src nil
"VC SRC backend."
:version "25.1"
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-08 11:07:25 +0000