summaryrefslogtreecommitdiff
path: root/lisp/vc
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/vc')
-rw-r--r--lisp/vc/add-log.el108
-rw-r--r--lisp/vc/cvs-status.el30
-rw-r--r--lisp/vc/diff-mode.el457
-rw-r--r--lisp/vc/diff.el5
-rw-r--r--lisp/vc/ediff-init.el22
-rw-r--r--lisp/vc/ediff-merg.el2
-rw-r--r--lisp/vc/ediff-ptch.el10
-rw-r--r--lisp/vc/ediff-util.el39
-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.el20
-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.el19
-rw-r--r--lisp/vc/vc-bzr.el24
-rw-r--r--lisp/vc/vc-cvs.el15
-rw-r--r--lisp/vc/vc-dir.el8
-rw-r--r--lisp/vc/vc-dispatcher.el30
-rw-r--r--lisp/vc/vc-git.el117
-rw-r--r--lisp/vc/vc-hg.el50
-rw-r--r--lisp/vc/vc-hooks.el32
-rw-r--r--lisp/vc/vc-mtn.el4
-rw-r--r--lisp/vc/vc-rcs.el17
-rw-r--r--lisp/vc/vc-svn.el6
-rw-r--r--lisp/vc/vc.el121
28 files changed, 1147 insertions, 891 deletions
diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el
index cbfd10affd1..d6e85408608 100644
--- a/lisp/vc/add-log.el
+++ b/lisp/vc/add-log.el
@@ -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 13b876273f2..b65b91c5178 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 7db5ca9b259..4adef029847 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -55,6 +55,8 @@
;;; Code:
(eval-when-compile (require 'cl-lib))
+(autoload 'vc-find-revision "vc")
+(defvar vc-find-revision-no-save)
(defvar add-log-buffer-file-name-function)
@@ -66,14 +68,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 +82,33 @@ 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-font-lock-refine t
+ "If non-nil, font-lock highlighting includes hunk refinement."
+ :version "27.1"
+ :type 'boolean)
+
+(defcustom diff-font-lock-prettify nil
+ "If non-nil, font-lock will try and make the format prettier."
+ :version "27.1"
+ :type 'boolean)
(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 diff-outline-regexp
"\\([*+][*+][*+] [^0-9]\\|@@ ...\\|\\*\\*\\* [0-9].\\|--- [0-9]..\\)")
@@ -207,8 +217,7 @@ 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))
@@ -216,9 +225,6 @@ when editing big diffs)."
(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.
Diff Auto Refine mode is a buffer-local minor mode used with
`diff-mode'. When enabled, Emacs automatically highlights
@@ -241,8 +247,7 @@ well."
(((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))
@@ -252,18 +257,15 @@ well."
(((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
@@ -274,8 +276,7 @@ well."
: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
@@ -286,40 +287,34 @@ well."
: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))
"`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))
"`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))
"`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))
@@ -327,13 +322,11 @@ well."
(((class color grayscale) (min-colors 88) (background dark))
:foreground "#dddddd"))
"`diff-mode' face used to highlight context and other side-information."
- :version "25.1"
- :group 'diff-mode)
+ :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)
@@ -412,7 +405,9 @@ and the face `diff-added' for added lines.")
("^\\(#\\)\\(.*\\)"
(1 font-lock-comment-delimiter-face)
(2 font-lock-comment-face))
- ("^[^-=+*!<>#].*\n" (0 'diff-context))))
+ ("^[^-=+*!<>#].*\n" (0 'diff-context))
+ (,#'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 +476,13 @@ 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 "^[^-+#! \\]")
+ ('normal "^[^<>#\\]")
(_ "^[^-+#!<> \\]"))
nil t)
(match-beginning 0)))
@@ -891,7 +886,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))
@@ -1351,6 +1346,13 @@ 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)
+ (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 +1370,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 +1387,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 +1400,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 +1415,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)))
+ (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 +1462,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."
@@ -1693,7 +1692,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 +1741,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 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 +1875,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,8 +1981,7 @@ 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
@@ -1979,7 +1991,6 @@ For use in `add-log-current-defun-function'."
(((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
@@ -1990,7 +2001,6 @@ For use in `add-log-current-defun-function'."
(((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 +2027,100 @@ 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)
-
- (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)))))))))
+ (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 "^---")))
+ (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--font-lock-refined (max)
+ "Apply hunk refinement from font-lock."
+ (when diff-font-lock-refine
+ (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)))
+ (let* ((min (point))
+ (beg (or (ignore-errors (diff-beginning-of-hunk))
+ (ignore-errors (diff-hunk-next) (point))
+ max)))
+ (while (< beg max)
+ (let ((end
+ (save-excursion (goto-char beg) (diff-end-of-hunk) (point))))
+ (if (< end min) (setq beg min))
+ (unless (or (< end beg)
+ (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--font-lock-refine--refresh))))
+ (goto-char (max beg end))
+ (setq beg (or (ignore-errors (diff-hunk-next) (point)) max)))))))
+
+(defun diff--font-lock-refine--refresh (ol _after _beg _end &optional _len)
+ (delete-overlay ol))
(defun diff-undo (&optional arg)
"Perform `undo', ignoring the buffer's read-only status."
@@ -2175,6 +2226,166 @@ 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-added))
+ (?- . (left-fringe diff-fringe-del diff-removed))
+ (?! . (left-fringe diff-fringe-rep diff-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)
+
+(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 b850350cd8a..ac94586cace 100644
--- a/lisp/vc/diff.el
+++ b/lisp/vc/diff.el
@@ -226,8 +226,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 e5e2a042305..ee36a82033f 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 ad72d7570c5..b67f520ca07 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 b3cf2fee97b..03f54219130 100644
--- a/lisp/vc/ediff-ptch.el
+++ b/lisp/vc/ediff-ptch.el
@@ -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 8670ba4603f..b1652e7efd4 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)
@@ -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 079e195291d..0535aa67253 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 da7b0f12919..f424fdb7086 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 438ef117da6..d407aab11df 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
;;;
@@ -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 6ff50dcde5f..e3ae8fa0ba5 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 7e727670554..7609f987f68 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 8db2fe5e836..dbd25d93a1e 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 5515e0cd608..9933e3682ed 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 ea99d31e898..fd655e435fa 100644
--- a/lisp/vc/smerge-mode.el
+++ b/lisp/vc/smerge-mode.el
@@ -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
@@ -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)
diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index 630932fe371..d5ed5908b9c 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)
@@ -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 54ece6cc264..ac98d996d2c 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 ")
@@ -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)
@@ -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)
@@ -1174,7 +1177,7 @@ 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))
diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el
index 0cd05b943ec..18da6e33578 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 b0d2221b255..da9d34644cd 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 ad806b38545..f3174005307 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -102,8 +102,7 @@
(eval-when-compile
(require 'cl-lib)
(require 'vc)
- (require 'vc-dir)
- (require 'grep))
+ (require 'vc-dir))
(defgroup vc-git nil
"VC Git backend."
@@ -180,9 +179,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)
@@ -278,7 +289,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 +375,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 +486,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 +496,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 +507,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 +516,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 +577,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
@@ -863,6 +874,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.
@@ -1176,7 +1189,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 +1386,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 +1413,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 +1440,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 +1450,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 +1475,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,16 +1514,22 @@ 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)
@@ -1555,7 +1598,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))
@@ -1582,8 +1632,15 @@ 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 "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 08b1be8f6d3..d6227d67820 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
@@ -175,6 +175,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 +583,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 +626,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 +833,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 +897,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,7 +914,7 @@ FILENAME must be the file's true absolute name."
(setf ignored (string-match (pop patterns) filename)))
ignored))
-(defun vc-hg--time-to-fixnum (ts)
+(defun vc-hg--time-to-integer (ts)
(+ (* 65536 (car ts)) (cadr ts)))
(defvar vc-hg--cached-ignore-patterns nil
@@ -967,8 +968,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 +1012,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 +1036,9 @@ 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 (vc-hg--time-to-integer
+ (file-attribute-modification-time stat))))
(if (and (eql vc-hg-size fs-size) (eql vc-hg-mtime fs-mtime))
'up-to-date
'edited)))
@@ -1142,11 +1142,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.
@@ -1194,9 +1192,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 55c0132bf2b..84e11f2e01d 100644
--- a/lisp/vc/vc-hooks.el
+++ b/lisp/vc/vc-hooks.el
@@ -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)
diff --git a/lisp/vc/vc-mtn.el b/lisp/vc/vc-mtn.el
index 94cf7691e3e..efb141b9970 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 9fa52bf5dce..7970fce637e 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 2cbf34ba43a..4b1a34bd5f8 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 "-".
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 41a76e0007e..dbbc3e20380 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -729,13 +729,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]."
@@ -841,6 +834,12 @@ See `run-hooks'."
:type 'hook
:group 'vc)
+(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
@@ -872,6 +871,12 @@ is sensitive to blank lines."
(string :tag "Comment End")))
:group 'vc)
+(defcustom vc-find-revision-no-save nil
+ "If non-nil, `vc-find-revision' doesn't write the created buffer to file."
+ :type 'boolean
+ :group 'vc
+ :version "27.1")
+
;; File property caching
@@ -988,6 +993,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 +1068,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
@@ -1488,7 +1494,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 +1549,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."
@@ -1565,7 +1571,8 @@ Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'."
(vc-call-backend backend 'checkin files comment rev)
(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 +1656,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.
@@ -1733,6 +1735,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)))
@@ -1956,6 +1959,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)))
@@ -1988,6 +1998,46 @@ 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
+ (let ((coding-system-for-read 'no-conversion)
+ (coding-system-for-write 'no-conversion))
+ (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))))
+ (goto-char (point-min))
+ (if buffer (let ((buffer-file-name file)) (normal-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
@@ -2164,7 +2214,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)
@@ -2191,6 +2242,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"))))
@@ -2280,11 +2332,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.
@@ -2295,7 +2347,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)
@@ -2421,11 +2473,13 @@ When called interactively with a prefix argument, prompt for REMOTE-LOCATION."
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)
@@ -2578,7 +2632,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
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-23 16:40:39 +0000