summaryrefslogtreecommitdiff
path: root/lisp/vc
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/vc')
-rw-r--r--lisp/vc/add-log.el110
-rw-r--r--lisp/vc/cvs-status.el30
-rw-r--r--lisp/vc/diff-mode.el783
-rw-r--r--lisp/vc/diff.el8
-rw-r--r--lisp/vc/ediff-init.el22
-rw-r--r--lisp/vc/ediff-merg.el2
-rw-r--r--lisp/vc/ediff-ptch.el14
-rw-r--r--lisp/vc/ediff-util.el45
-rw-r--r--lisp/vc/ediff-wind.el243
-rw-r--r--lisp/vc/ediff.el6
-rw-r--r--lisp/vc/emerge.el602
-rw-r--r--lisp/vc/log-edit.el22
-rw-r--r--lisp/vc/log-view.el16
-rw-r--r--lisp/vc/pcvs-info.el20
-rw-r--r--lisp/vc/pcvs-parse.el1
-rw-r--r--lisp/vc/pcvs.el14
-rw-r--r--lisp/vc/smerge-mode.el57
-rw-r--r--lisp/vc/vc-annotate.el4
-rw-r--r--lisp/vc/vc-bzr.el26
-rw-r--r--lisp/vc/vc-cvs.el26
-rw-r--r--lisp/vc/vc-dir.el8
-rw-r--r--lisp/vc/vc-dispatcher.el30
-rw-r--r--lisp/vc/vc-git.el155
-rw-r--r--lisp/vc/vc-hg.el67
-rw-r--r--lisp/vc/vc-hooks.el57
-rw-r--r--lisp/vc/vc-mtn.el4
-rw-r--r--lisp/vc/vc-rcs.el17
-rw-r--r--lisp/vc/vc-svn.el8
-rw-r--r--lisp/vc/vc.el254
29 files changed, 1663 insertions, 988 deletions
diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el
index 5350176e00e..f9efd44c5c7 100644
--- a/lisp/vc/add-log.el
+++ b/lisp/vc/add-log.el
@@ -239,7 +239,7 @@ a case simply use the directory containing the changed file."
;; wrongly with a non-date line existing as a random note. In
;; addition, using any kind of fixed setting like this doesn't
;; work if a user customizes add-log-time-format.
- ("^[0-9-]+ +\\|^ \\{11,\\}\\|^\t \\{3,\\}\\|^\\(Sun\\|Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\) [A-z][a-z][a-z] [0-9:+ ]+"
+ ("^[0-9-]+ +\\|^ \\{11,\\}\\|^\t \\{3,\\}\\|^\\(Sun\\|Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\) [A-Z][a-z][a-z] [0-9:+ ]+"
(0 'change-log-date)
;; Name and e-mail; some people put e-mail in parens, not angles.
("\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]" nil nil
@@ -471,6 +471,11 @@ A change log tag is a symbol within a parenthesized,
comma-separated list. If no suitable tag can be found nearby,
try to visit the file for the change under `point' instead."
(interactive)
+ (let ((buffer (current-buffer)))
+ (change-log-goto-source-internal)
+ (next-error-found buffer (current-buffer))))
+
+(defun change-log-goto-source-internal ()
(if (and (eq last-command 'change-log-goto-source)
change-log-find-tail)
(setq change-log-find-tail
@@ -539,7 +544,7 @@ Compatibility function for \\[next-error] invocations."
;; if we found a place to visit...
(when (looking-at change-log-file-names-re)
(let (change-log-find-window)
- (change-log-goto-source)
+ (change-log-goto-source-internal)
(when change-log-find-window
;; Select window displaying source file.
(select-window change-log-find-window)))))
@@ -739,6 +744,7 @@ Optional arg BUFFER-FILE overrides `buffer-file-name'."
file-name)
(defun add-log-file-name (buffer-file log-file)
+ "Compute file-name of BUFFER-FILE to be used in entries in LOG-FILE."
;; Never want to add a change log entry for the ChangeLog file itself.
(unless (or (null buffer-file) (string= buffer-file log-file))
(if add-log-file-name-function
@@ -762,15 +768,57 @@ Optional arg BUFFER-FILE overrides `buffer-file-name'."
(file-name-sans-versions buffer-file)
buffer-file))))
+(defcustom add-log-dont-create-changelog-file t
+ "If non-nil, don't create ChangeLog files for log entries.
+If a ChangeLog file does not already exist, a non-nil value
+means to put log entries in a suitably named buffer."
+ :type :boolean
+ :version "27.1")
+
+(put 'add-log-dont-create-changelog-file 'safe-local-variable 'booleanp)
+
+(defun add-log--pseudo-changelog-buffer-name (changelog-file-name)
+ "Compute a suitable name for a non-file visiting ChangeLog buffer.
+CHANGELOG-FILE-NAME is the file name of the actual ChangeLog file
+if it were to exist."
+ (format "*changes to %s*"
+ (abbreviate-file-name
+ (file-name-directory changelog-file-name))))
+
+(defun add-log--changelog-buffer-p (changelog-file-name buffer)
+ "Return non-nil if BUFFER holds a change log for CHANGELOG-FILE-NAME."
+ (with-current-buffer buffer
+ (if buffer-file-name
+ (equal buffer-file-name changelog-file-name)
+ (equal (add-log--pseudo-changelog-buffer-name changelog-file-name)
+ (buffer-name)))))
+
+(defun add-log-find-changelog-buffer (changelog-file-name)
+ "Find a ChangeLog buffer for CHANGELOG-FILE-NAME.
+Respect `add-log-use-pseudo-changelog', which see."
+ (if (or (file-exists-p changelog-file-name)
+ (not add-log-dont-create-changelog-file))
+ (find-file-noselect changelog-file-name)
+ (get-buffer-create
+ (add-log--pseudo-changelog-buffer-name changelog-file-name))))
+
;;;###autoload
-(defun add-change-log-entry (&optional whoami file-name other-window new-entry
+(defun add-change-log-entry (&optional whoami
+ changelog-file-name
+ other-window new-entry
put-new-entry-on-new-line)
- "Find change log file, and add an entry for today and an item for this file.
-Optional arg WHOAMI (interactive prefix) non-nil means prompt for user
-name and email (stored in `add-log-full-name' and `add-log-mailing-address').
-
-Second arg FILE-NAME is file name of the change log.
-If nil, use the value of `change-log-default-name'.
+ "Find ChangeLog buffer, add an entry for today and an item for this file.
+Optional arg WHOAMI (interactive prefix) non-nil means prompt for
+user name and email (stored in `add-log-full-name'
+and `add-log-mailing-address').
+
+Second arg CHANGELOG-FILE-NAME is the file name of the change log.
+If nil, use the value of `change-log-default-name'. If the file
+thus named exists, it is used for the new entry. If it doesn't
+exist, it is created, unless `add-log-dont-create-changelog-file' is t,
+in which case a suitably named buffer that doesn't visit any file
+is used for keeping entries pertaining to CHANGELOG-FILE-NAME's
+directory.
Third arg OTHER-WINDOW non-nil means visit in other window.
@@ -799,20 +847,28 @@ non-nil, otherwise in local time."
(change-log-version-number-search)))
(buf-file-name (funcall add-log-buffer-file-name-function))
(buffer-file (if buf-file-name (expand-file-name buf-file-name)))
- (file-name (expand-file-name (find-change-log file-name buffer-file)))
+ (changelog-file-name (expand-file-name (find-change-log
+ changelog-file-name
+ buffer-file)))
;; Set ITEM to the file name to use in the new item.
- (item (add-log-file-name buffer-file file-name)))
+ (item (add-log-file-name buffer-file changelog-file-name)))
- (unless (equal file-name buffer-file-name)
+ ;; don't add entries from the ChangeLog file/buffer to itself.
+ (unless (equal changelog-file-name buffer-file-name)
(cond
- ((equal file-name (buffer-file-name (window-buffer)))
+ ((add-log--changelog-buffer-p
+ changelog-file-name
+ (window-buffer))
;; If the selected window already shows the desired buffer don't show
;; it again (particularly important if other-window is true).
;; This is important for diff-add-change-log-entries-other-window.
(set-buffer (window-buffer)))
((or other-window (window-dedicated-p))
- (find-file-other-window file-name))
- (t (find-file file-name))))
+ (switch-to-buffer-other-window
+ (add-log-find-changelog-buffer changelog-file-name)))
+ (t
+ (switch-to-buffer
+ (add-log-find-changelog-buffer changelog-file-name)))))
(or (derived-mode-p 'change-log-mode)
(change-log-mode))
(undo-boundary)
@@ -1019,6 +1075,13 @@ the change log file in another window."
(defvar smerge-resolve-function)
(defvar copyright-at-end-flag)
+(defvar change-log-mode-syntax-table
+ (let ((table (make-syntax-table)))
+ (modify-syntax-entry ?` "' " table)
+ (modify-syntax-entry ?' "' " table)
+ table)
+ "Syntax table used while in `change-log-mode'.")
+
;;;###autoload
(define-derived-mode change-log-mode text-mode "Change Log"
"Major mode for editing change logs; like Indented Text mode.
@@ -1067,8 +1130,7 @@ Runs `change-log-mode-hook'.
(set (make-local-variable 'end-of-defun-function)
'change-log-end-of-defun)
;; next-error function glue
- (setq next-error-function 'change-log-next-error)
- (setq next-error-last-buffer (current-buffer)))
+ (setq next-error-function 'change-log-next-error))
(defun change-log-next-buffer (&optional buffer wrap)
"Return the next buffer in the series of ChangeLog file buffers.
@@ -1095,9 +1157,17 @@ file were isearch was started."
;; If there are no files that match the default pattern ChangeLog.[0-9],
;; return the current buffer to force isearch wrapping to its beginning.
;; If file is nil, multi-isearch-search-fun will signal "end of multi".
- (if (file-exists-p file)
- (find-file-noselect file)
- (current-buffer))))
+ (cond
+ ;; Wrapping doesn't catch errors from the nil arg of file-exists-p,
+ ;; so handle it explicitly.
+ ((and wrap (null file))
+ (current-buffer))
+ ;; When there is no next file, file-exists-p raises the error to be
+ ;; catched by the search function that displays the error message.
+ ((file-exists-p file)
+ (find-file-noselect file))
+ (t
+ (current-buffer)))))
(defun change-log-fill-forward-paragraph (n)
"Cut paragraphs so filling preserves open parentheses at beginning of lines."
diff --git a/lisp/vc/cvs-status.el b/lisp/vc/cvs-status.el
index 7fdff51607e..ccc8e5f4720 100644
--- a/lisp/vc/cvs-status.el
+++ b/lisp/vc/cvs-status.el
@@ -269,9 +269,9 @@ BEWARE: because of stability issues, this is not a symmetric operation."
(cond
((= l1 l2)
(pcase (cvs-tag-compare tag1 tag2)
- (`more1 (cons rev2 (cvs-tree-merge tree1 (cdr tree2))))
- (`more2 (cons rev1 (cvs-tree-merge (cdr tree1) tree2)))
- (`equal
+ ('more1 (cons rev2 (cvs-tree-merge tree1 (cdr tree2))))
+ ('more2 (cons rev1 (cvs-tree-merge (cdr tree1) tree2)))
+ ('equal
(cons (cons (cvs-tag-merge tag1 tag2)
(cvs-tree-merge (cvs-cdr rev1) (cvs-cdr rev2)))
(cvs-tree-merge (cdr tree1) (cdr tree2))))))
@@ -395,33 +395,33 @@ Otherwise, default to ASCII chars like +, - and |.")
(defconst cvs-tree-char-space
(pcase cvs-tree-use-charset
- (`jisx0208 (make-char 'japanese-jisx0208 33 33))
- (`unicode " ")
+ ('jisx0208 (make-char 'japanese-jisx0208 33 33))
+ ('unicode " ")
(_ " ")))
(defconst cvs-tree-char-hbar
(pcase cvs-tree-use-charset
- (`jisx0208 (make-char 'japanese-jisx0208 40 44))
- (`unicode "━")
+ ('jisx0208 (make-char 'japanese-jisx0208 40 44))
+ ('unicode "━")
(_ "--")))
(defconst cvs-tree-char-vbar
(pcase cvs-tree-use-charset
- (`jisx0208 (make-char 'japanese-jisx0208 40 45))
- (`unicode "┃")
+ ('jisx0208 (make-char 'japanese-jisx0208 40 45))
+ ('unicode "┃")
(_ "| ")))
(defconst cvs-tree-char-branch
(pcase cvs-tree-use-charset
- (`jisx0208 (make-char 'japanese-jisx0208 40 50))
- (`unicode "┣")
+ ('jisx0208 (make-char 'japanese-jisx0208 40 50))
+ ('unicode "┣")
(_ "+-")))
(defconst cvs-tree-char-eob ;end of branch
(pcase cvs-tree-use-charset
- (`jisx0208 (make-char 'japanese-jisx0208 40 49))
- (`unicode "┗")
+ ('jisx0208 (make-char 'japanese-jisx0208 40 49))
+ ('unicode "┗")
(_ "`-")))
(defconst cvs-tree-char-bob ;beginning of branch
(pcase cvs-tree-use-charset
- (`jisx0208 (make-char 'japanese-jisx0208 40 51))
- (`unicode "┳")
+ ('jisx0208 (make-char 'japanese-jisx0208 40 51))
+ ('unicode "┳")
(_ "+-")))
(defun cvs-tag-lessp (tag1 tag2)
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index d8d35d6682e..1d5a2cf69ab 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -55,6 +55,9 @@
;;; Code:
(eval-when-compile (require 'cl-lib))
+(autoload 'vc-find-revision "vc")
+(autoload 'vc-find-revision-no-save "vc")
+(defvar vc-find-revision-no-save)
(defvar add-log-buffer-file-name-function)
@@ -66,14 +69,12 @@
(defcustom diff-default-read-only nil
"If non-nil, `diff-mode' buffers default to being read-only."
- :type 'boolean
- :group 'diff-mode)
+ :type 'boolean)
(defcustom diff-jump-to-old-file nil
"Non-nil means `diff-goto-source' jumps to the old file.
Else, it jumps to the new file."
- :type 'boolean
- :group 'diff-mode)
+ :type 'boolean)
(defcustom diff-update-on-the-fly t
"Non-nil means hunk headers are kept up-to-date on-the-fly.
@@ -82,23 +83,70 @@ 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)."
- :type 'boolean
- :group 'diff-mode)
+ :type 'boolean)
(defcustom diff-advance-after-apply-hunk t
"Non-nil means `diff-apply-hunk' will move to the next hunk after applying."
- :type 'boolean
- :group 'diff-mode)
+ :type 'boolean)
(defcustom diff-mode-hook nil
"Run after setting up the `diff-mode' major mode."
:type 'hook
- :options '(diff-delete-empty-files diff-make-unified)
- :group 'diff-mode)
+ :options '(diff-delete-empty-files diff-make-unified))
+
+(defcustom diff-refine 'font-lock
+ "If non-nil, enable hunk refinement.
+
+The value `font-lock' means to refine during font-lock.
+The value `navigation' means to refine each hunk as you visit it
+with `diff-hunk-next' or `diff-hunk-prev'.
+
+You can always manually refine a hunk with `diff-refine-hunk'."
+ :version "27.1"
+ :type '(choice (const :tag "Don't refine hunks" nil)
+ (const :tag "Refine hunks during font-lock" font-lock)
+ (const :tag "Refine hunks during navigation" navigation)))
+
+(defcustom diff-font-lock-prettify nil
+ "If non-nil, font-lock will try and make the format prettier."
+ :version "27.1"
+ :type 'boolean)
+
+(defcustom diff-font-lock-syntax t
+ "If non-nil, diff hunk font-lock includes source language syntax highlighting.
+This highlighting is the same as added by `font-lock-mode'
+when corresponding source files are visited normally.
+Syntax highlighting is added over diff-mode's own highlighted changes.
+
+If t, the default, highlight syntax only in Diff buffers created by Diff
+commands that compare files or by VC commands that compare revisions.
+These provide all necessary context for reliable highlighting. This value
+requires support from a VC backend to find the files being compared.
+For diffs against the working-tree version of a file, the highlighting is
+based on the current file contents. File-based fontification tries to
+infer fontification from the compared files.
+
+If `hunk-only' fontification is based on hunk alone, without full source.
+It tries to highlight hunks without enough context that sometimes might result
+in wrong fontification. This is the fastest option, but less reliable.
+
+If `hunk-also', use reliable file-based syntax highlighting when available
+and hunk-based syntax highlighting otherwise as a fallback."
+ :version "27.1"
+ :type '(choice (const :tag "Don't highlight syntax" nil)
+ (const :tag "Hunk-based only" hunk-only)
+ (const :tag "Highlight syntax" t)
+ (const :tag "Allow hunk-based fallback" hunk-also)))
(defvar diff-vc-backend nil
"The VC backend that created the current Diff buffer, if any.")
+(defvar diff-vc-revisions nil
+ "The VC revisions compared in the current Diff buffer, if any.")
+
+(defvar-local diff-default-directory nil
+ "The default directory where the current Diff buffer was created.")
+
(defvar diff-outline-regexp
"\\([*+][*+][*+] [^0-9]\\|@@ ...\\|\\*\\*\\* [0-9].\\|--- [0-9]..\\)")
@@ -207,27 +255,29 @@ when editing big diffs)."
(defcustom diff-minor-mode-prefix "\C-c="
"Prefix key for `diff-minor-mode' commands."
- :type '(choice (string "\e") (string "C-c=") string)
- :group 'diff-mode)
+ :type '(choice (string "\e") (string "C-c=") string))
(easy-mmode-defmap diff-minor-mode-map
`((,diff-minor-mode-prefix . ,diff-mode-shared-map))
"Keymap for `diff-minor-mode'. See also `diff-mode-shared-map'.")
(define-minor-mode diff-auto-refine-mode
- "Toggle automatic diff hunk highlighting (Diff Auto Refine mode).
-With a prefix argument ARG, enable Diff Auto Refine mode if ARG
-is positive, and disable it otherwise. If called from Lisp,
-enable the mode if ARG is omitted or nil.
+ "Toggle automatic diff hunk finer highlighting (Diff Auto Refine mode).
Diff Auto Refine mode is a buffer-local minor mode used with
`diff-mode'. When enabled, Emacs automatically highlights
changes in detail as the user visits hunks. When transitioning
from disabled to enabled, it tries to refine the current hunk, as
well."
- :group 'diff-mode :init-value t :lighter nil ;; " Auto-Refine"
- (when diff-auto-refine-mode
- (condition-case-unless-debug nil (diff-refine-hunk) (error nil))))
+ :group 'diff-mode :init-value nil :lighter nil ;; " Auto-Refine"
+ (if diff-auto-refine-mode
+ (progn
+ (customize-set-variable 'diff-refine 'navigation)
+ (condition-case-unless-debug nil (diff-refine-hunk) (error nil)))
+ (customize-set-variable 'diff-refine nil)))
+(make-obsolete 'diff-auto-refine-mode "set `diff-refine' instead." "27.1")
+(make-obsolete-variable 'diff-auto-refine-mode
+ "set `diff-refine' instead." "27.1")
;;;;
;;;; font-lock support
@@ -235,105 +285,95 @@ well."
(defface diff-header
'((((class color) (min-colors 88) (background light))
- :background "grey80")
+ :background "grey85")
(((class color) (min-colors 88) (background dark))
:background "grey45")
(((class color))
:foreground "blue1" :weight bold)
(t :weight bold))
- "`diff-mode' face inherited by hunk and index header faces."
- :group 'diff-mode)
+ "`diff-mode' face inherited by hunk and index header faces.")
(defface diff-file-header
'((((class color) (min-colors 88) (background light))
- :background "grey70" :weight bold)
+ :background "grey75" :weight bold)
(((class color) (min-colors 88) (background dark))
:background "grey60" :weight bold)
(((class color))
:foreground "cyan" :weight bold)
(t :weight bold)) ; :height 1.3
- "`diff-mode' face used to highlight file header lines."
- :group 'diff-mode)
+ "`diff-mode' face used to highlight file header lines.")
(defface diff-index
'((t :inherit diff-file-header))
- "`diff-mode' face used to highlight index header lines."
- :group 'diff-mode)
+ "`diff-mode' face used to highlight index header lines.")
(defface diff-hunk-header
'((t :inherit diff-header))
- "`diff-mode' face used to highlight hunk header lines."
- :group 'diff-mode)
+ "`diff-mode' face used to highlight hunk header lines.")
(defface diff-removed
'((default
:inherit diff-changed)
(((class color) (min-colors 88) (background light))
- :background "#ffdddd")
+ :background "#ffeeee")
(((class color) (min-colors 88) (background dark))
:background "#553333")
(((class color))
:foreground "red"))
- "`diff-mode' face used to highlight removed lines."
- :group 'diff-mode)
+ "`diff-mode' face used to highlight removed lines.")
(defface diff-added
'((default
:inherit diff-changed)
(((class color) (min-colors 88) (background light))
- :background "#ddffdd")
+ :background "#eeffee")
(((class color) (min-colors 88) (background dark))
:background "#335533")
(((class color))
:foreground "green"))
- "`diff-mode' face used to highlight added lines."
- :group 'diff-mode)
+ "`diff-mode' face used to highlight added lines.")
(defface diff-changed
'((t nil))
"`diff-mode' face used to highlight changed lines."
- :version "25.1"
- :group 'diff-mode)
+ :version "25.1")
(defface diff-indicator-removed
- '((t :inherit diff-removed))
+ '((default :inherit diff-removed)
+ (((class color) (min-colors 88))
+ :foreground "#aa2222"))
"`diff-mode' face used to highlight indicator of removed lines (-, <)."
- :group 'diff-mode
:version "22.1")
(defvar diff-indicator-removed-face 'diff-indicator-removed)
(defface diff-indicator-added
- '((t :inherit diff-added))
+ '((default :inherit diff-added)
+ (((class color) (min-colors 88))
+ :foreground "#22aa22"))
"`diff-mode' face used to highlight indicator of added lines (+, >)."
- :group 'diff-mode
:version "22.1")
(defvar diff-indicator-added-face 'diff-indicator-added)
(defface diff-indicator-changed
- '((t :inherit diff-changed))
+ '((default :inherit diff-changed)
+ (((class color) (min-colors 88))
+ :foreground "#aaaa22"))
"`diff-mode' face used to highlight indicator of changed lines."
- :group 'diff-mode
:version "22.1")
(defvar diff-indicator-changed-face 'diff-indicator-changed)
(defface diff-function
'((t :inherit diff-header))
- "`diff-mode' face used to highlight function names produced by \"diff -p\"."
- :group 'diff-mode)
+ "`diff-mode' face used to highlight function names produced by \"diff -p\".")
(defface diff-context
- '((((class color grayscale) (min-colors 88) (background light))
- :foreground "#333333")
- (((class color grayscale) (min-colors 88) (background dark))
- :foreground "#dddddd"))
+ '((t nil))
"`diff-mode' face used to highlight context and other side-information."
- :version "25.1"
- :group 'diff-mode)
+ :version "25.1")
(defface diff-nonexistent
'((t :inherit diff-file-header))
- "`diff-mode' face used to highlight nonexistent files in recursive diffs."
- :group 'diff-mode)
+ "`diff-mode' face used to highlight nonexistent files in recursive diffs.")
(defconst diff-yank-handler '(diff-yank-function))
(defun diff-yank-function (text)
@@ -408,11 +448,17 @@ and the face `diff-added' for added lines.")
'diff-removed))))))
("^\\(?:Index\\|revno\\): \\(.+\\).*\n"
(0 'diff-header) (1 'diff-index prepend))
+ ("^\\(?:index .*\\.\\.\\|diff \\).*\n" . 'diff-header)
+ ("^\\(?:new\\|deleted\\) file mode .*\n" . 'diff-header)
("^Only in .*\n" . 'diff-nonexistent)
+ ("^Binary files .* differ\n" . 'diff-file-header)
("^\\(#\\)\\(.*\\)"
(1 font-lock-comment-delimiter-face)
(2 font-lock-comment-face))
- ("^[^-=+*!<>#].*\n" (0 'diff-context))))
+ ("^[^-=+*!<>#].*\n" (0 'diff-context))
+ (,#'diff--font-lock-syntax)
+ (,#'diff--font-lock-prettify)
+ (,#'diff--font-lock-refined)))
(defconst diff-font-lock-defaults
'(diff-font-lock-keywords t nil nil nil (font-lock-multiline . nil)))
@@ -481,13 +527,14 @@ See https://lists.gnu.org/r/emacs-devel/2007-11/msg01990.html")
(unless end
(setq end (and (re-search-forward
(pcase style
- (`unified
+ ('unified
(concat (if diff-valid-unified-empty-line
"^[^-+# \\\n]\\|" "^[^-+# \\]\\|")
;; A `unified' header is ambiguous.
diff-file-header-re))
- (`context "^[^-+#! \\]")
- (`normal "^[^<>#\\]")
+ ('context (if diff-valid-unified-empty-line
+ "^[^-+#! \n\\]" "^[^-+#! \\]"))
+ ('normal "^[^<>#\\]")
(_ "^[^-+#!<> \\]"))
nil t)
(match-beginning 0)))
@@ -590,7 +637,7 @@ 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
+ (when (and (eq diff-refine 'navigation) (called-interactively-p 'interactive))
(unless (prog1 diff--auto-refine-data
(setq diff--auto-refine-data
(cons (current-buffer) (point-marker))))
@@ -891,7 +938,7 @@ PREFIX is only used internally: don't use it."
(if (and newfile (file-exists-p newfile)) (cl-return newfile))))
;; look for each file in turn. If none found, try again but
;; ignoring the first level of directory, ...
- (cl-do* ((files fs (delq nil (mapcar 'diff-filename-drop-dir files)))
+ (cl-do* ((files fs (delq nil (mapcar #'diff-filename-drop-dir files)))
(file nil nil))
((or (null files)
(setq file (cl-do* ((files files (cdr files))
@@ -1018,7 +1065,7 @@ else cover the whole buffer."
" ----\n" hunk))
;;(goto-char (point-min))
(forward-line 1)
- (if (not (save-excursion (re-search-forward "^+" nil t)))
+ (if (not (save-excursion (re-search-forward "^\\+" nil t)))
(delete-region (point) (point-max))
(let ((modif nil) (delete nil))
(if (save-excursion (re-search-forward "^\\+.*\n-"
@@ -1351,6 +1398,14 @@ See `after-change-functions' for the meaning of BEG, END and LEN."
(diff-hunk-next arg)
(diff-goto-source))
+(defun diff--font-lock-cleanup ()
+ (remove-overlays nil nil 'diff-mode 'fine)
+ (remove-overlays nil nil 'diff-mode 'syntax)
+ (when font-lock-mode
+ (make-local-variable 'font-lock-extra-managed-props)
+ ;; Added when diff--font-lock-prettify is non-nil!
+ (cl-pushnew 'display font-lock-extra-managed-props)))
+
(defvar whitespace-style)
(defvar whitespace-trailing-regexp)
@@ -1368,12 +1423,10 @@ You can also switch between context diff and unified diff with \\[diff-context->
or vice versa with \\[diff-unified->context] and you can also reverse the direction of
a diff with \\[diff-reverse-direction].
- \\{diff-mode-map}"
+\\{diff-mode-map}"
(set (make-local-variable 'font-lock-defaults) diff-font-lock-defaults)
- (add-hook 'font-lock-mode-hook
- (lambda () (remove-overlays nil nil 'diff-mode 'fine))
- nil 'local)
+ (add-hook 'font-lock-mode-hook #'diff--font-lock-cleanup nil 'local)
(set (make-local-variable 'outline-regexp) diff-outline-regexp)
(set (make-local-variable 'imenu-generic-expression)
diff-imenu-generic-expression)
@@ -1387,12 +1440,12 @@ a diff with \\[diff-reverse-direction].
;; (set (make-local-variable 'paragraph-separate) paragraph-start)
;; (set (make-local-variable 'page-delimiter) "--- [^\t]+\t")
;; compile support
- (set (make-local-variable 'next-error-function) 'diff-next-error)
+ (set (make-local-variable 'next-error-function) #'diff-next-error)
(set (make-local-variable 'beginning-of-defun-function)
- 'diff-beginning-of-file-and-junk)
+ #'diff-beginning-of-file-and-junk)
(set (make-local-variable 'end-of-defun-function)
- 'diff-end-of-file)
+ #'diff-end-of-file)
(diff-setup-whitespace)
@@ -1400,10 +1453,10 @@ a diff with \\[diff-reverse-direction].
(setq buffer-read-only t))
;; setup change hooks
(if (not diff-update-on-the-fly)
- (add-hook 'write-contents-functions 'diff-write-contents-hooks nil t)
+ (add-hook 'write-contents-functions #'diff-write-contents-hooks nil t)
(make-local-variable 'diff-unhandled-changes)
- (add-hook 'after-change-functions 'diff-after-change-function nil t)
- (add-hook 'post-command-hook 'diff-post-command-hook nil t))
+ (add-hook 'after-change-functions #'diff-after-change-function nil t)
+ (add-hook 'post-command-hook #'diff-post-command-hook nil t))
;; Neat trick from Dave Love to add more bindings in read-only mode:
(let ((ro-bind (cons 'buffer-read-only diff-mode-shared-map)))
(add-to-list 'minor-mode-overriding-map-alist ro-bind)
@@ -1415,28 +1468,27 @@ a diff with \\[diff-reverse-direction].
nil t))
;; add-log support
(set (make-local-variable 'add-log-current-defun-function)
- 'diff-current-defun)
+ #'diff-current-defun)
(set (make-local-variable 'add-log-buffer-file-name-function)
(lambda () (diff-find-file-name nil 'noprompt)))
- (unless (buffer-file-name)
+ (add-function :filter-return (local 'filter-buffer-substring-function)
+ #'diff--filter-substring)
+ (unless buffer-file-name
(hack-dir-local-variables-non-file-buffer)))
;;;###autoload
(define-minor-mode diff-minor-mode
"Toggle Diff minor mode.
-With a prefix argument ARG, enable Diff minor mode if ARG is
-positive, and disable it otherwise. If called from Lisp, enable
-the mode if ARG is omitted or nil.
\\{diff-minor-mode-map}"
:group 'diff-mode :lighter " Diff"
;; FIXME: setup font-lock
;; setup change hooks
(if (not diff-update-on-the-fly)
- (add-hook 'write-contents-functions 'diff-write-contents-hooks nil t)
+ (add-hook 'write-contents-functions #'diff-write-contents-hooks nil t)
(make-local-variable 'diff-unhandled-changes)
- (add-hook 'after-change-functions 'diff-after-change-function nil t)
- (add-hook 'post-command-hook 'diff-post-command-hook nil t)))
+ (add-hook 'after-change-functions #'diff-after-change-function nil t)
+ (add-hook 'post-command-hook #'diff-post-command-hook nil t)))
;;; Handy hook functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1463,12 +1515,12 @@ modified lines of the diff."
;; can just remove the file altogether. Very handy for .rej files if we
;; remove hunks as we apply them.
(when (and buffer-file-name
- (eq 0 (nth 7 (file-attributes buffer-file-name))))
+ (eq 0 (file-attribute-size (file-attributes buffer-file-name))))
(delete-file buffer-file-name)))
(defun diff-delete-empty-files ()
"Arrange for empty diff files to be removed."
- (add-hook 'after-save-hook 'diff-delete-if-empty nil t))
+ (add-hook 'after-save-hook #'diff-delete-if-empty nil t))
(defun diff-make-unified ()
"Turn context diffs into unified diffs if applicable."
@@ -1662,10 +1714,11 @@ char-offset in TEXT."
(delete-region divider-pos (point-max)))
(delete-region (point-min) keep))
;; Remove line-prefix characters, and unneeded lines (unified diffs).
- (let ((kill-char (if destp ?- ?+)))
+ ;; Also skip lines like "\ No newline at end of file"
+ (let ((kill-chars (list (if destp ?- ?+) ?\\)))
(goto-char (point-min))
(while (not (eobp))
- (if (eq (char-after) kill-char)
+ (if (memq (char-after) kill-chars)
(delete-region (point) (progn (forward-line 1) (point)))
(delete-char num-pfx-chars)
(forward-line 1)))))
@@ -1693,7 +1746,7 @@ If TEXT isn't found, nil is returned."
Whitespace differences are ignored."
(let* ((orig (point))
(re (concat "^[ \t\n ]*"
- (mapconcat 'regexp-quote (split-string text) "[ \t\n ]+")
+ (mapconcat #'regexp-quote (split-string text) "[ \t\n ]+")
"[ \t\n ]*\n"))
(forw (and (re-search-forward re nil t)
(cons (match-beginning 0) (match-end 0))))
@@ -1742,7 +1795,15 @@ NOPROMPT, if non-nil, means not to prompt the user."
(match-string 1)))))
(file (or (diff-find-file-name other noprompt)
(error "Can't find the file")))
- (buf (find-file-noselect file)))
+ (revision (and other diff-vc-backend
+ (if reverse (nth 1 diff-vc-revisions)
+ (or (nth 0 diff-vc-revisions)
+ ;; When diff shows changes in working revision
+ (vc-working-revision file)))))
+ (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))))
;; Update the user preference if he so wished.
(when (> (prefix-numeric-value other-file) 8)
(setq diff-jump-to-old-file other))
@@ -1868,18 +1929,24 @@ With a prefix argument, try to REVERSE the hunk."
`diff-jump-to-old-file' (or its opposite if the OTHER-FILE prefix arg
is given) determines whether to jump to the old or the new file.
If the prefix arg is bigger than 8 (for example with \\[universal-argument] \\[universal-argument])
-then `diff-jump-to-old-file' is also set, for the next invocations."
+then `diff-jump-to-old-file' is also set, for the next invocations.
+
+Under version control, the OTHER-FILE prefix arg means jump to the old
+revision of the file if point is on an old changed line, or to the new
+revision of the file otherwise."
(interactive (list current-prefix-arg last-input-event))
;; When pointing at a removal line, we probably want to jump to
;; the old location, and else to the new (i.e. as if reverting).
;; This is a convenient detail when using smerge-diff.
(if event (posn-set-point (event-end event)))
- (let ((rev (not (save-excursion (beginning-of-line) (looking-at "[-<]")))))
+ (let ((buffer (when event (current-buffer)))
+ (reverse (not (save-excursion (beginning-of-line) (looking-at "[-<]")))))
(pcase-let ((`(,buf ,line-offset ,pos ,src ,_dst ,switched)
- (diff-find-source-location other-file rev)))
+ (diff-find-source-location other-file reverse)))
(pop-to-buffer buf)
(goto-char (+ (car pos) (cdr src)))
- (diff-hunk-status-msg line-offset (diff-xor rev switched) t))))
+ (when buffer (next-error-found buffer (current-buffer)))
+ (diff-hunk-status-msg line-offset (diff-xor reverse switched) t))))
(defun diff-current-defun ()
@@ -1968,29 +2035,26 @@ For use in `add-log-current-defun-function'."
(((class color) (min-colors 88) (background dark))
:background "#aaaa22")
(t :inverse-video t))
- "Face used for char-based changes shown by `diff-refine-hunk'."
- :group 'diff-mode)
+ "Face used for char-based changes shown by `diff-refine-hunk'.")
(defface diff-refine-removed
'((default
:inherit diff-refine-changed)
(((class color) (min-colors 88) (background light))
- :background "#ffbbbb")
+ :background "#ffcccc")
(((class color) (min-colors 88) (background dark))
:background "#aa2222"))
"Face used for removed characters shown by `diff-refine-hunk'."
- :group 'diff-mode
:version "24.3")
(defface diff-refine-added
'((default
:inherit diff-refine-changed)
(((class color) (min-colors 88) (background light))
- :background "#aaffaa")
+ :background "#bbffbb")
(((class color) (min-colors 88) (background dark))
:background "#22aa22"))
"Face used for added characters shown by `diff-refine-hunk'."
- :group 'diff-mode
:version "24.3")
(defun diff-refine-preproc ()
@@ -2017,59 +2081,112 @@ Return new point, if it was moved."
(defun diff-refine-hunk ()
"Highlight changes of hunk at point at a finer granularity."
(interactive)
- (require 'smerge-mode)
(when (diff--some-hunks-p)
(save-excursion
- (diff-beginning-of-hunk t)
- (let* ((start (point))
- (style (diff-hunk-style)) ;Skips the hunk header as well.
- (beg (point))
- (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))))
-
- (remove-overlays beg end 'diff-mode 'fine)
+ (let ((beg (diff-beginning-of-hunk t))
+ ;; Be careful to start from the hunk header so diff-end-of-hunk
+ ;; gets to read the hunk header's line info.
+ (end (progn (diff-end-of-hunk) (point))))
+ (diff--refine-hunk beg end)))))
+(defun diff--refine-hunk (start end)
+ (require 'smerge-mode)
+ (goto-char start)
+ (let* ((style (diff-hunk-style)) ;Skips the hunk header as well.
+ (beg (point))
+ (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))))
+
+ (remove-overlays beg end 'diff-mode 'fine)
+
+ (goto-char beg)
+ (pcase style
+ ('unified
+ (while (re-search-forward "^-" end t)
+ (let ((beg-del (progn (beginning-of-line) (point)))
+ beg-add end-add)
+ (when (and (diff--forward-while-leading-char ?- end)
+ ;; Allow for "\ No newline at end of file".
+ (progn (diff--forward-while-leading-char ?\\ end)
+ (setq beg-add (point)))
+ (diff--forward-while-leading-char ?+ end)
+ (progn (diff--forward-while-leading-char ?\\ end)
+ (setq end-add (point))))
+ (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)))
+ (other middle))
+ (while (re-search-forward "^\\(?:!.*\n\\)+" middle t)
+ (smerge-refine-regions (match-beginning 0) (match-end 0)
+ (save-excursion
+ (goto-char other)
+ (re-search-forward "^\\(?:!.*\n\\)+" end)
+ (setq other (match-end 0))
+ (match-beginning 0))
+ other
+ (if diff-use-changed-face props-c)
+ #'diff-refine-preproc
+ (unless diff-use-changed-face props-r)
+ (unless diff-use-changed-face props-a)))))
+ (_ ;; Normal diffs.
+ (let ((beg1 (1+ (point))))
+ (when (re-search-forward "^---.*\n" end t)
+ ;; It's a combined add&remove, so there's something to do.
+ (smerge-refine-regions beg1 (match-beginning 0)
+ (match-end 0) end
+ nil #'diff-refine-preproc props-r props-a)))))))
+
+(defun diff--iterate-hunks (max fun)
+ "Iterate over all hunks between point and MAX.
+Call FUN with two args (BEG and END) for each hunk."
+ (save-excursion
+ (let* ((beg (or (ignore-errors (diff-beginning-of-hunk))
+ (ignore-errors (diff-hunk-next) (point))
+ max)))
+ (while (< beg max)
(goto-char beg)
- (pcase style
- (`unified
- (while (re-search-forward "^-" end t)
- (let ((beg-del (progn (beginning-of-line) (point)))
- beg-add end-add)
- (when (and (diff--forward-while-leading-char ?- end)
- ;; Allow for "\ No newline at end of file".
- (progn (diff--forward-while-leading-char ?\\ end)
- (setq beg-add (point)))
- (diff--forward-while-leading-char ?+ end)
- (progn (diff--forward-while-leading-char ?\\ end)
- (setq end-add (point))))
- (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 "^---")))
- (other middle))
- (while (re-search-forward "^\\(?:!.*\n\\)+" middle t)
- (smerge-refine-regions (match-beginning 0) (match-end 0)
- (save-excursion
- (goto-char other)
- (re-search-forward "^\\(?:!.*\n\\)+" end)
- (setq other (match-end 0))
- (match-beginning 0))
- other
- (if diff-use-changed-face props-c)
- 'diff-refine-preproc
- (unless diff-use-changed-face props-r)
- (unless diff-use-changed-face props-a)))))
- (_ ;; Normal diffs.
- (let ((beg1 (1+ (point))))
- (when (re-search-forward "^---.*\n" end t)
- ;; It's a combined add&remove, so there's something to do.
- (smerge-refine-regions beg1 (match-beginning 0)
- (match-end 0) end
- nil 'diff-refine-preproc props-r props-a)))))))))
+ (cl-assert (looking-at diff-hunk-header-re))
+ (let ((end
+ (save-excursion (diff-end-of-hunk) (point))))
+ (cl-assert (< beg end))
+ (funcall fun beg end)
+ (goto-char end)
+ (setq beg (if (looking-at diff-hunk-header-re)
+ end
+ (or (ignore-errors (diff-hunk-next) (point))
+ max))))))))
+
+(defun diff--font-lock-refined (max)
+ "Apply hunk refinement from font-lock."
+ (when (eq diff-refine 'font-lock)
+ (when (get-char-property (point) 'diff--font-lock-refined)
+ ;; Refinement works over a complete hunk, whereas font-lock limits itself
+ ;; to highlighting smallish chunks between point..max, so we may be
+ ;; called N times for a large hunk in which case we don't want to
+ ;; rehighlight that hunk N times (especially since each highlighting
+ ;; of a large hunk can itself take a long time, adding insult to injury).
+ ;; So, after refining a hunk (including a failed attempt), we place an
+ ;; overlay over the whole hunk to mark it as refined, to avoid redoing
+ ;; the job redundantly when asked to highlight subsequent parts of the
+ ;; same hunk.
+ (goto-char (next-single-char-property-change
+ (point) 'diff--font-lock-refined nil max)))
+ (diff--iterate-hunks
+ max
+ (lambda (beg end)
+ (unless (get-char-property beg 'diff--font-lock-refined)
+ (diff--refine-hunk beg end)
+ (let ((ol (make-overlay beg end)))
+ (overlay-put ol 'diff--font-lock-refined t)
+ (overlay-put ol 'diff-mode 'fine)
+ (overlay-put ol 'evaporate t)
+ (overlay-put ol 'modification-hooks
+ '(diff--overlay-auto-delete))))))))
+
+(defun diff--overlay-auto-delete (ol _after _beg _end &optional _len)
+ (delete-overlay ol))
(defun diff-undo (&optional arg)
"Perform `undo', ignoring the buffer's read-only status."
@@ -2095,7 +2212,7 @@ I.e. like `add-change-log-entry-other-window' but applied to all hunks."
;; `add-change-log-entry-other-window' works better in
;; that case.
(re-search-forward
- (concat "\n[!+-<>]"
+ (concat "\n[!+<>-]"
;; If the hunk is a context hunk with an empty first
;; half, recognize the "--- NNN,MMM ----" line
"\\(-- [0-9]+\\(,[0-9]+\\)? ----\n"
@@ -2175,6 +2292,384 @@ fixed, visit it in a buffer."
modified-buffers ", "))
(message "No trailing whitespace to delete.")))))
+
+;;; Prettifying from font-lock
+
+(define-fringe-bitmap 'diff-fringe-add
+ [#b00000000
+ #b00000000
+ #b00010000
+ #b00010000
+ #b01111100
+ #b00010000
+ #b00010000
+ #b00000000
+ #b00000000]
+ nil nil 'center)
+
+(define-fringe-bitmap 'diff-fringe-del
+ [#b00000000
+ #b00000000
+ #b00000000
+ #b00000000
+ #b01111100
+ #b00000000
+ #b00000000
+ #b00000000
+ #b00000000]
+ nil nil 'center)
+
+(define-fringe-bitmap 'diff-fringe-rep
+ [#b00000000
+ #b00010000
+ #b00010000
+ #b00010000
+ #b00010000
+ #b00010000
+ #b00000000
+ #b00010000
+ #b00000000]
+ nil nil 'center)
+
+(define-fringe-bitmap 'diff-fringe-nul
+ ;; Maybe there should be such an "empty" bitmap defined by default?
+ [#b00000000
+ #b00000000
+ #b00000000
+ #b00000000
+ #b00000000
+ #b00000000
+ #b00000000
+ #b00000000
+ #b00000000]
+ nil nil 'center)
+
+(defun diff--font-lock-prettify (limit)
+ (when diff-font-lock-prettify
+ (save-excursion
+ ;; FIXME: Include the first space for context-style hunks!
+ (while (re-search-forward "^[-+! ]" limit t)
+ (let ((spec (alist-get (char-before)
+ '((?+ . (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))))))
+ (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.
+ (while (re-search-forward "^diff " limit t)
+ ;; FIXME: Switching between context<->unified leads to messed up
+ ;; file headers by cutting the `display' property in chunks!
+ (when (save-excursion
+ (forward-line 0)
+ (looking-at
+ (eval-when-compile
+ (concat "diff.*\n"
+ "\\(?:\\(?:new file\\|deleted\\).*\n\\)?"
+ "\\(?:index.*\n\\)?"
+ "--- \\(?:/dev/null\\|a/\\(.*\\)\\)\n"
+ "\\+\\+\\+ \\(?:/dev/null\\|b/\\(.*\\)\\)\n"))))
+ (put-text-property (match-beginning 0)
+ (or (match-beginning 2) (match-beginning 1))
+ 'display (propertize
+ (cond
+ ((null (match-beginning 1)) "new file ")
+ ((null (match-beginning 2)) "deleted ")
+ (t "modified "))
+ 'face '(diff-file-header diff-header)))
+ (unless (match-beginning 2)
+ (put-text-property (match-end 1) (1- (match-end 0))
+ 'display "")))))
+ nil)
+
+;;; Syntax highlighting from font-lock
+
+(defun diff--font-lock-syntax (max)
+ "Apply source language syntax highlighting from font-lock.
+Calls `diff-syntax-fontify' on every hunk found between point
+and the position in MAX."
+ (when diff-font-lock-syntax
+ (when (get-char-property (point) 'diff--font-lock-syntax)
+ (goto-char (next-single-char-property-change
+ (point) 'diff--font-lock-syntax nil max)))
+ (diff--iterate-hunks
+ max
+ (lambda (beg end)
+ (unless (get-char-property beg 'diff--font-lock-syntax)
+ (diff-syntax-fontify beg end)
+ (let ((ol (make-overlay beg end)))
+ (overlay-put ol 'diff--font-lock-syntax t)
+ (overlay-put ol 'diff-mode 'syntax)
+ (overlay-put ol 'evaporate t)
+ (overlay-put ol 'modification-hooks
+ '(diff--overlay-auto-delete))))))))
+
+(defun diff-syntax-fontify (beg end)
+ "Highlight source language syntax in diff hunk between BEG and END."
+ (remove-overlays beg end 'diff-mode 'syntax)
+ (save-excursion
+ (diff-syntax-fontify-hunk beg end t)
+ (diff-syntax-fontify-hunk beg end nil)))
+
+(eval-when-compile (require 'subr-x)) ; for string-trim-right
+
+(defvar-local diff--syntax-file-attributes nil)
+(put 'diff--syntax-file-attributes 'permanent-local t)
+
+(defun diff-syntax-fontify-hunk (beg end old)
+ "Highlight source language syntax in diff hunk between BEG and END.
+When OLD is non-nil, highlight the hunk from the old source."
+ (goto-char beg)
+ (let* ((hunk (buffer-substring-no-properties beg end))
+ ;; Trim a trailing newline to find hunk in diff-syntax-fontify-props
+ ;; in diffs that have no newline at end of diff file.
+ (text (string-trim-right
+ (or (with-demoted-errors (diff-hunk-text hunk (not old) nil))
+ "")))
+ (line (if (looking-at "\\(?:\\*\\{15\\}.*\n\\)?[-@* ]*\\([0-9,]+\\)\\([ acd+]+\\([0-9,]+\\)\\)?")
+ (if old (match-string 1)
+ (if (match-end 3) (match-string 3) (match-string 1)))))
+ (line-nb (when line
+ (if (string-match "\\([0-9]+\\),\\([0-9]+\\)" line)
+ (list (string-to-number (match-string 1 line))
+ (string-to-number (match-string 2 line)))
+ (list (string-to-number line) 1)))) ; One-line diffs
+ (props
+ (or
+ (when (and diff-vc-backend
+ (not (eq diff-font-lock-syntax 'hunk-only)))
+ (let* ((file (diff-find-file-name old t))
+ (revision (and file (if (not old) (nth 1 diff-vc-revisions)
+ (or (nth 0 diff-vc-revisions)
+ (vc-working-revision file))))))
+ (when file
+ (if (not revision)
+ ;; Get properties from the current working revision
+ (when (and (not old) (file-readable-p file)
+ (file-regular-p file))
+ (let ((buf (get-file-buffer (expand-file-name file))))
+ ;; Try to reuse an existing buffer
+ (if buf
+ (with-current-buffer buf
+ (diff-syntax-fontify-props nil text line-nb))
+ ;; Get properties from the file.
+ (with-current-buffer (get-buffer-create
+ " *diff-syntax-file*")
+ (let ((attrs (file-attributes file)))
+ (if (equal diff--syntax-file-attributes attrs)
+ ;; Same file as last-time, unmodified.
+ ;; Reuse buffer as-is.
+ (setq file nil)
+ (insert-file-contents file)
+ (setq diff--syntax-file-attributes attrs)))
+ (diff-syntax-fontify-props file text line-nb)))))
+ ;; Get properties from a cached revision
+ (let* ((buffer-name (format " *diff-syntax:%s.~%s~*"
+ (expand-file-name file)
+ revision))
+ (buffer (get-buffer buffer-name)))
+ (if buffer
+ ;; Don't re-initialize the buffer (which would throw
+ ;; away the previous fontification work).
+ (setq file nil)
+ (setq buffer (ignore-errors
+ (vc-find-revision-no-save
+ (expand-file-name file) revision
+ diff-vc-backend
+ (get-buffer-create buffer-name)))))
+ (when buffer
+ (with-current-buffer buffer
+ (diff-syntax-fontify-props file text line-nb))))))))
+ (let ((file (car (diff-hunk-file-names old))))
+ (cond
+ ((and file diff-default-directory
+ (not (eq diff-font-lock-syntax 'hunk-only))
+ (not diff-vc-backend)
+ (file-readable-p file) (file-regular-p file))
+ ;; Try to get full text from the file.
+ (with-temp-buffer
+ (insert-file-contents file)
+ (diff-syntax-fontify-props file text line-nb)))
+ ;; Otherwise, get properties from the hunk alone
+ ((memq diff-font-lock-syntax '(hunk-also hunk-only))
+ (with-temp-buffer
+ (insert text)
+ (diff-syntax-fontify-props file text line-nb t))))))))
+
+ ;; Put properties over the hunk text
+ (goto-char beg)
+ (when (and props (eq (diff-hunk-style) 'unified))
+ (while (< (progn (forward-line 1) (point)) end)
+ ;; Skip the "\ No newline at end of file" lines as well as the lines
+ ;; corresponding to the "other" version.
+ (unless (looking-at-p (if old "[+>\\]" "[-<\\]"))
+ (if (and old (not (looking-at-p "[-<]")))
+ ;; Fontify context lines only from new source,
+ ;; don't refontify context lines from old source.
+ (pop props)
+ (let ((line-props (pop props))
+ (bol (1+ (point))))
+ (dolist (prop line-props)
+ ;; Ideally, we'd want to use text-properties as in:
+ ;;
+ ;; (add-face-text-property
+ ;; (+ bol (nth 0 prop)) (+ bol (nth 1 prop))
+ ;; (nth 2 prop) 'append)
+ ;;
+ ;; rather than overlays here, but they'd get removed by later
+ ;; font-locking.
+ ;; This is because we also apply faces outside of the
+ ;; beg...end chunk currently font-locked and when font-lock
+ ;; later comes to handle the rest of the hunk that we already
+ ;; handled we don't (want to) redo it (we work at
+ ;; hunk-granularity rather than font-lock's own chunk
+ ;; granularity).
+ ;; I see two ways to fix this:
+ ;; - don't immediately apply the props that fall outside of
+ ;; font-lock's chunk but stash them somewhere (e.g. in another
+ ;; text property) and only later when font-lock comes back
+ ;; move them to `face'.
+ ;; - change the code so work at font-lock's chunk granularity
+ ;; (this seems doable without too much extra overhead,
+ ;; contrary to the refine highlighting, which inherently
+ ;; works at a different granularity).
+ (let ((ol (make-overlay (+ bol (nth 0 prop))
+ (+ bol (nth 1 prop))
+ nil 'front-advance nil)))
+ (overlay-put ol 'diff-mode 'syntax)
+ (overlay-put ol 'evaporate t)
+ (overlay-put ol 'face (nth 2 prop)))))))))))
+
+(defun diff-syntax-fontify-props (file text line-nb &optional hunk-only)
+ "Get font-lock properties from the source code.
+FILE is the name of the source file. If non-nil, it requests initialization
+of the mode according to FILE.
+TEXT is the literal source text from hunk.
+LINE-NB is a pair of numbers: start line number and the number of
+lines in the hunk.
+When HUNK-ONLY is non-nil, then don't verify the existence of the
+hunk text in the source file. Otherwise, don't highlight the hunk if the
+hunk text is not found in the source file."
+ (when 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:'
+ (buffer-file-name file))
+ (set-auto-mode)
+ ;; FIXME: Is this really worth the trouble?
+ (when (and (fboundp 'generic-mode-find-file-hook)
+ (memq #'generic-mode-find-file-hook
+ ;; There's no point checking the buffer-local value,
+ ;; we're in a fresh new buffer.
+ (default-value 'find-file-hook)))
+ (generic-mode-find-file-hook))))
+
+ (let ((font-lock-defaults (or font-lock-defaults '(nil t)))
+ props beg end)
+ (goto-char (point-min))
+ (if hunk-only
+ (setq beg (point-min) end (point-max))
+ (forward-line (1- (nth 0 line-nb)))
+ ;; non-regexp looking-at to compare hunk text for verification
+ (if (search-forward text (+ (point) (length text)) t)
+ (setq beg (- (point) (length text)) end (point))
+ (goto-char (point-min))
+ (if (search-forward text nil t)
+ (setq beg (- (point) (length text)) end (point)))))
+
+ (when (and beg end)
+ (goto-char beg)
+ (font-lock-ensure beg end)
+
+ (while (< (point) end)
+ (let* ((bol (point))
+ (eol (line-end-position))
+ line-props
+ (searching t)
+ (from (point)) to
+ (val (get-text-property from 'face)))
+ (while searching
+ (setq to (next-single-property-change from 'face nil eol))
+ (when val (push (list (- from bol) (- to bol) val) line-props))
+ (setq val (get-text-property to 'face) from to)
+ (unless (< to eol) (setq searching nil)))
+ (when val (push (list from eol val) line-props))
+ (push (nreverse line-props) props))
+ (forward-line 1)))
+ (nreverse props)))
+
+
+(defun diff--filter-substring (str)
+ (when diff-font-lock-prettify
+ ;; Strip the `display' properties added by diff-font-lock-prettify,
+ ;; since they look weird when you kill&yank!
+ (remove-text-properties 0 (length str) '(display nil) str)
+ ;; We could also try to only remove those `display' properties actually
+ ;; added by diff-font-lock-prettify rather than removing them all blindly.
+ ;; E.g.:
+ ;;(let ((len (length str))
+ ;; (i 0))
+ ;; (while (and (< i len)
+ ;; (setq i (text-property-not-all i len 'display nil str)))
+ ;; (let* ((val (get-text-property i 'display str))
+ ;; (end (or (text-property-not-all i len 'display val str) len)))
+ ;; ;; FIXME: Check for display props that prettify the file header!
+ ;; (when (eq 'left-fringe (car-safe val))
+ ;; ;; FIXME: Should we check that it's a diff-fringe-* bitmap?
+ ;; (remove-text-properties i end '(display nil) str))
+ ;; (setq i end))))
+ )
+ str)
+
+;;; Support for converting a diff to diff3 markers via `wiggle'.
+
+;; Wiggle can be found at http://neil.brown.name/wiggle/ or in your nearest
+;; Debian repository.
+
+(defun diff-wiggle ()
+ "Use `wiggle' to apply the whole current file diff by hook or by crook.
+When a hunk can't cleanly be applied, it gets turned into a diff3-style
+conflict."
+ (interactive)
+ (let* ((bounds (diff-bounds-of-file))
+ (file (diff-find-file-name))
+ (tmpbuf (current-buffer))
+ (filebuf (find-buffer-visiting file))
+ (patchfile (make-temp-file
+ (expand-file-name "wiggle" (file-name-directory file))
+ nil ".diff"))
+ (errfile (make-temp-file
+ (expand-file-name "wiggle" (file-name-directory file))
+ nil ".error")))
+ (unwind-protect
+ (with-temp-buffer
+ (set-buffer (prog1 tmpbuf (setq tmpbuf (current-buffer))))
+ (when (buffer-modified-p filebuf)
+ (save-some-buffers nil (lambda () (eq (current-buffer) filebuf)))
+ (if (buffer-modified-p filebuf) (user-error "Abort!")))
+ (write-region (car bounds) (cadr bounds) patchfile nil 'silent)
+ (let ((exitcode
+ (call-process "wiggle" nil (list tmpbuf errfile) nil
+ file patchfile)))
+ (if (not (memq exitcode '(0 1)))
+ (message "diff-wiggle error: %s"
+ (with-current-buffer tmpbuf
+ (goto-char (point-min))
+ (insert-file-contents errfile)
+ (buffer-string)))
+ (with-current-buffer tmpbuf
+ (write-region nil nil file nil 'silent)
+ (with-current-buffer filebuf
+ (revert-buffer t t t)
+ (save-excursion
+ (goto-char (point-min))
+ (if (re-search-forward "^<<<<<<<" nil t)
+ (smerge-mode 1)))
+ (pop-to-buffer filebuf))))))
+ (delete-file patchfile)
+ (delete-file errfile))))
+
;; provide the package
(provide 'diff-mode)
diff --git a/lisp/vc/diff.el b/lisp/vc/diff.el
index c04ff17ade7..523be87bc49 100644
--- a/lisp/vc/diff.el
+++ b/lisp/vc/diff.el
@@ -121,6 +121,8 @@ Possible values are:
nil -- no, it does not
check -- try to probe whether it does")
+(defvar diff-default-directory)
+
(defun diff-no-select (old new &optional switches no-async buf)
;; Noninteractive helper for creating and reverting diff buffers
(unless (bufferp new) (setq new (expand-file-name new)))
@@ -165,6 +167,7 @@ Possible values are:
(lambda (_ignore-auto _noconfirm)
(diff-no-select old new switches no-async (current-buffer))))
(setq default-directory thisdir)
+ (setq diff-default-directory default-directory)
(let ((inhibit-read-only t))
(insert command "\n"))
(if (and (not no-async) (fboundp 'make-process))
@@ -226,8 +229,9 @@ With prefix arg, prompt for diff switches."
"View the differences between BUFFER and its associated file.
This requires the external program `diff' to be in your `exec-path'."
(interactive "bBuffer: ")
- (with-current-buffer (get-buffer (or buffer (current-buffer)))
- (diff buffer-file-name (current-buffer) nil 'noasync)))
+ (let ((buf (get-buffer (or buffer (current-buffer)))))
+ (with-current-buffer (or (buffer-base-buffer buf) buf)
+ (diff buffer-file-name (current-buffer) nil 'noasync))))
(provide 'diff)
diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el
index c1526235dea..a74d6a8b4d1 100644
--- a/lisp/vc/ediff-init.el
+++ b/lisp/vc/ediff-init.el
@@ -267,17 +267,17 @@ It needs to be killed when we quit the session.")
(and (ediff-window-display-p) ediff-multiframe))
(defmacro ediff-narrow-control-frame-p ()
- `(and (ediff-multiframe-setup-p)
- (equal ediff-help-message ediff-brief-message-string)))
+ '(and (ediff-multiframe-setup-p)
+ (equal ediff-help-message ediff-brief-message-string)))
(defmacro ediff-3way-comparison-job ()
- `(memq
+ '(memq
ediff-job-name
'(ediff-files3 ediff-buffers3)))
(ediff-defvar-local ediff-3way-comparison-job nil "")
(defmacro ediff-merge-job ()
- `(memq
+ '(memq
ediff-job-name
'(ediff-merge-files
ediff-merge-buffers
@@ -288,10 +288,10 @@ It needs to be killed when we quit the session.")
(ediff-defvar-local ediff-merge-job nil "")
(defmacro ediff-patch-job ()
- `(eq ediff-job-name 'epatch))
+ '(eq ediff-job-name 'epatch))
(defmacro ediff-merge-with-ancestor-job ()
- `(memq
+ '(memq
ediff-job-name
'(ediff-merge-files-with-ancestor
ediff-merge-buffers-with-ancestor
@@ -299,26 +299,26 @@ It needs to be killed when we quit the session.")
(ediff-defvar-local ediff-merge-with-ancestor-job nil "")
(defmacro ediff-3way-job ()
- `(or ediff-3way-comparison-job ediff-merge-job))
+ '(or ediff-3way-comparison-job ediff-merge-job))
(ediff-defvar-local ediff-3way-job nil "")
;; A diff3 job is like a 3way job, but ediff-merge doesn't require the use
;; of diff3.
(defmacro ediff-diff3-job ()
- `(or ediff-3way-comparison-job
+ '(or ediff-3way-comparison-job
ediff-merge-with-ancestor-job))
(ediff-defvar-local ediff-diff3-job nil "")
(defmacro ediff-windows-job ()
- `(memq ediff-job-name '(ediff-windows-wordwise ediff-windows-linewise)))
+ '(memq ediff-job-name '(ediff-windows-wordwise ediff-windows-linewise)))
(ediff-defvar-local ediff-windows-job nil "")
(defmacro ediff-word-mode-job ()
- `(memq ediff-job-name '(ediff-windows-wordwise ediff-regions-wordwise)))
+ '(memq ediff-job-name '(ediff-windows-wordwise ediff-regions-wordwise)))
(ediff-defvar-local ediff-word-mode-job nil "")
(defmacro ediff-narrow-job ()
- `(memq ediff-job-name '(ediff-windows-wordwise
+ '(memq ediff-job-name '(ediff-windows-wordwise
ediff-regions-wordwise
ediff-windows-linewise
ediff-regions-linewise)))
diff --git a/lisp/vc/ediff-merg.el b/lisp/vc/ediff-merg.el
index 27835f7bdc1..a511f4488f1 100644
--- a/lisp/vc/ediff-merg.el
+++ b/lisp/vc/ediff-merg.el
@@ -194,7 +194,7 @@ Buffer B."
(defun ediff-set-merge-mode ()
(normal-mode t)
- (remove-hook 'local-write-file-hooks 'ediff-set-merge-mode))
+ (remove-hook 'write-file-functions 'ediff-set-merge-mode t))
;; Go over all diffs starting with DIFF-NUM and copy regions into buffer C
diff --git a/lisp/vc/ediff-ptch.el b/lisp/vc/ediff-ptch.el
index 35d7e28f294..4178b5a8c05 100644
--- a/lisp/vc/ediff-ptch.el
+++ b/lisp/vc/ediff-ptch.el
@@ -681,7 +681,7 @@ optional argument, then use it."
(error
"Ediff doesn't take the -V option in `ediff-patch-options'--sorry"))
- ;; Make a temp file, if source-filename has a magic file handler (or if
+ ;; Make a temp file, if source-filename has a magic file name handler (or if
;; it is handled via auto-mode-alist and similar magic).
;; Check if there is a buffer visiting source-filename and if they are in
;; sync; arrange for the deletion of temp file.
@@ -691,7 +691,7 @@ optional argument, then use it."
;; Check if source file name has triggered black magic, such as file name
;; handlers or auto mode alist, and make a note of it.
;; true-source-filename should be either the original name or a
- ;; temporary file where we put the after-product of the file handler.
+ ;; temporary file where we put the after-product of the file name handler.
(setq file-name-magic-p (not (equal (file-truename true-source-filename)
(file-truename source-filename))))
@@ -823,11 +823,11 @@ you can still examine the changes via M-x ediff-files"
(setq startup-hooks
;; this sets various vars in the meta buffer inside
;; ediff-prepare-meta-buffer
- (cons `(lambda ()
- ;; tell what to do if the user clicks on a session record
- (setq ediff-session-action-function
- 'ediff-patch-file-form-meta
- ediff-meta-patchbufer patch-buf) )
+ (cons (lambda ()
+ ;; tell what to do if the user clicks on a session record
+ (setq ediff-session-action-function
+ 'ediff-patch-file-form-meta
+ ediff-meta-patchbufer patch-buf) )
startup-hooks))
(setq meta-buf (ediff-prepare-meta-buffer
'ediff-filegroup-action
diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el
index 2e9863048f9..6e282a4fd80 100644
--- a/lisp/vc/ediff-util.el
+++ b/lisp/vc/ediff-util.el
@@ -39,9 +39,6 @@
(defvar ediff-after-quit-hook-internal nil)
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest _r))))
-
;; end pacifier
@@ -347,7 +344,7 @@ to invocation.")
(goto-char (point-min))
(funcall (ediff-with-current-buffer buf major-mode))
(widen) ; merge buffer is always widened
- (add-hook 'local-write-file-hooks 'ediff-set-merge-mode nil t)
+ (add-hook 'write-file-functions 'ediff-set-merge-mode nil t)
)))
(setq buffer-read-only nil
ediff-buffer-A buffer-A
@@ -778,8 +775,8 @@ Reestablish the default window display."
(select-frame-set-input-focus ediff-control-frame)
(raise-frame ediff-control-frame)
(select-frame ediff-control-frame)
- (if (fboundp 'focus-frame)
- (focus-frame ediff-control-frame))))
+ (and (featurep 'xemacs) (fboundp 'focus-frame)
+ (focus-frame ediff-control-frame))))
;; Redisplay whatever buffers are showing, if there is a selected difference
(let ((control-frame ediff-control-frame)
@@ -3224,9 +3221,9 @@ Hit \\[ediff-recenter] to reset the windows afterward."
short-f (concat ediff-temp-file-prefix short-p)
f (cond (given-file)
((find-file-name-handler f 'insert-file-contents)
- ;; to thwart file handlers in write-region, e.g., if file
- ;; name ends with .Z or .gz
- ;; This is needed so that patches produced by ediff will
+ ;; to thwart file name handlers in write-region,
+ ;; e.g., if file name ends with .Z or .gz
+ ;; This is needed so that patches produced by ediff will
;; have more meaningful names
(ediff-make-empty-tmp-file short-f))
(prefix
@@ -3549,25 +3546,19 @@ Ediff Control Panel to restore highlighting."
(ediff-paint-background-regions 'unhighlight)
(cond ((ediff-merge-job)
- (setq bufB ediff-buffer-C)
;; ask which buffer to compare to the merge buffer
- (while (cond ((eq answer ?A)
- (setq bufA ediff-buffer-A
- possibilities '(?B))
- nil)
- ((eq answer ?B)
- (setq bufA ediff-buffer-B
- possibilities '(?A))
- nil)
- ((equal answer ""))
- (t (beep 1)
- (message "Valid values are A or B")
- (sit-for 2)
- t))
- (let ((cursor-in-echo-area t))
- (message
- "Which buffer to compare to the merge buffer (A or B)? ")
- (setq answer (capitalize (read-char-exclusive))))))
+ (setq answer (read-multiple-choice
+ "Which buffer to compare?"
+ '((?a "A")
+ (?b "B"))))
+ (if (eq (car answer) ?a)
+ (setq bufA ediff-buffer-A)
+ (setq bufA ediff-buffer-B))
+ (setq bufB (if (and ediff-ancestor-buffer
+ (y-or-n-p (format "Compare %s against ancestor buffer?"
+ (cadr answer))))
+ ediff-ancestor-buffer
+ ediff-buffer-C)))
((ediff-3way-comparison-job)
;; ask which two buffers to compare
diff --git a/lisp/vc/ediff-wind.el b/lisp/vc/ediff-wind.el
index bc41e3d9e5c..492ddd3417a 100644
--- a/lisp/vc/ediff-wind.el
+++ b/lisp/vc/ediff-wind.el
@@ -38,10 +38,6 @@
(defvar frame-icon-title-format)
(defvar ediff-diff-status)
-;; declare-function does not exist in XEmacs
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest _r))))
-
(require 'ediff-init)
(require 'ediff-help)
;; end pacifier
@@ -64,10 +60,10 @@
(defun ediff-choose-window-setup-function-automatically ()
(declare (obsolete ediff-setup-windows-default "24.3"))
(if (ediff-window-display-p)
- 'ediff-setup-windows-multiframe
- 'ediff-setup-windows-plain))
+ #'ediff-setup-windows-multiframe
+ #'ediff-setup-windows-plain))
-(defcustom ediff-window-setup-function 'ediff-setup-windows-default
+(defcustom ediff-window-setup-function #'ediff-setup-windows-default
"Function called to set up windows.
Ediff provides a choice of three functions:
(1) `ediff-setup-windows-multiframe', which sets the control panel
@@ -132,7 +128,7 @@ provided functions are written."
(Ancestor . ediff-window-Ancestor)))
-(defcustom ediff-split-window-function 'split-window-vertically
+(defcustom ediff-split-window-function #'split-window-vertically
"The function used to split the main window between buffer-A and buffer-B.
You can set it to a horizontal split instead of the default vertical split
by setting this variable to `split-window-horizontally'.
@@ -145,7 +141,7 @@ In this case, Ediff will use those frames to display these buffers."
function)
:group 'ediff-window)
-(defcustom ediff-merge-split-window-function 'split-window-horizontally
+(defcustom ediff-merge-split-window-function #'split-window-horizontally
"The function used to split the main window between buffer-A and buffer-B.
You can set it to a vertical split instead of the default horizontal split
by setting this variable to `split-window-vertically'.
@@ -212,7 +208,7 @@ responsibility."
:type 'boolean
:group 'ediff-window)
-(defcustom ediff-control-frame-position-function 'ediff-make-frame-position
+(defcustom ediff-control-frame-position-function #'ediff-make-frame-position
"Function to call to determine the desired location for the control panel.
Expects three parameters: the control buffer, the desired width and height
of the control frame. It returns an association list
@@ -260,7 +256,7 @@ customization of the default."
display off.")
(ediff-defvar-local ediff-wide-display-frame nil
"Frame to be used for wide display.")
-(ediff-defvar-local ediff-make-wide-display-function 'ediff-make-wide-display
+(ediff-defvar-local ediff-make-wide-display-function #'ediff-make-wide-display
"The value is a function that is called to create a wide display.
The function is called without arguments. It should resize the frame in
which buffers A, B, and C are to be displayed, and it should save the old
@@ -336,11 +332,11 @@ into icons, regardless of the window manager."
;; in case user did a no-no on a tty
(or (ediff-window-display-p)
- (setq ediff-window-setup-function 'ediff-setup-windows-plain))
+ (setq ediff-window-setup-function #'ediff-setup-windows-plain))
(or (ediff-keep-window-config control-buffer)
(funcall
- (ediff-with-current-buffer control-buffer ediff-window-setup-function)
+ (with-current-buffer control-buffer ediff-window-setup-function)
buffer-A buffer-B buffer-C control-buffer))
(run-hooks 'ediff-after-setup-windows-hook))
@@ -354,7 +350,7 @@ into icons, regardless of the window manager."
;; Usually used without windowing systems
;; With windowing, we want to use dedicated frames.
(defun ediff-setup-windows-plain (buffer-A buffer-B buffer-C control-buffer)
- (ediff-with-current-buffer control-buffer
+ (with-current-buffer control-buffer
(setq ediff-multiframe nil))
(if ediff-merge-job
(ediff-setup-windows-plain-merge
@@ -368,14 +364,14 @@ into icons, regardless of the window manager."
;; skip dedicated and unsplittable frames
(ediff-destroy-control-frame control-buffer)
(let ((window-min-height 1)
- (with-Ancestor-p (ediff-with-current-buffer control-buffer
+ (with-Ancestor-p (with-current-buffer control-buffer
ediff-merge-with-ancestor-job))
split-window-function
merge-window-share merge-window-lines
- (buf-Ancestor (ediff-with-current-buffer control-buffer
+ (buf-Ancestor (with-current-buffer control-buffer
ediff-ancestor-buffer))
wind-A wind-B wind-C wind-Ancestor)
- (ediff-with-current-buffer control-buffer
+ (with-current-buffer control-buffer
(setq merge-window-share ediff-merge-window-share
;; this lets us have local versions of ediff-split-window-function
split-window-function ediff-split-window-function))
@@ -419,7 +415,7 @@ into icons, regardless of the window manager."
(switch-to-buffer buf-B)
(setq wind-B (selected-window))
- (ediff-with-current-buffer control-buffer
+ (with-current-buffer control-buffer
(setq ediff-window-A wind-A
ediff-window-B wind-B
ediff-window-C wind-C
@@ -438,7 +434,7 @@ into icons, regardless of the window manager."
split-window-function wind-width-or-height
three-way-comparison
wind-A-start wind-B-start wind-A wind-B wind-C)
- (ediff-with-current-buffer control-buffer
+ (with-current-buffer control-buffer
(setq wind-A-start (ediff-overlay-start
(ediff-get-value-according-to-buffer-type
'A ediff-narrow-bounds))
@@ -464,7 +460,7 @@ into icons, regardless of the window manager."
(setq wind-A (selected-window))
(if three-way-comparison
(setq wind-width-or-height
- (/ (if (eq split-window-function 'split-window-vertically)
+ (/ (if (eq split-window-function #'split-window-vertically)
(window-height wind-A)
(window-width wind-A))
3)))
@@ -489,7 +485,7 @@ into icons, regardless of the window manager."
(switch-to-buffer buf-C)
(setq wind-C (selected-window))))
- (ediff-with-current-buffer control-buffer
+ (with-current-buffer control-buffer
(setq ediff-window-A wind-A
ediff-window-B wind-B
ediff-window-C wind-C))
@@ -508,23 +504,23 @@ into icons, regardless of the window manager."
;; dispatch an appropriate window setup function
(defun ediff-setup-windows-multiframe (buf-A buf-B buf-C control-buf)
- (ediff-with-current-buffer control-buf
+ (with-current-buffer control-buf
(setq ediff-multiframe t))
(if ediff-merge-job
(ediff-setup-windows-multiframe-merge buf-A buf-B buf-C control-buf)
(ediff-setup-windows-multiframe-compare buf-A buf-B buf-C control-buf)))
(defun ediff-setup-windows-multiframe-merge (buf-A buf-B buf-C control-buf)
-;;; Algorithm:
-;;; 1. Never use frames that have dedicated windows in them---it is bad to
-;;; destroy dedicated windows.
-;;; 2. If A and B are in the same frame but C's frame is different---use one
-;;; frame for A and B, and use a separate frame for C.
-;;; 3. If C's frame is non-existent, then: if the first suitable
-;;; non-dedicated frame is different from A&B's, then use it for C.
-;;; Otherwise, put A, B, and C in one frame.
-;;; 4. If buffers A, B, C are in separate frames, use them to display these
-;;; buffers.
+ ;; Algorithm:
+ ;; 1. Never use frames that have dedicated windows in them---it is bad to
+ ;; destroy dedicated windows.
+ ;; 2. If A and B are in the same frame but C's frame is different--- use one
+ ;; frame for A and B and use a separate frame for C.
+ ;; 3. If C's frame is non-existent, then: if the first suitable
+ ;; non-dedicated frame is different from A&B's, then use it for C.
+ ;; Otherwise, put A,B, and C in one frame.
+ ;; 4. If buffers A, B, C are is separate frames, use them to display these
+ ;; buffers.
;; Skip dedicated or iconified frames.
;; Unsplittable frames are taken care of later.
@@ -534,7 +530,7 @@ into icons, regardless of the window manager."
(wind-A (ediff-get-visible-buffer-window buf-A))
(wind-B (ediff-get-visible-buffer-window buf-B))
(wind-C (ediff-get-visible-buffer-window buf-C))
- (buf-Ancestor (ediff-with-current-buffer control-buf
+ (buf-Ancestor (with-current-buffer control-buf
ediff-ancestor-buffer))
(wind-Ancestor (ediff-get-visible-buffer-window buf-Ancestor))
(frame-A (if wind-A (window-frame wind-A)))
@@ -543,10 +539,10 @@ into icons, regardless of the window manager."
(frame-Ancestor (if wind-Ancestor (window-frame wind-Ancestor)))
;; on wide display, do things in one frame
(force-one-frame
- (ediff-with-current-buffer control-buf ediff-wide-display-p))
+ (with-current-buffer control-buf ediff-wide-display-p))
;; this lets us have local versions of ediff-split-window-function
(split-window-function
- (ediff-with-current-buffer control-buf ediff-split-window-function))
+ (with-current-buffer control-buf ediff-split-window-function))
(orig-wind (selected-window))
(orig-frame (selected-frame))
(use-same-frame (or force-one-frame
@@ -568,11 +564,11 @@ into icons, regardless of the window manager."
;; use-same-frame-for-AB implies wind A and B are ok for display
(use-same-frame-for-AB (and (not use-same-frame)
(eq frame-A frame-B)))
- (merge-window-share (ediff-with-current-buffer control-buf
+ (merge-window-share (with-current-buffer control-buf
ediff-merge-window-share))
merge-window-lines
designated-minibuffer-frame ; ediff-merge-with-ancestor-job
- (with-Ancestor-p (ediff-with-current-buffer control-buf
+ (with-Ancestor-p (with-current-buffer control-buf
ediff-merge-with-ancestor-job))
(done-Ancestor (not with-Ancestor-p))
done-A done-B done-C)
@@ -726,7 +722,7 @@ into icons, regardless of the window manager."
(switch-to-buffer buf-Ancestor)
(setq wind-Ancestor (selected-window))))
- (ediff-with-current-buffer control-buf
+ (with-current-buffer control-buf
(setq ediff-window-A wind-A
ediff-window-B wind-B
ediff-window-C wind-C
@@ -740,21 +736,17 @@ into icons, regardless of the window manager."
;; Window setup for all comparison jobs, including 3way comparisons
(defun ediff-setup-windows-multiframe-compare (buf-A buf-B buf-C control-buf)
-;;; Algorithm:
-;;; If a buffer is seen in a frame, use that frame for that buffer.
-;;; If it is not seen, use the current frame.
-;;; If both buffers are not seen, they share the current frame. If one
-;;; of the buffers is not seen, it is placed in the current frame (where
-;;; ediff started). If that frame is displaying the other buffer, it is
-;;; shared between the two buffers.
-;;; However, if we decide to put both buffers in one frame
-;;; and the selected frame isn't splittable, we create a new frame and
-;;; put both buffers there, event if one of this buffers is visible in
-;;; another frame.
-
- ;; Skip dedicated or iconified frames.
- ;; Unsplittable frames are taken care of later.
- (ediff-skip-unsuitable-frames 'ok-unsplittable)
+ ;; Algorithm:
+ ;; If a buffer is seen in a frame, use that frame for that buffer.
+ ;; If it is not seen, use the current frame.
+ ;; If both buffers are not seen, they share the current frame. If one
+ ;; of the buffers is not seen, it is placed in the current frame (where
+ ;; ediff started). If that frame is displaying the other buffer, it is
+ ;; shared between the two buffers.
+ ;; However, if we decide to put both buffers in one frame
+ ;; and the selected frame isn't splittable, we create a new frame and
+ ;; put both buffers there, event if one of this buffers is visible in
+ ;; another frame.
(let* ((window-min-height 1)
(wind-A (ediff-get-visible-buffer-window buf-A))
@@ -763,17 +755,16 @@ into icons, regardless of the window manager."
(frame-A (if wind-A (window-frame wind-A)))
(frame-B (if wind-B (window-frame wind-B)))
(frame-C (if wind-C (window-frame wind-C)))
- (ctl-frame-exists-p (ediff-with-current-buffer control-buf
+ (ctl-frame-exists-p (with-current-buffer control-buf
(frame-live-p ediff-control-frame)))
;; on wide display, do things in one frame
(force-one-frame
- (ediff-with-current-buffer control-buf ediff-wide-display-p))
+ (with-current-buffer control-buf ediff-wide-display-p))
;; this lets us have local versions of ediff-split-window-function
(split-window-function
- (ediff-with-current-buffer control-buf ediff-split-window-function))
+ (with-current-buffer control-buf ediff-split-window-function))
(three-way-comparison
- (ediff-with-current-buffer control-buf ediff-3way-comparison-job))
- (orig-wind (selected-window))
+ (with-current-buffer control-buf ediff-3way-comparison-job))
(use-same-frame (or force-one-frame
(eq frame-A frame-B)
(not (ediff-window-ok-for-display wind-A))
@@ -792,10 +783,9 @@ into icons, regardless of the window manager."
(or ctl-frame-exists-p
(eq frame-B (selected-frame))))))
wind-A-start wind-B-start
- designated-minibuffer-frame
- done-A done-B done-C)
+ designated-minibuffer-frame)
- (ediff-with-current-buffer control-buf
+ (with-current-buffer control-buf
(setq wind-A-start (ediff-overlay-start
(ediff-get-value-according-to-buffer-type
'A ediff-narrow-bounds))
@@ -803,30 +793,6 @@ into icons, regardless of the window manager."
(ediff-get-value-according-to-buffer-type
'B ediff-narrow-bounds))))
- (if (and (window-live-p wind-A) (null use-same-frame)) ; buf-A on its own
- (progn
- ;; buffer buf-A is seen in live wind-A
- (select-window wind-A) ; must be displaying buf-A
- (delete-other-windows)
- (setq wind-A (selected-window))
- (setq done-A t)))
-
- (if (and (window-live-p wind-B) (null use-same-frame)) ; buf B on its own
- (progn
- ;; buffer buf-B is seen in live wind-B
- (select-window wind-B) ; must be displaying buf-B
- (delete-other-windows)
- (setq wind-B (selected-window))
- (setq done-B t)))
-
- (if (and (window-live-p wind-C) (null use-same-frame)) ; buf C on its own
- (progn
- ;; buffer buf-C is seen in live wind-C
- (select-window wind-C) ; must be displaying buf-C
- (delete-other-windows)
- (setq wind-C (selected-window))
- (setq done-C t)))
-
(if use-same-frame
(let (wind-width-or-height) ; this affects 3way setups only
(if (and (eq frame-A frame-B) (frame-live-p frame-A))
@@ -840,7 +806,7 @@ into icons, regardless of the window manager."
(if three-way-comparison
(setq wind-width-or-height
(/
- (if (eq split-window-function 'split-window-vertically)
+ (if (eq split-window-function #'split-window-vertically)
(window-height wind-A)
(window-width wind-A))
3)))
@@ -857,46 +823,57 @@ into icons, regardless of the window manager."
(if (memq (selected-window) (list wind-A wind-B))
(other-window 1))
(switch-to-buffer buf-C)
- (setq wind-C (selected-window))))
- (setq done-A t
- done-B t
- done-C t)
- ))
-
- (or done-A ; Buf A to be set in its own frame
- ;;; or it was set before because use-same-frame = 1
- (progn
- ;; Buf-A was not set up yet as it wasn't visible,
- ;; and use-same-frame = nil
- (select-window orig-wind)
- (delete-other-windows)
- (switch-to-buffer buf-A)
- (setq wind-A (selected-window))
- ))
- (or done-B ; Buf B to be set in its own frame
- ;;; or it was set before because use-same-frame = 1
- (progn
- ;; Buf-B was not set up yet as it wasn't visible,
- ;; and use-same-frame = nil
- (select-window orig-wind)
- (delete-other-windows)
- (switch-to-buffer buf-B)
- (setq wind-B (selected-window))
- ))
-
- (if three-way-comparison
- (or done-C ; Buf C to be set in its own frame
- ;;; or it was set before because use-same-frame = 1
+ (setq wind-C (selected-window)))))
+
+ (if (window-live-p wind-A) ; buf-A on its own
+ (progn
+ ;; buffer buf-A is seen in live wind-A
+ (select-window wind-A) ; must be displaying buf-A
+ (delete-other-windows)
+ (setq wind-A (selected-window))) ;FIXME: Why?
+ ;; Buf-A was not set up yet as it wasn't visible,
+ ;; and use-same-frame = nil
+ ;; Skip dedicated or iconified frames.
+ ;; Unsplittable frames are taken care of later.
+ (ediff-skip-unsuitable-frames 'ok-unsplittable)
+ (delete-other-windows)
+ (switch-to-buffer buf-A)
+ (setq wind-A (selected-window)))
+
+ (if (window-live-p wind-B) ; buf B on its own
+ (progn
+ ;; buffer buf-B is seen in live wind-B
+ (select-window wind-B) ; must be displaying buf-B
+ (delete-other-windows)
+ (setq wind-B (selected-window))) ;FIXME: Why?
+ ;; Buf-B was not set up yet as it wasn't visible,
+ ;; and use-same-frame = nil
+ ;; Skip dedicated or iconified frames.
+ ;; Unsplittable frames are taken care of later.
+ (ediff-skip-unsuitable-frames 'ok-unsplittable)
+ (delete-other-windows)
+ (switch-to-buffer buf-B)
+ (setq wind-B (selected-window)))
+
+ (if (window-live-p wind-C) ; buf C on its own
+ (progn
+ ;; buffer buf-C is seen in live wind-C
+ (select-window wind-C) ; must be displaying buf-C
+ (delete-other-windows)
+ (setq wind-C (selected-window))) ;FIXME: Why?
+ (if three-way-comparison
(progn
;; Buf-C was not set up yet as it wasn't visible,
;; and use-same-frame = nil
- (select-window orig-wind)
+ ;; Skip dedicated or iconified frames.
+ ;; Unsplittable frames are taken care of later.
+ (ediff-skip-unsuitable-frames 'ok-unsplittable)
(delete-other-windows)
(switch-to-buffer buf-C)
(setq wind-C (selected-window))
- )))
+ ))))
- (ediff-with-current-buffer control-buf
+ (with-current-buffer control-buf
(setq ediff-window-A wind-A
ediff-window-B wind-B
ediff-window-C wind-C)
@@ -915,9 +892,9 @@ into icons, regardless of the window manager."
(ediff-setup-control-frame control-buf designated-minibuffer-frame)
))
-;; skip unsplittable frames and frames that have dedicated windows.
-;; create a new splittable frame if none is found
(defun ediff-skip-unsuitable-frames (&optional ok-unsplittable)
+ "Skip unsplittable frames and frames that have dedicated windows.
+create a new splittable frame if none is found."
(if (ediff-window-display-p)
(let ((wind-frame (window-frame))
seen-windows)
@@ -977,14 +954,14 @@ into icons, regardless of the window manager."
;; user-grabbed-mouse
fheight fwidth adjusted-parameters)
- (ediff-with-current-buffer ctl-buffer
+ (with-current-buffer ctl-buffer
(if (and (featurep 'xemacs) (featurep 'menubar))
(set-buffer-menubar nil))
;;(setq user-grabbed-mouse (ediff-user-grabbed-mouse))
(run-hooks 'ediff-before-setup-control-frame-hook))
- (setq old-ctl-frame (ediff-with-current-buffer ctl-buffer ediff-control-frame))
- (ediff-with-current-buffer ctl-buffer
+ (setq old-ctl-frame (with-current-buffer ctl-buffer ediff-control-frame))
+ (with-current-buffer ctl-buffer
(setq ctl-frame (if (frame-live-p old-ctl-frame)
old-ctl-frame
(make-frame ediff-control-frame-parameters))
@@ -1004,7 +981,7 @@ into icons, regardless of the window manager."
;; must be before ediff-setup-control-buffer
;; just a precaution--we should be in ctl-buffer already
- (ediff-with-current-buffer ctl-buffer
+ (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
@@ -1103,12 +1080,12 @@ into icons, regardless of the window manager."
(not (eq ediff-grab-mouse t)))))
(when (featurep 'xemacs)
- (ediff-with-current-buffer ctl-buffer
+ (with-current-buffer ctl-buffer
(make-local-hook 'select-frame-hook)
(add-hook 'select-frame-hook
- 'ediff-xemacs-select-frame-hook nil 'local)))
+ #'ediff-xemacs-select-frame-hook nil 'local)))
- (ediff-with-current-buffer ctl-buffer
+ (with-current-buffer ctl-buffer
(run-hooks 'ediff-after-setup-control-frame-hook))))
@@ -1128,7 +1105,7 @@ into icons, regardless of the window manager."
;; finds a good place to clip control frame
(defun ediff-make-frame-position (ctl-buffer ctl-frame-width ctl-frame-height)
- (ediff-with-current-buffer ctl-buffer
+ (with-current-buffer ctl-buffer
(let* ((frame-A (window-frame ediff-window-A))
(frame-A-parameters (frame-parameters frame-A))
(frame-A-top (eval (cdr (assoc 'top frame-A-parameters))))
@@ -1382,12 +1359,4 @@ It assumes that it is called from within the control buffer."
(provide 'ediff-wind)
-
-
-;; Local Variables:
-;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun)
-;; eval: (put 'ediff-with-current-buffer 'lisp-indent-hook 1)
-;; eval: (put 'ediff-with-current-buffer 'edebug-form-spec '(form body))
-;; End:
-
;;; ediff-wind.el ends here
diff --git a/lisp/vc/ediff.el b/lisp/vc/ediff.el
index 68c4fa2722a..0dfbe2ea66f 100644
--- a/lisp/vc/ediff.el
+++ b/lisp/vc/ediff.el
@@ -112,10 +112,6 @@
(provide 'ediff)
-;; Compiler pacifier
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest _r))))
-
(require 'ediff-util)
;; end pacifier
@@ -153,7 +149,7 @@
(declare-function dired-get-filename "dired"
(&optional localp no-error-if-not-filep))
(declare-function dired-get-marked-files "dired"
- (&optional localp arg filter distinguish-one-marked))
+ (&optional localp arg filter distinguish-one-marked error))
;; Return a plausible default for ediff's first file:
;; In dired, return the file number FILENO (or 0) in the list
diff --git a/lisp/vc/emerge.el b/lisp/vc/emerge.el
index 0da14d07fd3..fc8c318e3af 100644
--- a/lisp/vc/emerge.el
+++ b/lisp/vc/emerge.el
@@ -1,6 +1,6 @@
-;;; emerge.el --- merge diffs under Emacs control
+;;; emerge.el --- merge diffs under Emacs control -*- lexical-binding:t -*-
-;;; The author has placed this file in the public domain.
+;; The author has placed this file in the public domain.
;; This file is part of GNU Emacs.
@@ -24,42 +24,20 @@
;;; Code:
-;; There aren't really global variables, just dynamic bindings
-(defvar A-begin)
-(defvar A-end)
-(defvar B-begin)
-(defvar B-end)
-(defvar diff-vector)
-(defvar merge-begin)
-(defvar merge-end)
-(defvar valid-diff)
-
;;; Macros
(defmacro emerge-defvar-local (var value doc)
- "Defines SYMBOL as an advertised variable.
+ "Define SYMBOL as an advertised buffer-local variable.
Performs a defvar, then executes `make-variable-buffer-local' on
the variable. Also sets the `permanent-local' property, so that
`kill-all-local-variables' (called by major-mode setting commands)
won't destroy Emerge control variables."
`(progn
- (defvar ,var ,value ,doc)
- (make-variable-buffer-local ',var)
- (put ',var 'permanent-local t)))
-
-;; Add entries to minor-mode-alist so that emerge modes show correctly
-(defvar emerge-minor-modes-list
- '((emerge-mode " Emerge")
- (emerge-fast-mode " F")
- (emerge-edit-mode " E")
- (emerge-auto-advance " A")
- (emerge-skip-prefers " S")))
-(if (not (assq 'emerge-mode minor-mode-alist))
- (setq minor-mode-alist (append emerge-minor-modes-list
- minor-mode-alist)))
+ (defvar-local ,var ,value ,doc)
+ (put ',var 'permanent-local t)))
;; We need to define this function so describe-mode can describe Emerge mode.
-(defun emerge-mode ()
+(define-minor-mode emerge-mode
"Emerge mode is used by the Emerge file-merging package.
It is entered only through one of the functions:
`emerge-files'
@@ -74,7 +52,13 @@ It is entered only through one of the functions:
Commands:
\\{emerge-basic-keymap}
Commands must be prefixed by \\<emerge-fast-keymap>\\[emerge-basic-keymap] in `edit' mode,
-but can be invoked directly in `fast' mode.")
+but can be invoked directly in `fast' mode."
+ :lighter (" Emerge"
+ (emerge-fast-mode " F")
+ (emerge-edit-mode " E")
+ (emerge-auto-advance " A")
+ (emerge-skip-prefers " S")))
+(put 'emerge-mode 'permanent-local t)
;;; Emerge configuration variables
@@ -453,8 +437,6 @@ Must be set before Emerge is loaded."
;; Variables which control each merge. They are local to the merge buffer.
;; Mode variables
-(emerge-defvar-local emerge-mode nil
- "Indicator for emerge-mode.")
(emerge-defvar-local emerge-fast-mode nil
"Indicator for emerge-mode fast submode.")
(emerge-defvar-local emerge-edit-mode nil
@@ -556,7 +538,7 @@ This is *not* a user option, since Emerge uses it for its own processing.")
(if temp
(setq file-A temp
startup-hooks
- (cons `(lambda () (delete-file ,file-A))
+ (cons (lambda () (delete-file file-A))
startup-hooks))
;; Verify that the file matches the buffer
(emerge-verify-file-buffer))))
@@ -567,7 +549,7 @@ This is *not* a user option, since Emerge uses it for its own processing.")
(if temp
(setq file-B temp
startup-hooks
- (cons `(lambda () (delete-file ,file-B))
+ (cons (lambda () (delete-file file-B))
startup-hooks))
;; Verify that the file matches the buffer
(emerge-verify-file-buffer))))
@@ -584,48 +566,49 @@ This is *not* a user option, since Emerge uses it for its own processing.")
;; create the merge buffer from buffer A, so it inherits buffer A's
;; default directory, etc.
(merge-buffer (with-current-buffer
- buffer-A
- (get-buffer-create merge-buffer-name))))
+ buffer-A
+ (get-buffer-create merge-buffer-name))))
(with-current-buffer
- merge-buffer
- (emerge-copy-modes buffer-A)
- (setq buffer-read-only nil)
- (auto-save-mode 1)
- (setq emerge-mode t)
- (setq emerge-A-buffer buffer-A)
- (setq emerge-B-buffer buffer-B)
- (setq emerge-ancestor-buffer nil)
- (setq emerge-merge-buffer merge-buffer)
- (setq emerge-output-description
- (if output-file
- (concat "Output to file: " output-file)
- (concat "Output to buffer: " (buffer-name merge-buffer))))
- (save-excursion (insert-buffer-substring emerge-A-buffer))
- (emerge-set-keys)
- (setq emerge-difference-list (emerge-make-diff-list file-A file-B))
- (setq emerge-number-of-differences (length emerge-difference-list))
- (setq emerge-current-difference -1)
- (setq emerge-quit-hook quit-hooks)
- (emerge-remember-buffer-characteristics)
- (emerge-handle-local-variables))
+ merge-buffer
+ (emerge-copy-modes buffer-A)
+ (setq buffer-read-only nil)
+ (auto-save-mode 1)
+ (setq emerge-mode t)
+ (setq emerge-A-buffer buffer-A)
+ (setq emerge-B-buffer buffer-B)
+ (setq emerge-ancestor-buffer nil)
+ (setq emerge-merge-buffer merge-buffer)
+ (setq emerge-output-description
+ (if output-file
+ (concat "Output to file: " output-file)
+ (concat "Output to buffer: " (buffer-name merge-buffer))))
+ (save-excursion (insert-buffer-substring emerge-A-buffer))
+ (emerge-set-keys)
+ (setq emerge-difference-list (emerge-make-diff-list file-A file-B))
+ (setq emerge-number-of-differences (length emerge-difference-list))
+ (setq emerge-current-difference -1)
+ (setq emerge-quit-hook quit-hooks)
+ (emerge-remember-buffer-characteristics)
+ (emerge-handle-local-variables))
(emerge-setup-windows buffer-A buffer-B merge-buffer t)
(with-current-buffer merge-buffer
- (run-hooks 'startup-hooks 'emerge-startup-hook)
- (setq buffer-read-only t))))
+ (mapc #'funcall startup-hooks)
+ (run-hooks 'emerge-startup-hook)
+ (setq buffer-read-only t))))
;; Generate the Emerge difference list between two files
(defun emerge-make-diff-list (file-A file-B)
(setq emerge-diff-buffer (get-buffer-create "*emerge-diff*"))
(with-current-buffer
- emerge-diff-buffer
- (erase-buffer)
- (shell-command
- (format "%s %s %s %s"
- (shell-quote-argument emerge-diff-program)
- emerge-diff-options
- (shell-quote-argument file-A)
- (shell-quote-argument file-B))
- t))
+ emerge-diff-buffer
+ (erase-buffer)
+ (shell-command
+ (format "%s %s %s %s"
+ (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
emerge-A-buffer emerge-B-buffer emerge-merge-buffer
@@ -711,7 +694,7 @@ This is *not* a user option, since Emerge uses it for its own processing.")
(if temp
(setq file-A temp
startup-hooks
- (cons `(lambda () (delete-file ,file-A))
+ (cons (lambda () (delete-file file-A))
startup-hooks))
;; Verify that the file matches the buffer
(emerge-verify-file-buffer))))
@@ -722,7 +705,7 @@ This is *not* a user option, since Emerge uses it for its own processing.")
(if temp
(setq file-B temp
startup-hooks
- (cons `(lambda () (delete-file ,file-B))
+ (cons (lambda () (delete-file file-B))
startup-hooks))
;; Verify that the file matches the buffer
(emerge-verify-file-buffer))))
@@ -733,7 +716,7 @@ This is *not* a user option, since Emerge uses it for its own processing.")
(if temp
(setq file-ancestor temp
startup-hooks
- (cons `(lambda () (delete-file ,file-ancestor))
+ (cons (lambda () (delete-file file-ancestor))
startup-hooks))
;; Verify that the file matches the buffer
(emerge-verify-file-buffer))))
@@ -746,6 +729,7 @@ This is *not* a user option, since Emerge uses it for its own processing.")
buffer-ancestor file-ancestor
&optional startup-hooks quit-hooks
output-file)
+ ;; FIXME: Duplicated code!
(setq file-A (expand-file-name file-A))
(setq file-B (expand-file-name file-B))
(setq file-ancestor (expand-file-name file-ancestor))
@@ -754,36 +738,37 @@ This is *not* a user option, since Emerge uses it for its own processing.")
;; create the merge buffer from buffer A, so it inherits buffer A's
;; default directory, etc.
(merge-buffer (with-current-buffer
- buffer-A
- (get-buffer-create merge-buffer-name))))
+ buffer-A
+ (get-buffer-create merge-buffer-name))))
(with-current-buffer
- merge-buffer
- (emerge-copy-modes buffer-A)
- (setq buffer-read-only nil)
- (auto-save-mode 1)
- (setq emerge-mode t)
- (setq emerge-A-buffer buffer-A)
- (setq emerge-B-buffer buffer-B)
- (setq emerge-ancestor-buffer buffer-ancestor)
- (setq emerge-merge-buffer merge-buffer)
- (setq emerge-output-description
- (if output-file
- (concat "Output to file: " output-file)
- (concat "Output to buffer: " (buffer-name merge-buffer))))
- (save-excursion (insert-buffer-substring emerge-A-buffer))
- (emerge-set-keys)
- (setq emerge-difference-list
- (emerge-make-diff3-list file-A file-B file-ancestor))
- (setq emerge-number-of-differences (length emerge-difference-list))
- (setq emerge-current-difference -1)
- (setq emerge-quit-hook quit-hooks)
- (emerge-remember-buffer-characteristics)
- (emerge-select-prefer-Bs)
- (emerge-handle-local-variables))
+ merge-buffer
+ (emerge-copy-modes buffer-A)
+ (setq buffer-read-only nil)
+ (auto-save-mode 1)
+ (setq emerge-mode t)
+ (setq emerge-A-buffer buffer-A)
+ (setq emerge-B-buffer buffer-B)
+ (setq emerge-ancestor-buffer buffer-ancestor)
+ (setq emerge-merge-buffer merge-buffer)
+ (setq emerge-output-description
+ (if output-file
+ (concat "Output to file: " output-file)
+ (concat "Output to buffer: " (buffer-name merge-buffer))))
+ (save-excursion (insert-buffer-substring emerge-A-buffer))
+ (emerge-set-keys)
+ (setq emerge-difference-list
+ (emerge-make-diff3-list file-A file-B file-ancestor))
+ (setq emerge-number-of-differences (length emerge-difference-list))
+ (setq emerge-current-difference -1)
+ (setq emerge-quit-hook quit-hooks)
+ (emerge-remember-buffer-characteristics)
+ (emerge-select-prefer-Bs)
+ (emerge-handle-local-variables))
(emerge-setup-windows buffer-A buffer-B merge-buffer t)
(with-current-buffer merge-buffer
- (run-hooks 'startup-hooks 'emerge-startup-hook)
- (setq buffer-read-only t))))
+ (mapc #'funcall startup-hooks)
+ (run-hooks 'emerge-startup-hook)
+ (setq buffer-read-only t))))
;; Generate the Emerge difference list between two files with an ancestor
(defun emerge-make-diff3-list (file-A file-B file-ancestor)
@@ -872,7 +857,7 @@ This is *not* a user option, since Emerge uses it for its own processing.")
(emerge-read-file-name "Output file" emerge-last-dir-output
f f nil)))))
(if file-out
- (add-hook 'quit-hooks `(lambda () (emerge-files-exit ,file-out))))
+ (push (lambda () (emerge-files-exit file-out)) quit-hooks))
(emerge-files-internal
file-A file-B startup-hooks
quit-hooks
@@ -894,7 +879,7 @@ This is *not* a user option, since Emerge uses it for its own processing.")
(emerge-read-file-name "Output file" emerge-last-dir-output
f f nil)))))
(if file-out
- (add-hook 'quit-hooks `(lambda () (emerge-files-exit ,file-out))))
+ (push (lambda () (emerge-files-exit file-out)) quit-hooks))
(emerge-files-with-ancestor-internal
file-A file-B file-ancestor startup-hooks
quit-hooks
@@ -922,9 +907,9 @@ This is *not* a user option, since Emerge uses it for its own processing.")
(write-region (point-min) (point-max) emerge-file-B nil 'no-message))
(emerge-setup (get-buffer buffer-A) emerge-file-A
(get-buffer buffer-B) emerge-file-B
- (cons `(lambda ()
- (delete-file ,emerge-file-A)
- (delete-file ,emerge-file-B))
+ (cons (lambda ()
+ (delete-file emerge-file-A)
+ (delete-file emerge-file-B))
startup-hooks)
quit-hooks
nil)))
@@ -953,11 +938,10 @@ This is *not* a user option, since Emerge uses it for its own processing.")
(get-buffer buffer-B) emerge-file-B
(get-buffer buffer-ancestor)
emerge-file-ancestor
- (cons `(lambda ()
- (delete-file ,emerge-file-A)
- (delete-file ,emerge-file-B)
- (delete-file
- ,emerge-file-ancestor))
+ (cons (lambda ()
+ (delete-file emerge-file-A)
+ (delete-file emerge-file-B)
+ (delete-file emerge-file-ancestor))
startup-hooks)
quit-hooks
nil)))
@@ -972,7 +956,7 @@ This is *not* a user option, since Emerge uses it for its own processing.")
(setq command-line-args-left (nthcdr 3 command-line-args-left))
(emerge-files-internal
file-a file-b nil
- (list `(lambda () (emerge-command-exit ,file-out))))))
+ (list (lambda () (emerge-command-exit file-out))))))
;;;###autoload
(defun emerge-files-with-ancestor-command ()
@@ -994,7 +978,7 @@ This is *not* a user option, since Emerge uses it for its own processing.")
(setq command-line-args-left (nthcdr 4 command-line-args-left)))
(emerge-files-with-ancestor-internal
file-a file-b file-anc nil
- (list `(lambda () (emerge-command-exit ,file-out))))))
+ (list (lambda () (emerge-command-exit file-out))))))
(defun emerge-command-exit (file-out)
(emerge-write-and-delete file-out)
@@ -1007,7 +991,8 @@ This is *not* a user option, since Emerge uses it for its own processing.")
(setq emerge-file-out file-out)
(emerge-files-internal
file-a file-b nil
- (list `(lambda () (emerge-remote-exit ,file-out ',emerge-exit-func)))
+ (let ((f emerge-exit-func))
+ (list (lambda () (emerge-remote-exit file-out f))))
file-out)
(throw 'client-wait nil))
@@ -1016,14 +1001,15 @@ This is *not* a user option, since Emerge uses it for its own processing.")
(setq emerge-file-out file-out)
(emerge-files-with-ancestor-internal
file-a file-b file-anc nil
- (list `(lambda () (emerge-remote-exit ,file-out ',emerge-exit-func)))
+ (let ((f emerge-exit-func))
+ (list (lambda () (emerge-remote-exit file-out f))))
file-out)
(throw 'client-wait nil))
-(defun emerge-remote-exit (file-out emerge-exit-func)
+(defun emerge-remote-exit (file-out exit-func)
(emerge-write-and-delete file-out)
(kill-buffer emerge-merge-buffer)
- (funcall emerge-exit-func (if emerge-prefix-argument 1 0)))
+ (funcall exit-func (if emerge-prefix-argument 1 0)))
;;; Functions to start Emerge on RCS versions
@@ -1041,10 +1027,9 @@ This is *not* a user option, since Emerge uses it for its own processing.")
(emerge-revisions-internal
file revision-A revision-B startup-hooks
(if arg
- (cons `(lambda ()
- (shell-command
- ,(format "%s %s" emerge-rcs-ci-program file)))
- quit-hooks)
+ (let ((cmd (format "%s %s" emerge-rcs-ci-program file)))
+ (cons (lambda () (shell-command cmd))
+ quit-hooks))
quit-hooks)))
;;;###autoload
@@ -1065,12 +1050,10 @@ This is *not* a user option, since Emerge uses it for its own processing.")
(emerge-revision-with-ancestor-internal
file revision-A revision-B ancestor startup-hooks
(if arg
- (let ((cmd ))
- (cons `(lambda ()
- (shell-command
- ,(format "%s %s" emerge-rcs-ci-program file)))
+ (let ((cmd (format "%s %s" emerge-rcs-ci-program file)))
+ (cons (lambda () (shell-command cmd))
quit-hooks))
- quit-hooks)))
+ quit-hooks)))
(defun emerge-revisions-internal (file revision-A revision-B &optional
startup-hooks quit-hooks _output-file)
@@ -1098,11 +1081,11 @@ This is *not* a user option, since Emerge uses it for its own processing.")
;; Do the merge
(emerge-setup buffer-A emerge-file-A
buffer-B emerge-file-B
- (cons `(lambda ()
- (delete-file ,emerge-file-A)
- (delete-file ,emerge-file-B))
+ (cons (lambda ()
+ (delete-file emerge-file-A)
+ (delete-file emerge-file-B))
startup-hooks)
- (cons `(lambda () (emerge-files-exit ,file))
+ (cons (lambda () (emerge-files-exit file))
quit-hooks)
nil)))
@@ -1146,12 +1129,12 @@ This is *not* a user option, since Emerge uses it for its own processing.")
(emerge-setup-with-ancestor
buffer-A emerge-file-A buffer-B emerge-file-B
buffer-ancestor emerge-ancestor
- (cons `(lambda ()
- (delete-file ,emerge-file-A)
- (delete-file ,emerge-file-B)
- (delete-file ,emerge-ancestor))
+ (cons (lambda ()
+ (delete-file emerge-file-A)
+ (delete-file emerge-file-B)
+ (delete-file emerge-ancestor))
startup-hooks)
- (cons `(lambda () (emerge-files-exit ,file))
+ (cons (lambda () (emerge-files-exit file))
quit-hooks)
output-file)))
@@ -1233,20 +1216,20 @@ Otherwise, the A or B file present is copied to the output file."
file-ancestor file-out
nil
;; When done, return to this buffer.
- (list
- `(lambda ()
- (switch-to-buffer ,(current-buffer))
- (message "Merge done.")))))
+ (let ((buf (current-buffer)))
+ (list (lambda ()
+ (switch-to-buffer buf)
+ (message "Merge done"))))))
;; Merge of two files without ancestor
((and file-A file-B)
(message "Merging %s and %s..." file-A file-B)
(emerge-files (not (not file-out)) file-A file-B file-out
nil
;; When done, return to this buffer.
- (list
- `(lambda ()
- (switch-to-buffer ,(current-buffer))
- (message "Merge done.")))))
+ (let ((buf (current-buffer)))
+ (list (lambda ()
+ (switch-to-buffer buf)
+ (message "Merge done"))))))
;; There is an output file (or there would have been an error above),
;; but only one input file.
;; The file appears to have been deleted in one version; do nothing.
@@ -1456,9 +1439,8 @@ These characteristics are restored by `emerge-restore-buffer-characteristics'."
merge-buffer
lineno-list)
(let* (marker-list
- (A-point-min (with-current-buffer A-buffer (point-min)))
- (offset (1- A-point-min))
- (B-point-min (with-current-buffer B-buffer (point-min)))
+ (offset (with-current-buffer A-buffer
+ (- (point-min) (save-restriction (widen) (point-min)))))
;; Record current line number in each buffer
;; so we don't have to count from the beginning.
(a-line 1)
@@ -1480,17 +1462,17 @@ These characteristics are restored by `emerge-restore-buffer-characteristics'."
(state (aref list-element 4)))
;; place markers at the appropriate places in the buffers
(with-current-buffer
- A-buffer
- (setq a-line (emerge-goto-line a-begin a-line))
- (setq a-begin-marker (point-marker))
- (setq a-line (emerge-goto-line a-end a-line))
- (setq a-end-marker (point-marker)))
+ A-buffer
+ (setq a-line (emerge-goto-line a-begin a-line))
+ (setq a-begin-marker (point-marker))
+ (setq a-line (emerge-goto-line a-end a-line))
+ (setq a-end-marker (point-marker)))
(with-current-buffer
- B-buffer
- (setq b-line (emerge-goto-line b-begin b-line))
- (setq b-begin-marker (point-marker))
- (setq b-line (emerge-goto-line b-end b-line))
- (setq b-end-marker (point-marker)))
+ B-buffer
+ (setq b-line (emerge-goto-line b-begin b-line))
+ (setq b-begin-marker (point-marker))
+ (setq b-line (emerge-goto-line b-end b-line))
+ (setq b-end-marker (point-marker)))
(setq merge-begin-marker (set-marker
(make-marker)
(- (marker-position a-begin-marker)
@@ -1502,15 +1484,15 @@ These characteristics are restored by `emerge-restore-buffer-characteristics'."
offset)
merge-buffer))
;; record all the markers for this difference
- (setq marker-list (cons (vector a-begin-marker a-end-marker
- b-begin-marker b-end-marker
- merge-begin-marker merge-end-marker
- state)
- marker-list)))
+ (push (vector a-begin-marker a-end-marker
+ b-begin-marker b-end-marker
+ merge-begin-marker merge-end-marker
+ state)
+ marker-list))
(setq lineno-list (cdr lineno-list)))
;; convert the list of difference information into a vector for
;; fast access
- (setq emerge-difference-list (apply 'vector (nreverse marker-list)))))
+ (setq emerge-difference-list (apply #'vector (nreverse marker-list)))))
;; If we have an ancestor, select all B variants that we prefer
(defun emerge-select-prefer-Bs ()
@@ -1636,7 +1618,7 @@ the height of the merge window.
`C-u -' alone as argument scrolls half the height of the merge window."
(interactive "P")
(emerge-operate-on-windows
- 'scroll-up
+ #'scroll-up
;; calculate argument to scroll-up
;; if there is an explicit argument
(if (and arg (not (equal arg '-)))
@@ -1663,7 +1645,7 @@ the height of the merge window.
`C-u -' alone as argument scrolls half the height of the merge window."
(interactive "P")
(emerge-operate-on-windows
- 'scroll-down
+ #'scroll-down
;; calculate argument to scroll-down
;; if there is an explicit argument
(if (and arg (not (equal arg '-)))
@@ -1690,7 +1672,7 @@ the width of the A and B windows. `C-u -' alone as argument scrolls half the
width of the A and B windows."
(interactive "P")
(emerge-operate-on-windows
- 'scroll-left
+ #'scroll-left
;; calculate argument to scroll-left
;; if there is an explicit argument
(if (and arg (not (equal arg '-)))
@@ -1718,7 +1700,7 @@ the width of the A and B windows. `C-u -' alone as argument scrolls half the
width of the A and B windows."
(interactive "P")
(emerge-operate-on-windows
- 'scroll-right
+ #'scroll-right
;; calculate argument to scroll-right
;; if there is an explicit argument
(if (and arg (not (equal arg '-)))
@@ -1745,18 +1727,18 @@ This resets the horizontal scrolling of all three merge buffers
to the left margin, if they are in windows."
(interactive)
(emerge-operate-on-windows
- (lambda (x) (set-window-hscroll (selected-window) 0))
+ (lambda (_) (set-window-hscroll (selected-window) 0))
nil))
-;; Attempt to show the region nicely.
-;; If there are min-lines lines above and below the region, then don't do
-;; anything.
-;; If not, recenter the region to make it so.
-;; If that isn't possible, remove context lines evenly from top and bottom
-;; so the entire region shows.
-;; If that isn't possible, show the top of the region.
-;; BEG must be at the beginning of a line.
(defun emerge-position-region (beg end pos)
+ "Attempt to show the region nicely.
+If there are min-lines lines above and below the region, then don't do
+anything.
+If not, recenter the region to make it so.
+If that isn't possible, remove context lines evenly from top and bottom
+so the entire region shows.
+If that isn't possible, show the top of the region.
+BEG must be at the beginning of a line."
;; First test whether the entire region is visible with
;; emerge-min-visible-lines above and below it
(if (not (and (<= (progn
@@ -1795,7 +1777,7 @@ to the left margin, if they are in windows."
(memq (aref (aref emerge-difference-list n) 6)
'(prefer-A prefer-B)))
(setq n (1+ n)))
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
(emerge-unselect-and-select-difference n)))
(error "At end")))
@@ -1809,14 +1791,14 @@ to the left margin, if they are in windows."
(memq (aref (aref emerge-difference-list n) 6)
'(prefer-A prefer-B)))
(setq n (1- n)))
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
(emerge-unselect-and-select-difference n)))
(error "At beginning")))
(defun emerge-jump-to-difference (difference-number)
"Go to the N-th difference."
(interactive "p")
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
(setq difference-number (1- difference-number))
(if (and (>= difference-number -1)
(< difference-number (1+ emerge-number-of-differences)))
@@ -1878,6 +1860,13 @@ buffer after this will cause serious problems."
(let ((emerge-prefix-argument arg))
(run-hooks 'emerge-quit-hook)))
+(defmacro emerge--current-beg (diff-vector side)
+ ;; +1 because emerge-place-flags-in-buffer1 moved the marker by 1.
+ `(1+ (aref ,diff-vector ,(pcase-exhaustive side ('A 0) ('B 2) ('merge 4)))))
+(defmacro emerge--current-end (diff-vector side)
+ ;; -1 because emerge-place-flags-in-buffer1 moved the marker by 1.
+ `(1- (aref ,diff-vector ,(pcase-exhaustive side ('A 1) ('B 3) ('merge 5)))))
+
(defun emerge-select-A (&optional force)
"Select the A variant of this difference.
Refuses to function if this difference has been edited, i.e., if it
@@ -1885,26 +1874,25 @@ is neither the A nor the B variant.
A prefix argument forces the variant to be selected
even if the difference has been edited."
(interactive "P")
- (let ((operate
- (lambda ()
- (emerge-select-A-edit merge-begin merge-end A-begin A-end)
- (if emerge-auto-advance
- (emerge-next-difference))))
+ (let ((operate #'emerge-select-A-edit)
(operate-no-change
- (lambda () (if emerge-auto-advance
- (emerge-next-difference)))))
+ (lambda (_diff-vector)
+ (if emerge-auto-advance (emerge-next-difference)))))
(emerge-select-version force operate-no-change operate operate)))
;; Actually select the A variant
-(defun emerge-select-A-edit (merge-begin merge-end A-begin A-end)
+(defun emerge-select-A-edit (diff-vector)
(with-current-buffer
- emerge-merge-buffer
- (delete-region merge-begin merge-end)
- (goto-char merge-begin)
- (insert-buffer-substring emerge-A-buffer A-begin A-end)
- (goto-char merge-begin)
- (aset diff-vector 6 'A)
- (emerge-refresh-mode-line)))
+ emerge-merge-buffer
+ (goto-char (emerge--current-beg diff-vector merge))
+ (delete-region (point) (emerge--current-end diff-vector merge))
+ (save-excursion
+ (insert-buffer-substring emerge-A-buffer
+ (emerge--current-beg diff-vector A)
+ (emerge--current-end diff-vector A)))
+ (aset diff-vector 6 'A)
+ (emerge-refresh-mode-line)
+ (if emerge-auto-advance (emerge-next-difference))))
(defun emerge-select-B (&optional force)
"Select the B variant of this difference.
@@ -1913,26 +1901,25 @@ is neither the A nor the B variant.
A prefix argument forces the variant to be selected
even if the difference has been edited."
(interactive "P")
- (let ((operate
- (lambda ()
- (emerge-select-B-edit merge-begin merge-end B-begin B-end)
- (if emerge-auto-advance
- (emerge-next-difference))))
+ (let ((operate #'emerge-select-B-edit)
(operate-no-change
- (lambda () (if emerge-auto-advance
- (emerge-next-difference)))))
+ (lambda (_diff-vector)
+ (if emerge-auto-advance (emerge-next-difference)))))
(emerge-select-version force operate operate-no-change operate)))
;; Actually select the B variant
-(defun emerge-select-B-edit (merge-begin merge-end B-begin B-end)
+(defun emerge-select-B-edit (diff-vector)
(with-current-buffer
- emerge-merge-buffer
- (delete-region merge-begin merge-end)
- (goto-char merge-begin)
- (insert-buffer-substring emerge-B-buffer B-begin B-end)
- (goto-char merge-begin)
- (aset diff-vector 6 'B)
- (emerge-refresh-mode-line)))
+ emerge-merge-buffer
+ (goto-char (emerge--current-beg diff-vector merge))
+ (delete-region (point) (emerge--current-end diff-vector merge))
+ (save-excursion
+ (insert-buffer-substring emerge-B-buffer
+ (emerge--current-beg diff-vector B)
+ (emerge--current-end diff-vector B)))
+ (aset diff-vector 6 'B)
+ (emerge-refresh-mode-line)
+ (if emerge-auto-advance (emerge-next-difference))))
(defun emerge-default-A ()
"Make the A variant the default from here down.
@@ -1940,7 +1927,7 @@ This selects the A variant for all differences from here down in the buffer
which are still defaulted, i.e., which the user has not selected and for
which there is no preference."
(interactive)
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
(let ((selected-difference emerge-current-difference)
(n (max emerge-current-difference 0)))
(while (< n emerge-number-of-differences)
@@ -1962,7 +1949,7 @@ This selects the B variant for all differences from here down in the buffer
which are still defaulted, i.e., which the user has not selected and for
which there is no preference."
(interactive)
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
(let ((selected-difference emerge-current-difference)
(n (max emerge-current-difference 0)))
(while (< n emerge-number-of-differences)
@@ -2071,7 +2058,7 @@ With prefix argument, puts point before, mark after."
(A-begin (1+ (aref diff-vector 0)))
(A-end (1- (aref diff-vector 1)))
(opoint (point))
- (buffer-read-only nil))
+ (inhibit-read-only t))
(insert-buffer-substring emerge-A-buffer A-begin A-end)
(if (not arg)
(set-mark opoint)
@@ -2089,7 +2076,7 @@ With prefix argument, puts point before, mark after."
(B-begin (1+ (aref diff-vector 2)))
(B-end (1- (aref diff-vector 3)))
(opoint (point))
- (buffer-read-only nil))
+ (inhibit-read-only t))
(insert-buffer-substring emerge-B-buffer B-begin B-end)
(if (not arg)
(set-mark opoint)
@@ -2450,28 +2437,28 @@ the nearest previous difference."
(1- index)
(error "No difference contains or precedes point")))))))
+(defvar emerge-line-diff)
+
(defun emerge-line-numbers ()
"Display the current line numbers.
This function displays the line numbers of the points in the A, B, and
merge buffers."
(interactive)
(let* ((valid-diff
- (and (>= emerge-current-difference 0)
- (< emerge-current-difference emerge-number-of-differences)))
+ (and (>= emerge-current-difference 0)
+ (< emerge-current-difference emerge-number-of-differences)))
(emerge-line-diff (and valid-diff
(aref emerge-difference-list
emerge-current-difference)))
- (merge-line (emerge-line-number-in-buf 4 5))
+ (merge-line (emerge-line-number-in-buf valid-diff 4 5))
(A-line (with-current-buffer emerge-A-buffer
- (emerge-line-number-in-buf 0 1)))
+ (emerge-line-number-in-buf valid-diff 0 1)))
(B-line (with-current-buffer emerge-B-buffer
- (emerge-line-number-in-buf 2 3))))
+ (emerge-line-number-in-buf valid-diff 2 3))))
(message "At lines: merge = %d, A = %d, B = %d"
merge-line A-line B-line)))
-(defvar emerge-line-diff)
-
-(defun emerge-line-number-in-buf (begin-marker end-marker)
+(defun emerge-line-number-in-buf (valid-diff begin-marker end-marker)
;; FIXME point-min rather than 1? widen?
(let ((temp (1+ (count-lines 1 (line-beginning-position)))))
(if valid-diff
@@ -2537,46 +2524,41 @@ Interactively, reads the register using `register-read-with-preview'."
(error "Register does not contain text"))
(emerge-combine-versions-internal template force)))
-(defun emerge-combine-versions-internal (emerge-combine-template force)
- (let ((operate
- (lambda ()
- (emerge-combine-versions-edit merge-begin merge-end
- A-begin A-end B-begin B-end)
- (if emerge-auto-advance
- (emerge-next-difference)))))
+(defun emerge-combine-versions-internal (combine-template force)
+ (let ((operate (lambda (diff-vector)
+ (emerge-combine-versions-edit diff-vector
+ combine-template))))
(emerge-select-version force operate operate operate)))
-(defvar emerge-combine-template)
-
-(defun emerge-combine-versions-edit (merge-begin merge-end
- A-begin A-end B-begin B-end)
+(defun emerge-combine-versions-edit (diff-vector combine-template)
(with-current-buffer
- emerge-merge-buffer
- (delete-region merge-begin merge-end)
- (goto-char merge-begin)
- (let ((i 0))
- (while (< i (length emerge-combine-template))
- (let ((c (aref emerge-combine-template i)))
- (if (= c ?%)
- (progn
- (setq i (1+ i))
- (setq c
- (condition-case nil
- (aref emerge-combine-template i)
- (error ?%)))
- (cond ((= c ?a)
- (insert-buffer-substring emerge-A-buffer A-begin A-end))
- ((= c ?b)
- (insert-buffer-substring emerge-B-buffer B-begin B-end))
- ((= c ?%)
- (insert ?%))
- (t
- (insert c))))
- (insert c)))
- (setq i (1+ i))))
- (goto-char merge-begin)
- (aset diff-vector 6 'combined)
- (emerge-refresh-mode-line)))
+ emerge-merge-buffer
+ (goto-char (emerge--current-beg diff-vector merge))
+ (delete-region (point) (emerge--current-end diff-vector merge))
+ (save-excursion
+ (let ((i 0))
+ (while (< i (length combine-template))
+ (let ((c (aref combine-template i)))
+ (if (not (= c ?%))
+ (insert c)
+ (setq i (1+ i))
+ (pcase (condition-case nil
+ (aref combine-template i)
+ (error ?%))
+ (?a
+ (insert-buffer-substring emerge-A-buffer
+ (emerge--current-beg diff-vector A)
+ (emerge--current-end diff-vector A)))
+ (?b
+ (insert-buffer-substring emerge-B-buffer
+ (emerge--current-beg diff-vector B)
+ (emerge--current-end diff-vector B)))
+ (?% (insert ?%))
+ (c (insert c)))))
+ (setq i (1+ i)))))
+ (aset diff-vector 6 'combined)
+ (emerge-refresh-mode-line)
+ (if emerge-auto-advance (emerge-next-difference))))
(defun emerge-set-merge-mode (mode)
"Set the major mode in a merge buffer.
@@ -2617,7 +2599,7 @@ keymap. Leaves merge in fast mode."
(emerge-place-flags-in-buffer1 difference before-index after-index)))
(defun emerge-place-flags-in-buffer1 (difference before-index after-index)
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
;; insert the flag before the difference
(let ((before (aref (aref emerge-globalized-difference-list difference)
before-index))
@@ -2682,7 +2664,7 @@ keymap. Leaves merge in fast mode."
(defun emerge-remove-flags-in-buffer (buffer before after)
(with-current-buffer
buffer
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
;; remove the flags, if they're there
(goto-char (- before (1- emerge-before-flag-length)))
(if (looking-at emerge-before-flag-match)
@@ -2717,18 +2699,18 @@ keymap. Leaves merge in fast mode."
(emerge-recenter)
(emerge-refresh-mode-line))))
-;; Perform tests to see whether user should be allowed to select a version
-;; of this difference:
-;; a valid difference has been selected; and
-;; the difference text in the merge buffer is:
-;; the A version (execute a-version), or
-;; the B version (execute b-version), or
-;; empty (execute neither-version), or
-;; argument FORCE is true (execute neither-version)
-;; Otherwise, signal an error.
(defun emerge-select-version (force a-version b-version neither-version)
+ "Perform tests to see whether user should be allowed to select a version
+of this difference:
+ a valid difference has been selected; and
+ the difference text in the merge buffer is:
+ the A version (execute a-version), or
+ the B version (execute b-version), or
+ empty (execute neither-version), or
+ argument FORCE is true (execute neither-version)
+Otherwise, signal an error."
(emerge-validate-difference)
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
(let* ((diff-vector
(aref emerge-difference-list emerge-current-difference))
(A-begin (1+ (aref diff-vector 0)))
@@ -2740,13 +2722,13 @@ keymap. Leaves merge in fast mode."
(if (emerge-compare-buffers emerge-A-buffer A-begin A-end
emerge-merge-buffer merge-begin
merge-end)
- (funcall a-version)
+ (funcall a-version diff-vector)
(if (emerge-compare-buffers emerge-B-buffer B-begin B-end
emerge-merge-buffer merge-begin
merge-end)
- (funcall b-version)
+ (funcall b-version diff-vector)
(if (or force (= merge-begin merge-end))
- (funcall neither-version)
+ (funcall neither-version diff-vector)
(error "This difference region has been edited")))))))
;; Read a file name, handling all of the various defaulting rules.
@@ -2972,78 +2954,6 @@ If some prefix of KEY has a non-prefix definition, it is redefined."
;; Now define the key
(define-key keymap key definition))
-;;;;; Improvements to describe-mode, so that it describes minor modes as well
-;;;;; as the major mode
-;;(defun describe-mode (&optional minor)
-;; "Display documentation of current major mode.
-;;If optional arg MINOR is non-nil (or prefix argument is given if interactive),
-;;display documentation of active minor modes as well.
-;;For this to work correctly for a minor mode, the mode's indicator variable
-;;\(listed in `minor-mode-alist') must also be a function whose documentation
-;;describes the minor mode."
-;; (interactive)
-;; (with-output-to-temp-buffer "*Help*"
-;; (princ mode-name)
-;; (princ " Mode:\n")
-;; (princ (documentation major-mode))
-;; (let ((minor-modes minor-mode-alist)
-;; (locals (buffer-local-variables)))
-;; (while minor-modes
-;; (let* ((minor-mode (car (car minor-modes)))
-;; (indicator (car (cdr (car minor-modes))))
-;; (local-binding (assq minor-mode locals)))
-;; ;; Document a minor mode if it is listed in minor-mode-alist,
-;; ;; bound locally in this buffer, non-nil, and has a function
-;; ;; definition.
-;; (if (and local-binding
-;; (cdr local-binding)
-;; (fboundp minor-mode))
-;; (progn
-;; (princ (format "\n\n\n%s minor mode (indicator%s):\n"
-;; minor-mode indicator))
-;; (princ (documentation minor-mode)))))
-;; (setq minor-modes (cdr minor-modes))))
-;; (with-current-buffer standard-output
-;; (help-mode))
-;; (help-print-return-message)))
-
-;; This goes with the redefinition of describe-mode.
-;;;; Adjust things so that keyboard macro definitions are documented correctly.
-;;(fset 'defining-kbd-macro (symbol-function 'start-kbd-macro))
-
-;; substitute-key-definition should work now.
-;;;; Function to shadow a definition in a keymap with definitions in another.
-;;(defun emerge-shadow-key-definition (olddef newdef keymap shadowmap)
-;; "Shadow OLDDEF with NEWDEF for any keys in KEYMAP with entries in SHADOWMAP.
-;;In other words, SHADOWMAP will now shadow all definitions of OLDDEF in KEYMAP
-;;with NEWDEF. Does not affect keys that are already defined in SHADOWMAP,
-;;including those whose definition is OLDDEF."
-;; ;; loop through all keymaps accessible from keymap
-;; (let ((maps (accessible-keymaps keymap)))
-;; (while maps
-;; (let ((prefix (car (car maps)))
-;; (map (cdr (car maps))))
-;; ;; examine a keymap
-;; (if (arrayp map)
-;; ;; array keymap
-;; (let ((len (length map))
-;; (i 0))
-;; (while (< i len)
-;; (if (eq (aref map i) olddef)
-;; ;; set the shadowing definition
-;; (let ((key (concat prefix (char-to-string i))))
-;; (emerge-define-key-if-possible shadowmap key newdef)))
-;; (setq i (1+ i))))
-;; ;; sparse keymap
-;; (while map
-;; (if (eq (cdr-safe (car-safe map)) olddef)
-;; ;; set the shadowing definition
-;; (let ((key
-;; (concat prefix (char-to-string (car (car map))))))
-;; (emerge-define-key-if-possible shadowmap key newdef)))
-;; (setq map (cdr map)))))
-;; (setq maps (cdr maps)))))
-
;; Define a key if it (or a prefix) is not already defined in the map.
(defun emerge-define-key-if-possible (keymap key definition)
;; look up the present definition of the key
@@ -3057,18 +2967,6 @@ If some prefix of KEY has a non-prefix definition, it is redefined."
(if (not present)
(define-key keymap key definition)))))
-;; Ordinary substitute-key-definition should do this now.
-;;(defun emerge-recursively-substitute-key-definition (olddef newdef keymap)
-;; "Like `substitute-key-definition', but act recursively on subkeymaps.
-;;Make sure that subordinate keymaps aren't shared with other keymaps!
-;;\(`copy-keymap' will suffice.)"
-;; ;; Loop through all keymaps accessible from keymap
-;; (let ((maps (accessible-keymaps keymap)))
-;; (while maps
-;; ;; Substitute in this keymap
-;; (substitute-key-definition olddef newdef (cdr (car maps)))
-;; (setq maps (cdr maps)))))
-
;; Show the name of the file in the buffer.
(defun emerge-show-file-name ()
"Displays the name of the file loaded into the current buffer.
diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el
index 963edb49dd3..42710dd8dc9 100644
--- a/lisp/vc/log-edit.el
+++ b/lisp/vc/log-edit.el
@@ -52,7 +52,7 @@
;; The main keymap
(easy-mmode-defmap log-edit-mode-map
- `(("\C-c\C-c" . log-edit-done)
+ '(("\C-c\C-c" . log-edit-done)
("\C-c\C-a" . log-edit-insert-changelog)
("\C-c\C-d" . log-edit-show-diff)
("\C-c\C-f" . log-edit-show-files)
@@ -203,10 +203,7 @@ when this variable is set to nil.")
(defconst log-edit-maximum-comment-ring-size 32
"Maximum number of saved comments in the comment ring.")
-(define-obsolete-variable-alias 'vc-comment-ring 'log-edit-comment-ring "22.1")
(defvar log-edit-comment-ring (make-ring log-edit-maximum-comment-ring-size))
-(define-obsolete-variable-alias 'vc-comment-ring-index
- 'log-edit-comment-ring-index "22.1")
(defvar log-edit-comment-ring-index nil)
(defvar log-edit-last-comment-match "")
@@ -311,13 +308,6 @@ automatically."
(or (eobp) (looking-at "\n\n")
(insert "\n"))))
-;; Compatibility with old names.
-(define-obsolete-function-alias 'vc-previous-comment 'log-edit-previous-comment "22.1")
-(define-obsolete-function-alias 'vc-next-comment 'log-edit-next-comment "22.1")
-(define-obsolete-function-alias 'vc-comment-search-reverse 'log-edit-comment-search-backward "22.1")
-(define-obsolete-function-alias 'vc-comment-search-forward 'log-edit-comment-search-forward "22.1")
-(define-obsolete-function-alias 'vc-comment-to-change-log 'log-edit-comment-to-change-log "22.1")
-
;;;
;;; Actual code
;;;
@@ -360,7 +350,7 @@ The first subexpression is the actual text of the field.")
(defun log-edit-goto-eoh () ;FIXME: Almost rfc822-goto-eoh!
(goto-char (point-min))
(when (re-search-forward
- "^\\([^[:alpha:]]\\|[[:alnum:]-]+[^[:alnum:]-:]\\)" nil 'move)
+ "^\\([^[:alpha:]]\\|[[:alnum:]-]+[^[:alnum:]-]\\)" nil 'move)
(goto-char (match-beginning 0))))
(defun log-edit--match-first-line (limit)
@@ -623,7 +613,7 @@ Also saves its contents in the comment history and hides
(setq buffer-read-only nil)
(erase-buffer)
(cvs-insert-strings files)
- (setq buffer-read-only t)
+ (special-mode)
(goto-char (point-min))
(save-selected-window
(cvs-pop-to-buffer-same-frame buf)
@@ -923,8 +913,10 @@ where LOGBUFFER is the name of the ChangeLog buffer, and each
(setq change-log-default-name nil)
(find-change-log)))))
(when (or (find-buffer-visiting changelog-file-name)
- (file-exists-p changelog-file-name))
- (with-current-buffer (find-file-noselect changelog-file-name)
+ (file-exists-p changelog-file-name)
+ add-log-dont-create-changelog-file)
+ (with-current-buffer
+ (add-log-find-changelog-buffer changelog-file-name)
(unless (eq major-mode 'change-log-mode) (change-log-mode))
(goto-char (point-min))
(if (looking-at "\\s-*\n") (goto-char (match-end 0)))
diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el
index b9f386d5158..e47fad89083 100644
--- a/lisp/vc/log-view.el
+++ b/lisp/vc/log-view.el
@@ -157,7 +157,7 @@
(easy-menu-define log-view-mode-menu log-view-mode-map
"Log-View Display Menu"
- `("Log-View"
+ '("Log-View"
;; XXX Do we need menu entries for these?
;; ["Quit" quit-window]
;; ["Kill This Buffer" kill-this-buffer]
@@ -217,7 +217,7 @@ If it is nil, `log-view-toggle-entry-display' does nothing.")
The match group number 1 should match the file name itself.")
(defvar log-view-per-file-logs t
- "Set if to t if the logs are shown one file at a time.")
+ "Set to t if the logs are shown one file at a time.")
(defvar log-view-message-re
(concat "^\\(?:revision \\(?1:[.0-9]+\\)\\(?:\t.*\\)?" ; RCS and CVS.
@@ -517,8 +517,10 @@ Works like `end-of-defun'."
If called interactively, visit the version at point."
(interactive "d")
(unless log-view-per-file-logs
- (when (> (length log-view-vc-fileset) 1)
- (error "Multiple files shown in this buffer, cannot use this command here")))
+ (when (or (> (length log-view-vc-fileset) 1)
+ (null (car log-view-vc-fileset))
+ (file-directory-p (car log-view-vc-fileset)))
+ (user-error "Multiple files shown in this buffer, cannot use this command here")))
(save-excursion
(goto-char pos)
(switch-to-buffer (vc-find-revision (if log-view-per-file-logs
@@ -561,8 +563,10 @@ If called interactively, visit the version at point."
If called interactively, annotate the version at point."
(interactive "d")
(unless log-view-per-file-logs
- (when (> (length log-view-vc-fileset) 1)
- (error "Multiple files shown in this buffer, cannot use this command here")))
+ (when (or (> (length log-view-vc-fileset) 1)
+ (null (car log-view-vc-fileset))
+ (file-directory-p (car log-view-vc-fileset)))
+ (user-error "Multiple files shown in this buffer, cannot use this command here")))
(save-excursion
(goto-char pos)
(vc-annotate (if log-view-per-file-logs
diff --git a/lisp/vc/pcvs-info.el b/lisp/vc/pcvs-info.el
index 28cfccbf293..224bab314d7 100644
--- a/lisp/vc/pcvs-info.el
+++ b/lisp/vc/pcvs-info.el
@@ -39,9 +39,6 @@
;;;; config variables
;;;;
-(define-obsolete-variable-alias 'cvs-display-full-path
- 'cvs-display-full-name "22.1")
-
(defcustom cvs-display-full-name t
"Specifies how the filenames should be displayed in the listing.
If non-nil, their full filename name will be displayed, else only the
@@ -211,8 +208,6 @@ to confuse some users sometimes."
;; Here, I use `concat' rather than `expand-file-name' because I want
;; the resulting path to stay relative if `dir' is relative.
(concat dir (cvs-fileinfo->file fileinfo)))))
-(define-obsolete-function-alias 'cvs-fileinfo->full-path
- 'cvs-fileinfo->full-name "22.1")
(defun cvs-fileinfo->pp-name (fi)
"Return the filename of FI as it should be displayed."
@@ -268,9 +263,9 @@ to confuse some users sometimes."
(setq check 'type) (symbolp type)
(setq check 'consistency)
(pcase type
- (`DIRCHANGE (and (null subtype) (string= "." file)))
- ((or `NEED-UPDATE `ADDED `MISSING `DEAD `MODIFIED `MESSAGE
- `UP-TO-DATE `REMOVED `NEED-MERGE `CONFLICT `UNKNOWN)
+ ('DIRCHANGE (and (null subtype) (string= "." file)))
+ ((or 'NEED-UPDATE 'ADDED 'MISSING 'DEAD 'MODIFIED 'MESSAGE
+ 'UP-TO-DATE 'REMOVED 'NEED-MERGE 'CONFLICT 'UNKNOWN)
t)))
fi
(error "Invalid :%s in cvs-fileinfo %s" check fi))))
@@ -331,11 +326,11 @@ For use by the ewoc package."
(subtype (cvs-fileinfo->subtype fileinfo)))
(insert
(pcase type
- (`DIRCHANGE (concat "In directory "
+ ('DIRCHANGE (concat "In directory "
(cvs-add-face (cvs-fileinfo->full-name fileinfo)
'cvs-header t 'cvs-goal-column t)
":"))
- (`MESSAGE
+ ('MESSAGE
(cvs-add-face (format "Message: %s" (cvs-fileinfo->full-log fileinfo))
'cvs-msg))
(_
@@ -349,7 +344,7 @@ For use by the ewoc package."
(type
(let ((str (pcase type
;;(MOD-CONFLICT "Not Removed")
- (`DEAD "")
+ ('DEAD "")
(_ (capitalize (symbol-name type)))))
(face (let ((sym (intern-soft
(concat "cvs-fi-"
@@ -456,7 +451,8 @@ DIR can also be a file."
((not (file-exists-p (concat dir f))) (setq type 'MISSING))
((equal rev "0") (setq type 'ADDED rev nil))
((equal date "Result of merge") (setq subtype 'MERGED))
- ((let ((mtime (nth 5 (file-attributes (concat dir f))))
+ ((let ((mtime (file-attribute-modification-time
+ (file-attributes (concat dir f))))
(system-time-locale "C"))
(setq timestamp (format-time-string "%c" mtime t))
;; Solaris sometimes uses "Wed Sep 05", not "Wed Sep 5".
diff --git a/lisp/vc/pcvs-parse.el b/lisp/vc/pcvs-parse.el
index 9525ff93be5..0596ccb9129 100644
--- a/lisp/vc/pcvs-parse.el
+++ b/lisp/vc/pcvs-parse.el
@@ -32,6 +32,7 @@
;;; Code:
+(eval-when-compile (require 'cl-lib))
(require 'pcvs-util)
(require 'pcvs-info)
diff --git a/lisp/vc/pcvs.el b/lisp/vc/pcvs.el
index fafeaaedae6..4679996b35b 100644
--- a/lisp/vc/pcvs.el
+++ b/lisp/vc/pcvs.el
@@ -430,11 +430,11 @@ If non-nil, NEW means to create a new buffer no matter what."
(set-buffer buffer)
(and (cvs-buffer-p)
(pcase cvs-reuse-cvs-buffer
- (`always t)
- (`subdir
+ ('always t)
+ ('subdir
(or (string-prefix-p default-directory dir)
(string-prefix-p dir default-directory)))
- (`samedir (string= default-directory dir)))
+ ('samedir (string= default-directory dir)))
(cl-return buffer)))))
;; we really have to create a new buffer:
;; we temporarily bind cwd to "" to prevent
@@ -700,7 +700,7 @@ OLD-FIS is the list of fileinfos on which the cvs command was applied and
;; because of the call to `process-send-eof'.
(save-excursion
(goto-char (point-min))
- (while (re-search-forward "^\\^D+" nil t)
+ (while (re-search-forward "^\\^D\^H+" nil t)
(let ((inhibit-read-only t))
(delete-region (match-beginning 0) (match-end 0))))))
(let* ((fileinfos (cvs-parse-buffer 'cvs-parse-table dcd subdir))
@@ -876,11 +876,11 @@ RM-MSGS if non-nil means remove messages."
(keep
(pcase type
;; Remove temp messages and keep the others.
- (`MESSAGE (not (or rm-msgs (eq subtype 'TEMP))))
+ ('MESSAGE (not (or rm-msgs (eq subtype 'TEMP))))
;; Remove dead entries.
- (`DEAD nil)
+ ('DEAD nil)
;; Handled also?
- (`UP-TO-DATE
+ ('UP-TO-DATE
(not
(if (find-buffer-visiting (cvs-fileinfo->full-name fi))
(eq rm-handled 'all)
diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el
index cb0083a9851..6b1df6603df 100644
--- a/lisp/vc/smerge-mode.el
+++ b/lisp/vc/smerge-mode.el
@@ -44,7 +44,7 @@
;;; Code:
(eval-when-compile (require 'cl-lib))
-(require 'diff-mode) ;For diff-auto-refine-mode.
+(require 'diff-mode) ;For diff-refine.
(require 'newcomment)
;;; The real definition comes later.
@@ -104,7 +104,6 @@ Used in `smerge-diff-base-upper' and related functions."
(((class color))
:foreground "yellow"))
"Face for the base code.")
-(define-obsolete-face-alias 'smerge-base-face 'smerge-base "22.1")
(defvar smerge-base-face 'smerge-base)
(defface smerge-markers
@@ -113,7 +112,6 @@ Used in `smerge-diff-base-upper' and related functions."
(((background dark))
(:background "grey30")))
"Face for the conflict markers.")
-(define-obsolete-face-alias 'smerge-markers-face 'smerge-markers "22.1")
(defvar smerge-markers-face 'smerge-markers)
(defface smerge-refined-changed
@@ -266,7 +264,7 @@ Can be nil if the style is undecided, or else:
;; Define smerge-next and smerge-prev
(easy-mmode-define-navigation smerge smerge-begin-re "conflict" nil nil
- (if diff-auto-refine-mode
+ (if diff-refine
(condition-case nil (smerge-refine) (error nil))))
(defconst smerge-match-names ["conflict" "upper" "base" "lower"])
@@ -365,9 +363,9 @@ function should only apply safe heuristics) and with the match data set
according to `smerge-match-conflict'.")
(defvar smerge-text-properties
- `(help-echo "merge conflict: mouse-3 shows a menu"
- ;; mouse-face highlight
- keymap (keymap (down-mouse-3 . smerge-popup-context-menu))))
+ '(help-echo "merge conflict: mouse-3 shows a menu"
+ ;; mouse-face highlight
+ keymap (keymap (down-mouse-3 . smerge-popup-context-menu))))
(defun smerge-remove-props (beg end)
(remove-overlays beg end 'smerge 'refine)
@@ -1077,9 +1075,10 @@ used to replace chars to try and eliminate some spurious differences."
(if smerge-refine-weight-hack (make-hash-table :test #'equal))))
(unless (markerp beg1) (setq beg1 (copy-marker beg1)))
(unless (markerp beg2) (setq beg2 (copy-marker beg2)))
- ;; Chop up regions into smaller elements and save into files.
- (smerge--refine-chopup-region beg1 end1 file1 preproc)
- (smerge--refine-chopup-region beg2 end2 file2 preproc)
+ (let ((write-region-inhibit-fsync t)) ; Don't fsync temp files (Bug#12747).
+ ;; Chop up regions into smaller elements and save into files.
+ (smerge--refine-chopup-region beg1 end1 file1 preproc)
+ (smerge--refine-chopup-region beg2 end2 file2 preproc))
;; Call diff on those files.
(unwind-protect
@@ -1400,9 +1399,7 @@ with a \\[universal-argument] prefix, makes up a 3-way conflict."
;;;###autoload
(define-minor-mode smerge-mode
"Minor mode to simplify editing output from the diff3 program.
-With a prefix argument ARG, enable the mode if ARG is positive,
-and disable it otherwise. If called from Lisp, enable the mode
-if ARG is omitted or nil.
+
\\{smerge-mode-map}"
:group 'smerge :lighter " SMerge"
(when (and (boundp 'font-lock-mode) font-lock-mode)
@@ -1435,6 +1432,40 @@ If no conflict maker is found, turn off `smerge-mode'."
(smerge-next))
(error (smerge-auto-leave))))
+(defcustom smerge-change-buffer-confirm t
+ "If non-nil, request confirmation before moving to another buffer."
+ :type 'boolean)
+
+(defun smerge-vc-next-conflict ()
+ "Go to next conflict, possibly in another file.
+First tries to go to the next conflict in the current buffer, and if not
+found, uses VC to try and find the next file with conflict."
+ (interactive)
+ (let ((buffer (current-buffer)))
+ (condition-case nil
+ ;; FIXME: Try again from BOB before moving to the next file.
+ (smerge-next)
+ (error
+ (if (and (or smerge-change-buffer-confirm
+ (and (buffer-modified-p) buffer-file-name))
+ (not (or (eq last-command this-command)
+ (eq ?\r last-command-event)))) ;Called via M-x!?
+ ;; FIXME: Don't emit this message if `vc-find-conflicted-file' won't
+ ;; go to another file anyway (because there are no more conflicted
+ ;; files).
+ (message (if (buffer-modified-p)
+ "No more conflicts here. Repeat to save and go to next buffer"
+ "No more conflicts here. Repeat to go to next buffer"))
+ (if (and (buffer-modified-p) buffer-file-name)
+ (save-buffer))
+ (vc-find-conflicted-file)
+ (if (eq buffer (current-buffer))
+ ;; Do nothing: presumably `vc-find-conflicted-file' already
+ ;; emitted a message explaining there aren't any more conflicts.
+ nil
+ (goto-char (point-min))
+ (smerge-next)))))))
+
(provide 'smerge-mode)
;;; smerge-mode.el ends here
diff --git a/lisp/vc/vc-annotate.el b/lisp/vc/vc-annotate.el
index 86fc8686c39..84838135fcc 100644
--- a/lisp/vc/vc-annotate.el
+++ b/lisp/vc/vc-annotate.el
@@ -541,7 +541,9 @@ Return a cons (REV . FILENAME)."
(setq prev-rev
(vc-call-backend vc-annotate-backend 'previous-revision
fname rev))
- (vc-annotate-warp-revision prev-rev fname)))))
+ (if (not prev-rev)
+ (message "No previous revisions")
+ (vc-annotate-warp-revision prev-rev fname))))))
(defvar log-view-vc-backend)
(defvar log-view-vc-fileset)
diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index a33560aa47a..ab5a449cd3d 100644
--- a/lisp/vc/vc-bzr.el
+++ b/lisp/vc/vc-bzr.el
@@ -268,8 +268,8 @@ in the repository root directory of FILE."
;; If file is in dirstate, can only be added (b#8025).
((or (not (match-beginning 4))
(eq (char-after (match-beginning 4)) ?a)) 'added)
- ((or (and (eq (string-to-number (match-string 3))
- (nth 7 (file-attributes file)))
+ ((or (and (eql (string-to-number (match-string 3))
+ (file-attribute-size (file-attributes file)))
(equal (match-string 5)
(save-match-data (vc-bzr-sha1 file)))
;; For a file, does the executable state match?
@@ -281,7 +281,8 @@ in the repository root directory of FILE."
?x
(mapcar
'identity
- (nth 8 (file-attributes file))))))
+ (file-attribute-modes
+ (file-attributes file))))))
(if (eq (char-after (match-beginning 7))
?y)
exe
@@ -291,8 +292,8 @@ in the repository root directory of FILE."
;; checkouts \2 is empty and we need to
;; look for size in \6.
(eq (match-beginning 2) (match-end 2))
- (eq (string-to-number (match-string 6))
- (nth 7 (file-attributes file)))
+ (eql (string-to-number (match-string 6))
+ (file-attribute-size (file-attributes file)))
(equal (match-string 5)
(vc-bzr-sha1 file))))
'up-to-date)
@@ -331,7 +332,7 @@ in the repository root directory of FILE."
(file-relative-name filename* rootdir))))
(defvar vc-bzr-error-regexp-alist
- '(("^\\( M[* ]\\|+N \\|-D \\|\\| \\*\\|R[M ] \\) \\(.+\\)" 2 nil nil 1)
+ '(("^\\( M[* ]\\|\\+N \\|-D \\|\\| \\*\\|R[M ] \\) \\(.+\\)" 2 nil nil 1)
("^C \\(.+\\)" 2)
("^Text conflict in \\(.+\\)" 1 nil nil 2)
("^Using saved parent location: \\(.+\\)" 1 nil nil 0))
@@ -694,7 +695,6 @@ or a superior directory.")
(defvar log-view-message-re)
(defvar log-view-file-re)
(defvar log-view-font-lock-keywords)
-(defvar log-view-current-tag-function)
(defvar log-view-per-file-logs)
(defvar log-view-expanded-log-entry-function)
@@ -782,7 +782,11 @@ If LIMIT is non-nil, show no more than this many entries."
(defun vc-bzr-expanded-log-entry (revision)
(with-temp-buffer
(apply 'vc-bzr-command "log" t nil nil
- (list "--long" (format "-r%s" revision)))
+ (append
+ (list "--long" (format "-r%s" revision))
+ (if (stringp vc-bzr-log-switches)
+ (list vc-bzr-log-switches)
+ vc-bzr-log-switches)))
(goto-char (point-min))
(when (looking-at "^-+\n")
;; Indent the expanded log entry.
@@ -1243,7 +1247,11 @@ stream. Standard error output is discarded."
(let ((vc-bzr-revisions '())
(default-directory (file-name-directory (car files))))
(with-temp-buffer
- (vc-bzr-command "log" t 0 files "--line")
+ (apply 'vc-bzr-command "log" t 0 files
+ (append '("--line")
+ (if (stringp vc-bzr-log-switches)
+ (list vc-bzr-log-switches)
+ vc-bzr-log-switches)))
(let ((start (point-min))
(loglines (buffer-substring-no-properties (point-min) (point-max))))
(while (string-match "^\\([0-9]+\\):" loglines)
diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el
index b4419a4db30..626e190c1e8 100644
--- a/lisp/vc/vc-cvs.el
+++ b/lisp/vc/vc-cvs.el
@@ -57,7 +57,7 @@
;; (We actually shouldn't trust this, but there is
;; no other way to learn this from CVS at the
;; moment (version 1.9).)
- (string-match "r-..-..-." (nth 8 attrib)))
+ (string-match "r-..-..-." (file-attribute-modes attrib)))
'announce
'implicit))))))
@@ -257,7 +257,7 @@ See also variable `vc-cvs-sticky-date-format-string'."
;; If the file has not changed since checkout, consider it `up-to-date'.
;; Otherwise consider it `edited'.
(let ((checkout-time (vc-file-getprop file 'vc-checkout-time))
- (lastmod (nth 5 (file-attributes file))))
+ (lastmod (file-attribute-modification-time (file-attributes file))))
(cond
((equal checkout-time lastmod) 'up-to-date)
((string= (vc-working-revision file) "0") 'added)
@@ -524,7 +524,8 @@ The changes are between FIRST-REVISION and SECOND-REVISION."
(string= (match-string 1) "P "))
(vc-file-setprop file 'vc-state 'up-to-date)
(vc-file-setprop file 'vc-checkout-time
- (nth 5 (file-attributes file)))
+ (file-attribute-modification-time
+ (file-attributes file)))
0);; indicate success to the caller
;; Merge successful, but our own changes are still in the file
((string= (match-string 1) "M ")
@@ -649,7 +650,7 @@ Optional arg REVISION is a revision to annotate from."
"Return the current time, based at midnight of the current day, and
encoded as fractional days."
(vc-annotate-convert-time
- (apply 'encode-time 0 0 0 (nthcdr 3 (decode-time)))))
+ (apply #'encode-time 0 0 0 (nthcdr 3 (decode-time)))))
(defun vc-cvs-annotate-time ()
"Return the time of the next annotation (as fraction of days)
@@ -748,7 +749,8 @@ If UPDATE is non-nil, then update (resynch) any affected buffers."
(vc-file-setprop file 'vc-state 'up-to-date)
(vc-file-setprop file 'vc-working-revision nil)
(vc-file-setprop file 'vc-checkout-time
- (nth 5 (file-attributes file))))
+ (file-attribute-modification-time
+ (file-attributes file))))
((or (string= state "M")
(string= state "C"))
(vc-file-setprop file 'vc-state 'edited)
@@ -908,7 +910,7 @@ essential information. Note that this can never set the `ignored'
state."
(let (file status missing)
(goto-char (point-min))
- (while (looking-at "? \\(.*\\)")
+ (while (looking-at "\\? \\(.*\\)")
(setq file (expand-file-name (match-string 1)))
(vc-file-setprop file 'vc-state 'unregistered)
(forward-line 1))
@@ -931,7 +933,8 @@ state."
(cond
((string-match "Up-to-date" status)
(vc-file-setprop file 'vc-checkout-time
- (nth 5 (file-attributes file)))
+ (file-attribute-modification-time
+ (file-attributes file)))
'up-to-date)
((string-match "Locally Modified" status) 'edited)
((string-match "Needs Merge" status) 'needs-merge)
@@ -1084,7 +1087,7 @@ CVS/Entries should only be accessed through this function."
;; an uppercase or lowercase letter and can contain uppercase and
;; lowercase letters, digits, `-', and `_'.
(and (string-match "^[a-zA-Z]" tag)
- (not (string-match "[^a-z0-9A-Z-_]" tag))))
+ (not (string-match "[^a-z0-9A-Z_-]" tag))))
(defun vc-cvs-valid-revision-number-p (tag)
"Return non-nil if TAG is a valid revision number."
@@ -1174,16 +1177,15 @@ is non-nil."
;; (which is based on textual comparison), because there can be problems
;; generating a time string that looks exactly like the one from CVS.
(let* ((time (match-string 2))
- (mtime (nth 5 (file-attributes file)))
+ (mtime (file-attribute-modification-time (file-attributes file)))
(parsed-time (progn (require 'parse-time)
(parse-time-string (concat time " +0000")))))
(cond ((and (not (string-match "\\+" time))
(car parsed-time)
;; Compare just the seconds part of the file time,
;; since CVS file time stamp resolution is just 1 second.
- (let ((ptime (apply 'encode-time parsed-time)))
- (and (eq (car mtime) (car ptime))
- (eq (cadr mtime) (cadr ptime)))))
+ (= (encode-time mtime 'integer)
+ (encode-time parsed-time 'integer)))
(vc-file-setprop file 'vc-checkout-time mtime)
(if set-state (vc-file-setprop file 'vc-state 'up-to-date)))
(t
diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el
index 39894952e05..75697e389ad 100644
--- a/lisp/vc/vc-dir.el
+++ b/lisp/vc/vc-dir.el
@@ -554,11 +554,15 @@ If a prefix argument is given, move by that many lines."
(defun vc-dir-mark-unmark (mark-unmark-function)
(if (use-region-p)
- (let (;; (firstl (line-number-at-pos (region-beginning)))
+ (let ((processed-line nil)
(lastl (line-number-at-pos (region-end))))
(save-excursion
(goto-char (region-beginning))
- (while (<= (line-number-at-pos) lastl)
+ (while (and (<= (line-number-at-pos) lastl)
+ ;; We make sure to not get stuck processing the
+ ;; same line in an infinite loop.
+ (not (eq processed-line (line-number-at-pos))))
+ (setq processed-line (line-number-at-pos))
(condition-case nil
(funcall mark-unmark-function)
;; `vc-dir-mark-file' signals an error if we try marking
diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el
index 54c0880d444..edbb83f3df7 100644
--- a/lisp/vc/vc-dispatcher.el
+++ b/lisp/vc/vc-dispatcher.el
@@ -290,16 +290,16 @@ case, and the process object in the asynchronous case."
(let* ((files
(mapcar (lambda (f) (file-relative-name (expand-file-name f)))
(if (listp file-or-list) file-or-list (list file-or-list))))
+ ;; Keep entire commands in *Messages* but avoid resizing the
+ ;; echo area. Messages in this function are formatted in
+ ;; a such way that the important parts are at the beginning,
+ ;; due to potential truncation of long messages.
+ (message-truncate-lines t)
(full-command
- ;; What we're doing here is preparing a version of the command
- ;; for display in a debug-progress message. If it's fewer than
- ;; 20 characters display the entire command (without trailing
- ;; newline). Otherwise display the first 20 followed by an ellipsis.
(concat (if (string= (substring command -1) "\n")
(substring command 0 -1)
command)
- " "
- (vc-delistify (mapcar (lambda (s) (if (> (length s) 20) (concat (substring s 0 2) "...") s)) flags))
+ " " (vc-delistify flags)
" " (vc-delistify files))))
(save-current-buffer
(unless (or (eq buffer t)
@@ -324,7 +324,7 @@ case, and the process object in the asynchronous case."
(apply 'start-file-process command (current-buffer)
command squeezed))))
(when vc-command-messages
- (message "Running %s in background..." full-command))
+ (message "Running in background: %s" full-command))
;; Get rid of the default message insertion, in case we don't
;; set a sentinel explicitly.
(set-process-sentinel proc #'ignore)
@@ -332,10 +332,11 @@ case, and the process object in the asynchronous case."
(setq status proc)
(when vc-command-messages
(vc-run-delayed
- (message "Running %s in background... done" full-command))))
+ (let ((message-truncate-lines t))
+ (message "Done in background: %s" full-command)))))
;; Run synchronously
(when vc-command-messages
- (message "Running %s in foreground..." full-command))
+ (message "Running in foreground: %s" full-command))
(let ((buffer-undo-list t))
(setq status (apply 'process-file command nil t nil squeezed)))
(when (and (not (eq t okstatus))
@@ -345,13 +346,14 @@ case, and the process object in the asynchronous case."
(pop-to-buffer (current-buffer))
(goto-char (point-min))
(shrink-window-if-larger-than-buffer))
- (error "Running %s...FAILED (%s)" full-command
- (if (integerp status) (format "status %d" status) status)))
+ (error "Failed (%s): %s"
+ (if (integerp status) (format "status %d" status) status)
+ full-command))
(when vc-command-messages
- (message "Running %s...OK = %d" full-command status))))
+ (message "Done (status=%d): %s" status full-command))))
(vc-run-delayed
- (run-hook-with-args 'vc-post-command-functions
- command file-or-list flags))
+ (run-hook-with-args 'vc-post-command-functions
+ command file-or-list flags))
status))))
(defun vc-do-async-command (buffer root command &rest args)
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 610cbde7a49..a921ff1bb88 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -101,9 +101,9 @@
(eval-when-compile
(require 'cl-lib)
+ (require 'subr-x) ; for string-trim-right
(require 'vc)
- (require 'vc-dir)
- (require 'grep))
+ (require 'vc-dir))
(defgroup vc-git nil
"VC Git backend."
@@ -180,9 +180,21 @@ Should be consistent with the Git config value i18n.logOutputEncoding."
:type '(coding-system :tag "Coding system to decode Git log output")
:version "25.1")
+(defcustom vc-git-grep-template "git --no-pager grep -n -e <R> -- <F>"
+ "The default command to run for \\[vc-git-grep].
+The following place holders should be present in the string:
+ <F> - file names and wildcards to search.
+ <R> - the regular expression searched for."
+ :type 'string
+ :version "27.1")
+
;; History of Git commands.
(defvar vc-git-history nil)
+;; Clear up the cache to force vc-call to check again and discover
+;; new functions when we reload this file.
+(put 'Git 'vc-functions nil)
+
;;; BACKEND PROPERTIES
(defun vc-git-revision-granularity () 'repository)
@@ -242,7 +254,7 @@ Should be consistent with the Git config value i18n.logOutputEncoding."
;; Git for Windows appends ".windows.N" to the
;; numerical version reported by Git.
(string-match
- "git version \\([0-9.]+\\)\\(\.windows.[0-9]+\\)?$"
+ "git version \\([0-9.]+\\)\\(\\.windows\\.[0-9]+\\)?$"
version-string))
(match-string 1 version-string)
"0")))))
@@ -278,7 +290,7 @@ in the order given by 'git status'."
;; 2. When a file A is renamed to B in the index and then back to A
;; in the working tree.
;; In both of these instances, `unregistered' is a reasonable response.
- (`("D " "??") 'unregistered)
+ ('("D " "??") 'unregistered)
;; In other cases, let us return `edited'.
(_ 'edited)))
@@ -364,8 +376,8 @@ in the order given by 'git status'."
(defun vc-git-file-type-as-string (old-perm new-perm)
"Return a string describing the file type based on its permissions."
- (let* ((old-type (lsh (or old-perm 0) -9))
- (new-type (lsh (or new-perm 0) -9))
+ (let* ((old-type (ash (or old-perm 0) -9))
+ (new-type (ash (or new-perm 0) -9))
(str (pcase new-type
(?\100 ;; File.
(pcase old-type
@@ -475,9 +487,9 @@ or an empty string if none."
(files (vc-git-dir-status-state->files git-state)))
(goto-char (point-min))
(pcase (vc-git-dir-status-state->stage git-state)
- (`update-index
+ ('update-index
(setq next-stage (if (vc-git--empty-db-p) 'ls-files-added 'diff-index)))
- (`ls-files-added
+ ('ls-files-added
(setq next-stage 'ls-files-unknown)
(while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 0\t\\([^\0]+\\)\0" nil t)
(let ((new-perm (string-to-number (match-string 1) 8))
@@ -485,7 +497,7 @@ or an empty string if none."
(vc-git-dir-status-update-file
git-state name 'added
(vc-git-create-extra-fileinfo 0 new-perm)))))
- (`ls-files-up-to-date
+ ('ls-files-up-to-date
(setq next-stage 'ls-files-unknown)
(while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} \\([0-3]\\)\t\\([^\0]+\\)\0" nil t)
(let ((perm (string-to-number (match-string 1) 8))
@@ -496,7 +508,7 @@ or an empty string if none."
'up-to-date
'conflict)
(vc-git-create-extra-fileinfo perm perm)))))
- (`ls-files-conflict
+ ('ls-files-conflict
(setq next-stage 'ls-files-unknown)
;; It's enough to look for "3" to notice a conflict.
(while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 3\t\\([^\0]+\\)\0" nil t)
@@ -505,16 +517,16 @@ or an empty string if none."
(vc-git-dir-status-update-file
git-state name 'conflict
(vc-git-create-extra-fileinfo perm perm)))))
- (`ls-files-unknown
+ ('ls-files-unknown
(when files (setq next-stage 'ls-files-ignored))
(while (re-search-forward "\\([^\0]*?\\)\0" nil t 1)
(vc-git-dir-status-update-file git-state (match-string 1) 'unregistered
(vc-git-create-extra-fileinfo 0 0))))
- (`ls-files-ignored
+ ('ls-files-ignored
(while (re-search-forward "\\([^\0]*?\\)\0" nil t 1)
(vc-git-dir-status-update-file git-state (match-string 1) 'ignored
(vc-git-create-extra-fileinfo 0 0))))
- (`diff-index
+ ('diff-index
(setq next-stage (if files 'ls-files-up-to-date 'ls-files-conflict))
(while (re-search-forward
":\\([0-7]\\{6\\}\\) \\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} [0-9a-f]\\{40\\} \\(\\([ADMUT]\\)\0\\([^\0]+\\)\\|\\([CR]\\)[0-9]*\0\\([^\0]+\\)\0\\([^\0]+\\)\\)\0"
@@ -566,30 +578,30 @@ or an empty string if none."
(let ((files (vc-git-dir-status-state->files git-state)))
(erase-buffer)
(pcase (vc-git-dir-status-state->stage git-state)
- (`update-index
+ ('update-index
(if files
(vc-git-command (current-buffer) 'async files "add" "--refresh" "--")
(vc-git-command (current-buffer) 'async nil
"update-index" "--refresh")))
- (`ls-files-added
+ ('ls-files-added
(vc-git-command (current-buffer) 'async files
"ls-files" "-z" "-c" "-s" "--"))
- (`ls-files-up-to-date
+ ('ls-files-up-to-date
(vc-git-command (current-buffer) 'async files
"ls-files" "-z" "-c" "-s" "--"))
- (`ls-files-conflict
+ ('ls-files-conflict
(vc-git-command (current-buffer) 'async files
"ls-files" "-z" "-u" "--"))
- (`ls-files-unknown
+ ('ls-files-unknown
(vc-git-command (current-buffer) 'async files
"ls-files" "-z" "-o" "--directory"
"--no-empty-directory" "--exclude-standard" "--"))
- (`ls-files-ignored
+ ('ls-files-ignored
(vc-git-command (current-buffer) 'async files
"ls-files" "-z" "-o" "-i" "--directory"
"--no-empty-directory" "--exclude-standard" "--"))
;; --relative added in Git 1.5.5.
- (`diff-index
+ ('diff-index
(vc-git-command (current-buffer) 'async files
"diff-index" "--relative" "-z" "-M" "HEAD" "--")))
(vc-run-delayed
@@ -746,6 +758,11 @@ the commit message."
(interactive)
(log-edit-toggle-header "Sign-Off" "yes"))
+(defun vc-git-log-edit-toggle-no-verify ()
+ "Toggle whether to bypass the pre-commit and commit-msg hooks."
+ (interactive)
+ (log-edit-toggle-header "No-Verify" "yes"))
+
(defun vc-git-log-edit-toggle-amend ()
"Toggle whether this will amend the previous commit.
If toggling on, also insert its message into the buffer."
@@ -771,6 +788,7 @@ If toggling on, also insert its message into the buffer."
(defvar vc-git-log-edit-mode-map
(let ((map (make-sparse-keymap "Git-Log-Edit")))
(define-key map "\C-c\C-s" 'vc-git-log-edit-toggle-signoff)
+ (define-key map "\C-c\C-n" 'vc-git-log-edit-toggle-no-verify)
(define-key map "\C-c\C-e" 'vc-git-log-edit-toggle-amend)
map))
@@ -814,6 +832,7 @@ It is based on `log-edit-mode', and has Git-specific extensions.")
`(("Author" . "--author")
("Date" . "--date")
("Amend" . ,(boolean-arg-fn "--amend"))
+ ("No-Verify" . ,(boolean-arg-fn "--no-verify"))
("Sign-Off" . ,(boolean-arg-fn "--signoff")))
comment)))
(when msg-file
@@ -863,6 +882,8 @@ It is based on `log-edit-mode', and has Git-specific extensions.")
;; To be called via vc-pull from vc.el, which requires vc-dispatcher.
(declare-function vc-compilation-mode "vc-dispatcher" (backend))
+(defvar compilation-directory)
+(defvar compilation-arguments)
(defun vc-git--pushpull (command prompt extra-args)
"Run COMMAND (a string; either push or pull) on the current Git branch.
@@ -997,7 +1018,8 @@ This prompts for a branch to merge from."
If SHORTLOG is non-nil, use a short format based on `vc-git-root-log-format'.
\(This requires at least Git version 1.5.6, for the --graph option.)
If START-REVISION is non-nil, it is the newest revision to show.
-If LIMIT is non-nil, show no more than this many entries."
+If LIMIT is a number, show no more than this many entries.
+If LIMIT is a revision string, use it as an end-revision."
(let ((coding-system-for-read
(or coding-system-for-read vc-git-log-output-coding-system)))
;; `vc-do-command' creates the buffer, but we need it before running
@@ -1025,8 +1047,14 @@ If LIMIT is non-nil, show no more than this many entries."
,(format "--pretty=tformat:%s"
(car vc-git-root-log-format))
"--abbrev-commit"))
- (when limit (list "-n" (format "%s" limit)))
- (when start-revision (list start-revision))
+ (when (numberp limit)
+ (list "-n" (format "%s" limit)))
+ (when start-revision
+ (if (and limit (not (numberp limit)))
+ (list (concat start-revision ".." (if (equal limit "")
+ "HEAD"
+ limit)))
+ (list start-revision)))
'("--")))))))
(defun vc-git-log-outgoing (buffer remote-location)
@@ -1057,6 +1085,10 @@ If LIMIT is non-nil, show no more than this many entries."
"@{upstream}"
remote-location))))
+(defun vc-git-mergebase (rev1 &optional rev2)
+ (unless rev2 (setq rev2 "HEAD"))
+ (string-trim-right (vc-git--run-command-string nil "merge-base" rev1 rev2)))
+
(defvar log-view-message-re)
(defvar log-view-file-re)
(defvar log-view-font-lock-keywords)
@@ -1073,7 +1105,7 @@ If LIMIT is non-nil, show no more than this many entries."
(cadr vc-git-root-log-format)
"^commit *\\([0-9a-z]+\\)"))
;; Allow expanding short log entries.
- (when (memq vc-log-view-type '(short log-outgoing log-incoming))
+ (when (memq vc-log-view-type '(short log-outgoing log-incoming mergebase))
(setq truncate-lines t)
(set (make-local-variable 'log-view-expanded-log-entry-function)
'vc-git-expanded-log-entry))
@@ -1176,7 +1208,7 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
(defvar vc-git--log-view-long-font-lock-keywords nil)
(defvar font-lock-keywords)
(defvar vc-git-region-history-font-lock-keywords
- `((vc-git-region-history-font-lock)))
+ '((vc-git-region-history-font-lock)))
(defun vc-git-region-history-font-lock (limit)
(let ((in-diff (save-excursion
@@ -1373,6 +1405,9 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
(define-key map [git-grep]
'(menu-item "Git grep..." vc-git-grep
:help "Run the `git grep' command"))
+ (define-key map [git-ds]
+ '(menu-item "Delete Stash..." vc-git-stash-delete
+ :help "Delete a stash"))
(define-key map [git-sn]
'(menu-item "Stash a Snapshot" vc-git-stash-snapshot
:help "Stash the current state of the tree and keep the current state"))
@@ -1397,6 +1432,7 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
(declare-function grep-read-files "grep" (regexp))
(declare-function grep-expand-template "grep"
(template &optional regexp files dir excl))
+(defvar compilation-environment)
;; Derived from `lgrep'.
(defun vc-git-grep (regexp &optional files dir)
@@ -1423,8 +1459,7 @@ This command shares argument histories with \\[rgrep] and \\[grep]."
(cond
((equal current-prefix-arg '(16))
(list (read-from-minibuffer "Run: " "git grep"
- nil nil 'grep-history)
- nil))
+ nil nil 'grep-history)))
(t (let* ((regexp (grep-read-regexp))
(files
(mapconcat #'shell-quote-argument
@@ -1434,13 +1469,15 @@ This command shares argument histories with \\[rgrep] and \\[grep]."
(list regexp files dir))))))
(require 'grep)
(when (and (stringp regexp) (> (length regexp) 0))
+ (unless (and dir (file-accessible-directory-p dir))
+ (setq dir default-directory))
(let ((command regexp))
(if (null files)
(if (string= command "git grep")
(setq command nil))
(setq dir (file-name-as-directory (expand-file-name dir)))
(setq command
- (grep-expand-template "git --no-pager grep -n -e <R> -- <F>"
+ (grep-expand-template vc-git-grep-template
regexp files))
(when command
(if (equal current-prefix-arg '(4))
@@ -1457,17 +1494,36 @@ This command shares argument histories with \\[rgrep] and \\[grep]."
(if (eq next-error-last-buffer (current-buffer))
(setq default-directory dir))))))
+(autoload 'vc-dir-marked-files "vc-dir")
+
(defun vc-git-stash (name)
"Create a stash."
(interactive "sStash name: ")
(let ((root (vc-git-root default-directory)))
(when root
- (vc-git--call nil "stash" "save" name)
+ (apply #'vc-git--call nil "stash" "push" "-m" name
+ (when (derived-mode-p 'vc-dir-mode)
+ (vc-dir-marked-files)))
(vc-resynch-buffer root t t))))
+(defvar vc-git-stash-read-history nil
+ "History for `vc-git-stash-read'.")
+
+(defun vc-git-stash-read (prompt)
+ "Read a Git stash. PROMPT is a string to prompt with."
+ (let ((stash (completing-read
+ prompt
+ (split-string
+ (or (vc-git--run-command-string nil "stash" "list") "") "\n")
+ nil :require-match nil 'vc-git-stash-read-history)))
+ (if (string-equal stash "")
+ (user-error "Not a stash")
+ (string-match "^stash@{[[:digit:]]+}" stash)
+ (match-string 0 stash))))
+
(defun vc-git-stash-show (name)
"Show the contents of stash NAME."
- (interactive "sStash name: ")
+ (interactive (list (vc-git-stash-read "Show stash: ")))
(vc-setup-buffer "*vc-git-stash*")
(vc-git-command "*vc-git-stash*" 'async nil "stash" "show" "-p" name)
(set-buffer "*vc-git-stash*")
@@ -1477,24 +1533,27 @@ This command shares argument histories with \\[rgrep] and \\[grep]."
(defun vc-git-stash-apply (name)
"Apply stash NAME."
- (interactive "sApply stash: ")
+ (interactive (list (vc-git-stash-read "Apply stash: ")))
(vc-git-command "*vc-git-stash*" 0 nil "stash" "apply" "-q" name)
(vc-resynch-buffer (vc-git-root default-directory) t t))
(defun vc-git-stash-pop (name)
"Pop stash NAME."
- (interactive "sPop stash: ")
+ (interactive (list (vc-git-stash-read "Pop stash: ")))
(vc-git-command "*vc-git-stash*" 0 nil "stash" "pop" "-q" name)
(vc-resynch-buffer (vc-git-root default-directory) t t))
+(defun vc-git-stash-delete (name)
+ "Delete stash NAME."
+ (interactive (list (vc-git-stash-read "Delete stash: ")))
+ (vc-git-command "*vc-git-stash*" 0 nil "stash" "drop" "-q" name)
+ (vc-resynch-buffer (vc-git-root default-directory) t t))
+
(defun vc-git-stash-snapshot ()
"Create a stash with the current tree state."
(interactive)
(vc-git--call nil "stash" "save"
- (let ((ct (current-time)))
- (concat
- (format-time-string "Snapshot on %Y-%m-%d" ct)
- (format-time-string " at %H:%M" ct))))
+ (format-time-string "Snapshot on %Y-%m-%d at %H:%M"))
(vc-git-command "*vc-git-stash*" 0 nil "stash" "apply" "-q" "stash@{0}")
(vc-resynch-buffer (vc-git-root default-directory) t t))
@@ -1555,7 +1614,14 @@ The difference to vc-do-command is that this function always invokes
(or coding-system-for-read vc-git-log-output-coding-system))
(coding-system-for-write
(or coding-system-for-write vc-git-commits-coding-system))
- (process-environment (cons "GIT_DIR" process-environment)))
+ (process-environment
+ (append
+ `("GIT_DIR"
+ ;; Avoid repository locking during background operations
+ ;; (bug#21559).
+ ,@(when revert-buffer-in-progress-p
+ '("GIT_OPTIONAL_LOCKS=0")))
+ process-environment)))
(apply 'vc-do-command (or buffer "*vc*") okstatus vc-git-program
;; https://debbugs.gnu.org/16897
(unless (and (not (cdr-safe file-or-list))
@@ -1575,15 +1641,22 @@ 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-null-byte-detection', otherwise
+ ;; directories. We enable `inhibit-nul-byte-detection', otherwise
;; Tramp's eol conversion might be confused.
- (let ((inhibit-null-byte-detection t)
+ (let ((inhibit-nul-byte-detection t)
(coding-system-for-read
(or coding-system-for-read vc-git-log-output-coding-system))
(coding-system-for-write
(or coding-system-for-write vc-git-commits-coding-system))
- (process-environment (cons "PAGER=" process-environment)))
- (push "GIT_DIR" process-environment)
+ (process-environment
+ (append
+ `("GIT_DIR"
+ "PAGER="
+ ;; Avoid repository locking during background operations
+ ;; (bug#21559).
+ ,@(when revert-buffer-in-progress-p
+ '("GIT_OPTIONAL_LOCKS=0")))
+ process-environment)))
(apply 'process-file vc-git-program nil buffer nil command args)))
(defun vc-git--out-ok (command &rest args)
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index eab7e566b27..6b17e861dda 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -101,12 +101,12 @@
;;; Code:
+(require 'cl-lib)
+
(eval-when-compile
(require 'vc)
(require 'vc-dir))
-(require 'cl-lib)
-
(declare-function vc-compilation-mode "vc-dispatcher" (backend))
;;; Customization options
@@ -145,6 +145,15 @@ switches."
:version "25.1"
:group 'vc-hg)
+(defcustom vc-hg-revert-switches nil
+ "String or list of strings specifying switches for hg revert
+under VC."
+ :type '(choice (const :tag "None" nil)
+ (string :tag "Argument String")
+ (repeat :tag "Argument List" :value ("") string))
+ :version "27.1"
+ :group 'vc-hg)
+
(defcustom vc-hg-program "hg"
"Name of the Mercurial executable (excluding any arguments)."
:type 'string
@@ -175,6 +184,10 @@ highlighting the Log View buffer."
:version "24.5")
+;; Clear up the cache to force vc-call to check again and discover
+;; new functions when we reload this file.
+(put 'Hg 'vc-functions nil)
+
;;; Properties of the backend
(defvar vc-hg-history nil)
@@ -579,15 +592,14 @@ back to running Mercurial directly."
(defsubst vc-hg--read-u8 ()
"Read and advance over an unsigned byte.
-Return a fixnum."
+Return the byte's value as an integer."
(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."
+ "Read and advance over a big-endian unsigned 32-bit integer."
;; Because elisp bytecode has an instruction for multiply and
- ;; doesn't have one for lsh, it's somewhat counter-intuitively
+ ;; doesn't have one for shift, it's somewhat counter-intuitively
;; faster to multiply than to shift.
(+ (* (vc-hg--read-u8) (* 256 256 256))
(* (vc-hg--read-u8) (* 256 256))
@@ -623,9 +635,7 @@ Return a fixnum; on overflow, result is undefined."
;; 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
+ ;; 1+4*4 is the length of the dirstate item header.
(forward-char (1+ (* 3 4)))
(let ((this-flen (vc-hg--read-u32-be)))
(if (and (or (eq this-flen flen)
@@ -832,7 +842,7 @@ if we don't understand a construct, we signal
(with-temp-buffer
(let ((attr (file-attributes hgignore)))
(when attr (insert-file-contents hgignore))
- (push (list hgignore (nth 5 attr) (nth 7 attr))
+ (push (list hgignore (file-attribute-modification-time attr) (file-attribute-size attr))
vc-hg--hgignore-filenames))
(while (not (eobp))
;; This list of pattern-file commands isn't complete, but it
@@ -896,8 +906,8 @@ REPO must be the directory name of an hg repository."
(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)))
+ (current-mtime (file-attribute-modification-time attr))
+ (current-size (file-attribute-size attr)))
(unless (and (equal saved-mtime current-mtime)
(equal saved-size current-size))
(setf valid nil))))
@@ -913,9 +923,6 @@ FILENAME must be the file's true absolute name."
(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.")
@@ -967,8 +974,8 @@ 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))
+ (let* ((mtime (file-attribute-modification-time dirstate-attr))
+ (size (file-attribute-size dirstate-attr))
(cache vc-hg--dirstate-scan-cache)
)
(if (and cache
@@ -1011,9 +1018,7 @@ hg binary."
;; 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)
+ (< (file-attribute-size dirstate-attr) 40)
(progn
(setf repo-relative-filename
(file-relative-name truename repo))
@@ -1037,8 +1042,10 @@ hg binary."
((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))))
+ (fs-size (file-attribute-size stat))
+ (fs-mtime (encode-time
+ (file-attribute-modification-time stat)
+ 'integer)))
(if (and (eql vc-hg-size fs-size) (eql vc-hg-mtime fs-mtime))
'up-to-date
'edited)))
@@ -1142,11 +1149,9 @@ REV is the revision to check out into WORKFILE."
(defun vc-hg-find-file-hook ()
(when (and buffer-file-name
- (file-exists-p (concat buffer-file-name ".orig"))
;; Hg does not seem to have a "conflict" status, eg
;; hg http://bz.selenic.com/show_bug.cgi?id=2724
- (memq (vc-file-getprop buffer-file-name 'vc-state)
- '(edited conflict))
+ (memq (vc-state buffer-file-name) '(edited conflict))
;; Maybe go on to check that "hg resolve -l" says "U"?
;; If "hg resolve -l" says there's a conflict but there are no
;; conflict markers, it's not clear what we should do.
@@ -1163,7 +1168,11 @@ REV is the revision to check out into WORKFILE."
;; Modeled after the similar function in vc-bzr.el
(defun vc-hg-revert (file &optional contents-done)
(unless contents-done
- (with-temp-buffer (vc-hg-command t 0 file "revert"))))
+ (with-temp-buffer
+ (apply #'vc-hg-command
+ t 0 file
+ "revert"
+ (append (vc-switches 'hg 'revert))))))
;;; Hg specific functionality.
@@ -1194,9 +1203,9 @@ REV is the revision to check out into WORKFILE."
(insert (propertize
(format " (%s %s)"
(pcase (vc-hg-extra-fileinfo->rename-state extra)
- (`copied "copied from")
- (`renamed-from "renamed from")
- (`renamed-to "renamed to"))
+ ('copied "copied from")
+ ('renamed-from "renamed from")
+ ('renamed-to "renamed to"))
(vc-hg-extra-fileinfo->extra-name extra))
'face 'font-lock-comment-face)))))
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el
index c3ff41088ca..07b3d86b518 100644
--- a/lisp/vc/vc-hooks.el
+++ b/lisp/vc/vc-hooks.el
@@ -1,4 +1,4 @@
-;;; vc-hooks.el --- resident support for version-control
+;;; vc-hooks.el --- resident support for version-control -*- lexical-binding:t -*-
;; Copyright (C) 1992-1996, 1998-2019 Free Software Foundation, Inc.
@@ -173,9 +173,9 @@ Otherwise, not displayed."
(make-variable-buffer-local 'vc-mode)
(put 'vc-mode 'permanent-local t)
-;;; We signal this error when we try to do something a VC backend
-;;; doesn't support. Two arguments: the method that's not supported
-;;; and the backend
+;; We signal this error when we try to do something a VC backend
+;; doesn't support. Two arguments: the method that's not supported
+;; and the backend
(define-error 'vc-not-supported "VC method not implemented for backend")
(defun vc-mode (&optional _arg)
@@ -243,12 +243,12 @@ if that doesn't exist either, return nil."
"Call for BACKEND the implementation of FUNCTION-NAME with the given ARGS.
Calls
- (apply \\='vc-BACKEND-FUN ARGS)
+ (apply #\\='vc-BACKEND-FUN ARGS)
if vc-BACKEND-FUN exists (after trying to find it in vc-BACKEND.el)
and else calls
- (apply \\='vc-default-FUN BACKEND ARGS)
+ (apply #\\='vc-default-FUN BACKEND ARGS)
It is usually called via the `vc-call' macro."
(let ((f (assoc function-name (get backend 'vc-functions))))
@@ -603,7 +603,7 @@ a regexp for matching all such backup files, regardless of the version."
"Delete all existing automatic version backups for FILE."
(condition-case nil
(mapc
- 'delete-file
+ #'delete-file
(directory-files (or (file-name-directory file) default-directory) t
(vc-version-backup-file-name file nil nil t)))
;; Don't fail when the directory doesn't exist.
@@ -658,7 +658,7 @@ Before doing that, check if there are any old backups and get rid of them."
;; If the file was saved in the same second in which it was
;; checked out, clear the checkout-time to avoid confusion.
(if (equal (vc-file-getprop file 'vc-checkout-time)
- (nth 5 (file-attributes file)))
+ (file-attribute-modification-time (file-attributes file)))
(vc-file-setprop file 'vc-checkout-time nil))
(if (vc-state-refresh file backend)
(vc-mode-line file backend)))
@@ -692,24 +692,26 @@ visiting FILE.
If BACKEND is passed use it as the VC backend when computing the result."
(interactive (list buffer-file-name))
(setq backend (or backend (vc-backend file)))
- (if (not backend)
- (setq vc-mode nil)
+ (cond
+ ((not backend)
+ (setq vc-mode nil))
+ ((null vc-display-status)
+ (setq vc-mode (concat " " (symbol-name backend))))
+ (t
(let* ((ml-string (vc-call-backend backend 'mode-line-string file))
(ml-echo (get-text-property 0 'help-echo ml-string)))
(setq vc-mode
(concat
" "
- (if (null vc-display-status)
- (symbol-name backend)
- (propertize
- ml-string
- 'mouse-face 'mode-line-highlight
- 'help-echo
- (concat (or ml-echo
- (format "File under the %s version control system"
- backend))
- "\nmouse-1: Version Control menu")
- 'local-map vc-mode-line-map)))))
+ (propertize
+ ml-string
+ 'mouse-face 'mode-line-highlight
+ 'help-echo
+ (concat (or ml-echo
+ (format "File under the %s version control system"
+ backend))
+ "\nmouse-1: Version Control menu")
+ 'local-map vc-mode-line-map))))
;; If the user is root, and the file is not owner-writable,
;; then pretend that we can't write it
;; even though we can (because root can write anything).
@@ -718,7 +720,7 @@ If BACKEND is passed use it as the VC backend when computing the result."
(not buffer-read-only)
(zerop (user-real-uid))
(zerop (logand (file-modes buffer-file-name) 128))
- (setq buffer-read-only t)))
+ (setq buffer-read-only t))))
(force-mode-line-update)
backend)
@@ -809,7 +811,7 @@ In the latter case, VC mode is deactivated for this buffer."
(when buffer-file-name
(vc-file-clearprops buffer-file-name)
;; FIXME: Why use a hook? Why pass it buffer-file-name?
- (add-hook 'vc-mode-line-hook 'vc-mode-line nil t)
+ (add-hook 'vc-mode-line-hook #'vc-mode-line nil t)
(let (backend)
(cond
((setq backend (with-demoted-errors (vc-backend buffer-file-name)))
@@ -860,13 +862,13 @@ In the latter case, VC mode is deactivated for this buffer."
)))))))))
(add-hook 'find-file-hook #'vc-refresh-state)
-(define-obsolete-function-alias 'vc-find-file-hook 'vc-refresh-state "25.1")
+(define-obsolete-function-alias 'vc-find-file-hook #'vc-refresh-state "25.1")
(defun vc-kill-buffer-hook ()
"Discard VC info about a file when we kill its buffer."
(when buffer-file-name (vc-file-clearprops buffer-file-name)))
-(add-hook 'kill-buffer-hook 'vc-kill-buffer-hook)
+(add-hook 'kill-buffer-hook #'vc-kill-buffer-hook)
;; Now arrange for (autoloaded) bindings of the main package.
;; Bindings for this have to go in the global map, as we'll often
@@ -888,6 +890,8 @@ In the latter case, VC mode is deactivated for this buffer."
(define-key map "L" 'vc-print-root-log)
(define-key map "I" 'vc-log-incoming)
(define-key map "O" 'vc-log-outgoing)
+ (define-key map "ML" 'vc-log-mergebase)
+ (define-key map "MD" 'vc-diff-mergebase)
(define-key map "m" 'vc-merge)
(define-key map "r" 'vc-retrieve-tag)
(define-key map "s" 'vc-create-tag)
@@ -948,8 +952,7 @@ In the latter case, VC mode is deactivated for this buffer."
(bindings--define-key map [separator2] menu-bar-separator)
(bindings--define-key map [vc-insert-header]
'(menu-item "Insert Header" vc-insert-headers
- :help "Insert headers into a file for use with a version control system.
-"))
+ :help "Insert headers into a file for use with a version control system."))
(bindings--define-key map [vc-revert]
'(menu-item "Revert to Base Version" vc-revert
:help "Revert working copies of the selected file set to their repository contents"))
diff --git a/lisp/vc/vc-mtn.el b/lisp/vc/vc-mtn.el
index 748c2ae23ff..f0b12489c1b 100644
--- a/lisp/vc/vc-mtn.el
+++ b/lisp/vc/vc-mtn.el
@@ -190,8 +190,8 @@ switches."
(setq branch (replace-match (cdr rule) t nil branch))))
(format "Mtn%c%s"
(pcase (vc-state file)
- ((or `up-to-date `needs-update) ?-)
- (`added ?@)
+ ((or 'up-to-date 'needs-update) ?-)
+ ('added ?@)
(_ ?:))
branch))
"")))
diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el
index 11a8d396953..598e98250ac 100644
--- a/lisp/vc/vc-rcs.el
+++ b/lisp/vc/vc-rcs.el
@@ -684,13 +684,13 @@ Optional arg REVISION is a revision to annotate from."
(forward-line (1- (pop insn)))
(setq p (point))
(pcase (pop insn)
- (`k (setq s (buffer-substring-no-properties
+ ('k (setq s (buffer-substring-no-properties
p (progn (forward-line (car insn))
(point))))
(when prda
(push `(,p . ,(propertize s :vc-rcs-r/d/a prda)) path))
(delete-region p (point)))
- (`i (setq s (car insn))
+ ('i (setq s (car insn))
(when prda
(push `(,p . ,(length s)) path))
(insert s)))))
@@ -716,10 +716,10 @@ Optional arg REVISION is a revision to annotate from."
(goto-char (point-min))
(forward-line (1- (pop insn)))
(pcase (pop insn)
- (`k (delete-region
+ ('k (delete-region
(point) (progn (forward-line (car insn))
(point))))
- (`i (insert (propertize
+ ('i (insert (propertize
(car insn)
:vc-rcs-r/d/a
(or prda (setq prda (r/d/a))))))))
@@ -955,11 +955,10 @@ Uses `rcs2log' which only works for RCS and CVS."
"Return non-nil if FILE is newer than its RCS master.
This likely means that FILE has been changed with respect
to its master version."
- (let ((file-time (nth 5 (file-attributes file)))
- (master-time (nth 5 (file-attributes (vc-master-name file)))))
- (or (> (nth 0 file-time) (nth 0 master-time))
- (and (= (nth 0 file-time) (nth 0 master-time))
- (> (nth 1 file-time) (nth 1 master-time))))))
+ (let ((file-time (file-attribute-modification-time (file-attributes file)))
+ (master-time (file-attribute-modification-time
+ (file-attributes (vc-master-name file)))))
+ (time-less-p master-time file-time)))
(defun vc-rcs-find-most-recent-rev (branch)
"Find most recent revision on BRANCH."
diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el
index e10cdd21698..3c50c8fff64 100644
--- a/lisp/vc/vc-svn.el
+++ b/lisp/vc/vc-svn.el
@@ -479,7 +479,8 @@ The changes are between FIRST-VERSION and SECOND-VERSION."
((string= (match-string 2) "U")
(vc-file-setprop file 'vc-state 'up-to-date)
(vc-file-setprop file 'vc-checkout-time
- (nth 5 (file-attributes file)))
+ (file-attribute-modification-time
+ (file-attributes file)))
0);; indicate success to the caller
;; Merge successful, but our own changes are still in the file
((string= (match-string 2) "G")
@@ -729,7 +730,8 @@ Set file properties accordingly. If FILENAME is non-nil, return its status."
(if (eq (char-after (match-beginning 1)) ?*)
'needs-update
(vc-file-setprop file 'vc-checkout-time
- (nth 5 (file-attributes file)))
+ (file-attribute-modification-time
+ (file-attributes file)))
'up-to-date))
((eq status ?A)
;; If the file was actually copied, (match-string 2) is "-".
@@ -757,7 +759,7 @@ Set file properties accordingly. If FILENAME is non-nil, return its status."
;; an uppercase or lowercase letter and can contain uppercase and
;; lowercase letters, digits, `-', and `_'.
(and (string-match "^[a-zA-Z]" tag)
- (not (string-match "[^a-z0-9A-Z-_]" tag))))
+ (not (string-match "[^a-z0-9A-Z_-]" tag))))
(defun vc-svn-valid-revision-number-p (tag)
"Return non-nil if TAG is a valid revision number."
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 353299cbed9..b992a8ebe09 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -429,6 +429,10 @@
;; - region-history-mode ()
;;
;; Major mode to use for the output of `region-history'.
+;;
+;; - mergebase (rev1 &optional rev2)
+;;
+;; Return the common ancestor between REV1 and REV2 revisions.
;; TAG SYSTEM
;;
@@ -729,13 +733,6 @@
"Emacs interface to version control systems."
:group 'tools)
-(defcustom vc-initial-comment nil
- "If non-nil, prompt for initial comment when a file is registered."
- :type 'boolean
- :group 'vc)
-
-(make-obsolete-variable 'vc-initial-comment "it has no effect." "23.2")
-
(defcustom vc-checkin-switches nil
"A string or list of strings specifying extra switches for checkin.
These are passed to the checkin program by \\[vc-checkin]."
@@ -743,8 +740,7 @@ These are passed to the checkin program by \\[vc-checkin]."
(string :tag "Argument String")
(repeat :tag "Argument List"
:value ("")
- string))
- :group 'vc)
+ string)))
(defcustom vc-checkout-switches nil
"A string or list of strings specifying extra switches for checkout.
@@ -753,8 +749,7 @@ These are passed to the checkout program by \\[vc-checkout]."
(string :tag "Argument String")
(repeat :tag "Argument List"
:value ("")
- string))
- :group 'vc)
+ string)))
(defcustom vc-register-switches nil
"A string or list of strings; extra switches for registering a file.
@@ -763,8 +758,7 @@ These are passed to the checkin program by \\[vc-register]."
(string :tag "Argument String")
(repeat :tag "Argument List"
:value ("")
- string))
- :group 'vc)
+ string)))
(defcustom vc-diff-switches nil
"A string or list of strings specifying switches for diff under VC.
@@ -779,7 +773,6 @@ not specific to any particular backend."
(const :tag "None" t)
(string :tag "Argument String")
(repeat :tag "Argument List" :value ("") string))
- :group 'vc
:version "21.1")
(defcustom vc-annotate-switches nil
@@ -799,15 +792,13 @@ for the backend you use."
(const :tag "None" t)
(string :tag "Argument String")
(repeat :tag "Argument List" :value ("") string))
- :group 'vc
:version "25.1")
(defcustom vc-log-show-limit 2000
"Limit the number of items shown by the VC log commands.
Zero means unlimited.
Not all VC backends are able to support this feature."
- :type 'integer
- :group 'vc)
+ :type 'integer)
(defcustom vc-allow-async-revert nil
"Specifies whether the diff during \\[vc-revert] may be asynchronous.
@@ -815,7 +806,6 @@ Enabling this option means that you can confirm a revert operation even
if the local changes in the file have not been found and displayed yet."
:type '(choice (const :tag "No" nil)
(const :tag "Yes" t))
- :group 'vc
:version "22.1")
;;;###autoload
@@ -823,7 +813,6 @@ if the local changes in the file have not been found and displayed yet."
"Normal hook (list of functions) run after checking out a file.
See `run-hooks'."
:type 'hook
- :group 'vc
:version "21.1")
;;;###autoload
@@ -831,20 +820,22 @@ See `run-hooks'."
"Normal hook (list of functions) run after commit or file checkin.
See also `log-edit-done-hook'."
:type 'hook
- :options '(log-edit-comment-to-change-log)
- :group 'vc)
+ :options '(log-edit-comment-to-change-log))
;;;###autoload
(defcustom vc-before-checkin-hook nil
"Normal hook (list of functions) run before a commit or a file checkin.
See `run-hooks'."
+ :type 'hook)
+
+(defcustom vc-retrieve-tag-hook nil
+ "Normal hook (list of functions) run after retrieving a tag."
:type 'hook
- :group 'vc)
+ :version "27.1")
(defcustom vc-revert-show-diff t
"If non-nil, `vc-revert' shows a `vc-diff' buffer before querying."
:type 'boolean
- :group 'vc
:version "24.1")
;; Header-insertion hair
@@ -857,8 +848,7 @@ A %s in the template is replaced with the first string associated with
the file's version control type in `vc-BACKEND-header'."
:type '(repeat (cons :format "%v"
(regexp :tag "File Type")
- (string :tag "Header String")))
- :group 'vc)
+ (string :tag "Header String"))))
(defcustom vc-comment-alist
'((nroff-mode ".\\\"" ""))
@@ -869,8 +859,12 @@ is sensitive to blank lines."
:type '(repeat (list :format "%v"
(symbol :tag "Mode")
(string :tag "Comment Start")
- (string :tag "Comment End")))
- :group 'vc)
+ (string :tag "Comment End"))))
+
+(defcustom vc-find-revision-no-save nil
+ "If non-nil, `vc-find-revision' doesn't write the created buffer to file."
+ :type 'boolean
+ :version "27.1")
;; File property caching
@@ -935,7 +929,7 @@ use."
;; 'create-repo method.
(completing-read
(format "%s is not in a version controlled directory.\nUse VC backend: " file)
- (mapcar 'symbol-name possible-backends) nil t)))
+ (mapcar #'symbol-name possible-backends) nil t)))
(repo-dir
(let ((def-dir (file-name-directory file)))
;; read the directory where to create the
@@ -988,6 +982,7 @@ Within directories, only files already under version control are noticed."
(defvar log-view-vc-backend)
(defvar log-edit-vc-backend)
(defvar diff-vc-backend)
+(defvar diff-vc-revisions)
(defun vc-deduce-backend ()
(cond ((derived-mode-p 'vc-dir-mode) vc-dir-backend)
@@ -1062,27 +1057,27 @@ BEWARE: this function may change the current buffer."
(t (error "File is not under version control")))))
(defun vc-dired-deduce-fileset ()
- (let ((backend (vc-responsible-backend default-directory)))
- (unless backend (error "Directory not under VC"))
- (list backend
- (dired-map-over-marks (dired-get-filename nil t) nil))))
+ (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
((derived-mode-p 'vc-dir-mode)
(set-buffer (find-file-noselect (vc-dir-current-file))))
+ ((derived-mode-p 'dired-mode)
+ (set-buffer (find-file-noselect (dired-get-filename))))
(t
(while (and vc-parent-buffer
(buffer-live-p vc-parent-buffer)
;; Avoid infinite looping when vc-parent-buffer and
;; current buffer are the same buffer.
(not (eq vc-parent-buffer (current-buffer))))
- (set-buffer vc-parent-buffer))
- (if (not buffer-file-name)
- (error "Buffer %s is not associated with a file" (buffer-name))
- (unless (vc-backend buffer-file-name)
- (error "File %s is not under version control" buffer-file-name))))))
+ (set-buffer vc-parent-buffer))))
+ (if (not buffer-file-name)
+ (error "Buffer %s is not associated with a file" (buffer-name))
+ (unless (vc-backend buffer-file-name)
+ (error "File %s is not under version control" buffer-file-name))))
;;; Support for the C-x v v command.
;; This is where all the single-file-oriented code from before the fileset
@@ -1103,7 +1098,7 @@ BEWARE: this function may change the current buffer."
(defun vc-read-backend (prompt)
(intern
- (completing-read prompt (mapcar 'symbol-name vc-handled-backends)
+ (completing-read prompt (mapcar #'symbol-name vc-handled-backends)
nil 'require-match)))
;; Here's the major entry point.
@@ -1361,7 +1356,7 @@ first backend that could register the file is used."
(set-buffer-modified-p t))
(vc-buffer-sync)))))
(message "Registering %s... " files)
- (mapc 'vc-file-clearprops files)
+ (mapc #'vc-file-clearprops files)
(vc-call-backend backend 'register files comment)
(mapc
(lambda (file)
@@ -1488,7 +1483,8 @@ After check-out, runs the normal hook `vc-checkout-hook'."
nil)
'up-to-date
'edited))
- (vc-checkout-time . ,(nth 5 (file-attributes file))))))
+ (vc-checkout-time . ,(file-attribute-modification-time
+ (file-attributes file))))))
(vc-resynch-buffer file t t)
(run-hooks 'vc-checkout-hook))
@@ -1542,8 +1538,7 @@ The optional argument REV may be a string specifying the new revision
level (only supported for some older VCSes, like RCS and CVS).
Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'."
- (when vc-before-checkin-hook
- (run-hooks 'vc-before-checkin-hook))
+ (run-hooks 'vc-before-checkin-hook)
(vc-start-logentry
files comment initial-contents
"Enter a change comment."
@@ -1563,9 +1558,10 @@ Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'."
;; not a well-defined concept for filesets.
(progn
(vc-call-backend backend 'checkin files comment rev)
- (mapc 'vc-delete-automatic-version-backups files))
+ (mapc #'vc-delete-automatic-version-backups files))
`((vc-state . up-to-date)
- (vc-checkout-time . ,(nth 5 (file-attributes file)))
+ (vc-checkout-time . ,(file-attribute-modification-time
+ (file-attributes file)))
(vc-working-revision . nil)))
(message "Checking in %s...done" (vc-delistify files)))
'vc-checkin-hook
@@ -1649,11 +1645,6 @@ to override the value of `vc-diff-switches' and `diff-switches'."
;; any switches in diff-switches.
(when (listp switches) switches))))
-;; Old def for compatibility with Emacs-21.[123].
-(defmacro vc-diff-switches-list (backend)
- (declare (obsolete vc-switches "22.1"))
- `(vc-switches ',backend 'diff))
-
(defun vc-diff-finish (buffer messages)
;; The empty sync output case has already been handled, so the only
;; possibility of an empty output is for an async process.
@@ -1725,7 +1716,7 @@ Return t if the buffer had changes, nil otherwise."
(error "No revisions of %s exist" file)
;; We regard this as "changed".
;; Diff it against /dev/null.
- (apply 'vc-do-command buffer
+ (apply #'vc-do-command buffer
(if async 'async 1) "diff" file
(append (vc-switches nil 'diff) '("/dev/null"))))))
(setq files (nreverse filtered))))
@@ -1733,6 +1724,7 @@ Return t if the buffer had changes, nil otherwise."
(set-buffer buffer)
(diff-mode)
(set (make-local-variable 'diff-vc-backend) (car vc-fileset))
+ (set (make-local-variable 'diff-vc-revisions) (list rev1 rev2))
(set (make-local-variable 'revert-buffer-function)
(lambda (_ignore-auto _noconfirm)
(vc-diff-internal async vc-fileset rev1 rev2 verbose)))
@@ -1774,9 +1766,9 @@ Return t if the buffer had changes, nil otherwise."
nil nil initial-input 'vc-revision-history default)
(read-string prompt initial-input nil default))))
-(defun vc-diff-build-argument-list-internal ()
+(defun vc-diff-build-argument-list-internal (&optional fileset)
"Build argument list for calling internal diff functions."
- (let* ((vc-fileset (vc-deduce-fileset t)) ;FIXME: why t? --Stef
+ (let* ((vc-fileset (or fileset (vc-deduce-fileset t))) ;FIXME: why t? --Stef
(files (cadr vc-fileset))
(backend (car vc-fileset))
(first (car files))
@@ -1830,6 +1822,32 @@ state of each file in the fileset."
(called-interactively-p 'interactive)))
;;;###autoload
+(defun vc-root-version-diff (_files rev1 rev2)
+ "Report diffs between REV1 and REV2 revisions of the whole tree."
+ (interactive
+ (vc-diff-build-argument-list-internal
+ (or (ignore-errors (vc-deduce-fileset t))
+ (let ((backend (or (vc-deduce-backend) (vc-responsible-backend default-directory))))
+ (list backend (list (vc-call-backend backend 'root default-directory)))))))
+ ;; This is a mix of `vc-root-diff' and `vc-version-diff'
+ (when (and (not rev1) rev2)
+ (error "Not a valid revision range"))
+ (let ((backend (vc-deduce-backend))
+ (default-directory default-directory)
+ rootdir)
+ (if backend
+ (setq rootdir (vc-call-backend backend 'root default-directory))
+ (setq rootdir (read-directory-name "Directory for VC root-diff: "))
+ (setq backend (vc-responsible-backend rootdir))
+ (if backend
+ (setq default-directory rootdir)
+ (error "Directory is not version controlled")))
+ (let ((default-directory rootdir))
+ (vc-diff-internal
+ t (list backend (list rootdir)) rev1 rev2
+ (called-interactively-p 'interactive)))))
+
+;;;###autoload
(defun vc-diff (&optional historic not-urgent)
"Display diffs between file revisions.
Normally this compares the currently selected fileset with their
@@ -1845,6 +1863,33 @@ saving the buffer."
(vc-diff-internal t (vc-deduce-fileset t) nil nil
(called-interactively-p 'interactive))))
+;;;###autoload
+(defun vc-diff-mergebase (_files rev1 rev2)
+ "Report diffs between the merge base of REV1 and REV2 revisions.
+The merge base is a common ancestor between REV1 and REV2 revisions."
+ (interactive
+ (vc-diff-build-argument-list-internal
+ (or (ignore-errors (vc-deduce-fileset t))
+ (let ((backend (or (vc-deduce-backend) (vc-responsible-backend default-directory))))
+ (list backend (list (vc-call-backend backend 'root default-directory)))))))
+ (when (and (not rev1) rev2)
+ (error "Not a valid revision range"))
+ (let ((backend (vc-deduce-backend))
+ (default-directory default-directory)
+ rootdir)
+ (if backend
+ (setq rootdir (vc-call-backend backend 'root default-directory))
+ (setq rootdir (read-directory-name "Directory for VC root-diff: "))
+ (setq backend (vc-responsible-backend rootdir))
+ (if backend
+ (setq default-directory rootdir)
+ (error "Directory is not version controlled")))
+ (let ((default-directory rootdir)
+ (rev1 (vc-call-backend backend 'mergebase rev1 rev2)))
+ (vc-diff-internal
+ t (list backend (list rootdir)) rev1 rev2
+ (called-interactively-p 'interactive)))))
+
(declare-function ediff-load-version-control "ediff" (&optional silent))
(declare-function ediff-vc-internal "ediff-vers"
(rev1 rev2 &optional startup-hooks))
@@ -1908,10 +1953,8 @@ The optional argument NOT-URGENT non-nil means it is ok to say no to
saving the buffer."
(interactive (list current-prefix-arg t))
(if historic
- ;; FIXME: this does not work right, `vc-version-diff' ends up
- ;; calling `vc-deduce-fileset' to find the files to diff, and
- ;; that's not what we want here, we want the diff for the VC root dir.
- (call-interactively 'vc-version-diff)
+ ;; We want the diff for the VC root dir.
+ (call-interactively 'vc-root-version-diff)
(when buffer-file-name (vc-buffer-sync not-urgent))
(let ((backend (vc-deduce-backend))
(default-directory default-directory)
@@ -1967,6 +2010,13 @@ If `F.~REV~' already exists, use it instead of checking it out again."
(defun vc-find-revision (file revision &optional backend)
"Read REVISION of FILE into a buffer and return the buffer.
Use BACKEND as the VC backend if specified."
+ (if vc-find-revision-no-save
+ (vc-find-revision-no-save file revision backend)
+ (vc-find-revision-save file revision backend)))
+
+(defun vc-find-revision-save (file revision &optional backend)
+ "Read REVISION of FILE into a buffer and return the buffer.
+Saves the buffer to the file."
(let ((automatic-backup (vc-version-backup-file-name file revision))
(filebuf (or (get-file-buffer file) (current-buffer)))
(filename (vc-version-backup-file-name file revision 'manual)))
@@ -2002,6 +2052,51 @@ Use BACKEND as the VC backend if specified."
(set (make-local-variable 'vc-parent-buffer) filebuf))
result-buf)))
+(defun vc-find-revision-no-save (file revision &optional backend buffer)
+ "Read REVISION of FILE into BUFFER and return the buffer.
+If BUFFER omitted or nil, this function creates a new buffer and sets
+`buffer-file-name' to the name constructed from the file name and the
+revision number.
+Unlike `vc-find-revision-save', doesn't save the buffer to the file."
+ (let* ((buffer (when (buffer-live-p buffer) buffer))
+ (filebuf (or buffer (get-file-buffer file) (current-buffer)))
+ (filename (unless buffer (vc-version-backup-file-name file revision 'manual))))
+ (unless (and (not buffer)
+ (or (get-file-buffer filename)
+ (file-exists-p filename)))
+ (with-current-buffer filebuf
+ (let ((failed t))
+ (unwind-protect
+ (with-current-buffer (or buffer (create-file-buffer filename))
+ (unless buffer (setq buffer-file-name filename))
+ (let ((outbuf (current-buffer)))
+ (with-current-buffer filebuf
+ (if backend
+ (vc-call-backend backend 'find-revision file revision outbuf)
+ (vc-call find-revision file revision outbuf))))
+ (decode-coding-inserted-region (point-min) (point-max) file)
+ (after-insert-file-set-coding (- (point-max) (point-min)))
+ (goto-char (point-min))
+ (if buffer
+ ;; For non-interactive, skip any questions
+ (let ((enable-local-variables :safe) ;; to find `mode:'
+ (buffer-file-name file))
+ (ignore-errors (set-auto-mode)))
+ (normal-mode))
+ (set-buffer-modified-p nil)
+ (setq buffer-read-only t))
+ (setq failed nil)
+ (when (and failed (unless buffer (get-file-buffer filename)))
+ (with-current-buffer (get-file-buffer filename)
+ (set-buffer-modified-p nil))
+ (kill-buffer (get-file-buffer filename)))))))
+ (let ((result-buf (or buffer
+ (get-file-buffer filename)
+ (find-file-noselect filename))))
+ (with-current-buffer result-buf
+ (set (make-local-variable 'vc-parent-buffer) filebuf))
+ result-buf)))
+
;; Header-insertion code
;;;###autoload
@@ -2108,6 +2203,7 @@ changes from the current branch."
;; `default-next-file' variable for its default file (M-n), and
;; we could then set it upon mark-resolve, so C-x C-s C-x C-f M-n would
;; automatically offer the next conflicted file.
+;;;###autoload
(defun vc-find-conflicted-file ()
"Visit the next conflicted file in the current project."
(interactive)
@@ -2178,7 +2274,8 @@ otherwise use the repository root of the current buffer.
If NAME is empty, it refers to the latest revisions of the current branch.
If locking is used for the files in DIR, then there must not be any
locked files at or below DIR (but if NAME is empty, locked files are
-allowed and simply skipped)."
+allowed and simply skipped).
+This function runs the hook `vc-retrieve-tag-hook' when finished."
(interactive
(let* ((granularity
(vc-call-backend (vc-responsible-backend default-directory)
@@ -2205,6 +2302,7 @@ allowed and simply skipped)."
(vc-call-backend (vc-responsible-backend dir)
'retrieve-tag dir name update)
(vc-resynch-buffer dir t t t)
+ (run-hooks 'vc-retrieve-tag-hook)
(message "%s" (concat msg "done"))))
@@ -2294,11 +2392,11 @@ earlier revisions. Show up to LIMIT entries (non-nil means unlimited)."
setup-buttons-func
goto-location-func
rev-buff-func)
- (let (retval)
- (with-current-buffer (get-buffer-create buffer-name)
+ (let (retval (buffer (get-buffer-create buffer-name)))
+ (with-current-buffer buffer
(set (make-local-variable 'vc-log-view-type) type))
(setq retval (funcall backend-func backend buffer-name type files))
- (with-current-buffer (get-buffer buffer-name)
+ (with-current-buffer buffer
(let ((inhibit-read-only t))
;; log-view-mode used to be called with inhibit-read-only bound
;; to t, so let's keep doing it, just in case.
@@ -2309,7 +2407,7 @@ earlier revisions. Show up to LIMIT entries (non-nil means unlimited)."
rev-buff-func)))
;; Display after setting up major-mode, so display-buffer-alist can know
;; the major-mode.
- (pop-to-buffer buffer-name)
+ (pop-to-buffer buffer)
(vc-run-delayed
(let ((inhibit-read-only t))
(funcall setup-buttons-func backend files retval)
@@ -2429,17 +2527,41 @@ When called interactively with a prefix argument, prompt for REMOTE-LOCATION."
"*vc-outgoing*" 'log-outgoing)))
;;;###autoload
+(defun vc-log-mergebase (_files rev1 rev2)
+ "Show a log of changes between the merge base of REV1 and REV2 revisions.
+The merge base is a common ancestor between REV1 and REV2 revisions."
+ (interactive
+ (vc-diff-build-argument-list-internal
+ (or (ignore-errors (vc-deduce-fileset t))
+ (let ((backend (or (vc-deduce-backend) (vc-responsible-backend default-directory))))
+ (list backend (list (vc-call-backend backend 'root default-directory)))))))
+ (let ((backend (vc-deduce-backend))
+ (default-directory default-directory)
+ rootdir)
+ (if backend
+ (setq rootdir (vc-call-backend backend 'root default-directory))
+ (setq rootdir (read-directory-name "Directory for VC root-log: "))
+ (setq backend (vc-responsible-backend rootdir))
+ (unless backend
+ (error "Directory is not version controlled")))
+ (setq default-directory rootdir)
+ (setq rev1 (vc-call-backend backend 'mergebase rev1 rev2))
+ (vc-print-log-internal backend (list rootdir) rev1 t (or rev2 ""))))
+
+;;;###autoload
(defun vc-region-history (from to)
"Show the history of the region between FROM and TO.
If called interactively, show the history between point and
mark."
(interactive "r")
- (let* ((lfrom (line-number-at-pos from))
- (lto (line-number-at-pos (1- to)))
+ (let* ((lfrom (line-number-at-pos from t))
+ (lto (line-number-at-pos (1- to) t))
(file buffer-file-name)
(backend (vc-backend file))
(buf (get-buffer-create "*VC-history*")))
+ (unless backend
+ (error "Buffer is not version controlled"))
(with-current-buffer buf
(setq-local vc-log-view-type 'long))
(vc-call region-history file buf lfrom lto)
@@ -2592,7 +2714,8 @@ its name; otherwise return nil."
(vc-delete-automatic-version-backups file))
(vc-call revert file backup-file))
`((vc-state . up-to-date)
- (vc-checkout-time . ,(nth 5 (file-attributes file)))))
+ (vc-checkout-time . ,(file-attribute-modification-time
+ (file-attributes file)))))
(vc-resynch-buffer file t t))
;;;###autoload
@@ -2703,7 +2826,8 @@ If called interactively, read FILE, defaulting to the current
buffer's file name if it's under version control."
(interactive (list (read-file-name "VC delete file: " nil
(when (vc-backend buffer-file-name)
- buffer-file-name) t)))
+ buffer-file-name)
+ t)))
(setq file (expand-file-name file))
(let ((buf (get-file-buffer file))
(backend (vc-backend file)))
View Lorry Controller Status