summaryrefslogtreecommitdiff
path: root/lisp/vc
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/vc')
-rw-r--r--lisp/vc/add-log.el20
-rw-r--r--lisp/vc/cvs-status.el26
-rw-r--r--lisp/vc/diff-mode.el287
-rw-r--r--lisp/vc/diff.el8
-rw-r--r--lisp/vc/ediff-diff.el5
-rw-r--r--lisp/vc/ediff-help.el4
-rw-r--r--lisp/vc/ediff-init.el4
-rw-r--r--lisp/vc/ediff-ptch.el29
-rw-r--r--lisp/vc/ediff-util.el6
-rw-r--r--lisp/vc/ediff.el4
-rw-r--r--lisp/vc/log-edit.el28
-rw-r--r--lisp/vc/log-view.el51
-rw-r--r--lisp/vc/pcvs-defs.el154
-rw-r--r--lisp/vc/pcvs-info.el8
-rw-r--r--lisp/vc/pcvs.el147
-rw-r--r--lisp/vc/smerge-mode.el52
-rw-r--r--lisp/vc/vc-annotate.el2
-rw-r--r--lisp/vc/vc-cvs.el9
-rw-r--r--lisp/vc/vc-dav.el4
-rw-r--r--lisp/vc/vc-dir.el14
-rw-r--r--lisp/vc/vc-dispatcher.el21
-rw-r--r--lisp/vc/vc-git.el40
-rw-r--r--lisp/vc/vc-hg.el7
-rw-r--r--lisp/vc/vc-hooks.el11
-rw-r--r--lisp/vc/vc-rcs.el9
-rw-r--r--lisp/vc/vc-sccs.el10
-rw-r--r--lisp/vc/vc-svn.el4
-rw-r--r--lisp/vc/vc.el124
28 files changed, 610 insertions, 478 deletions
diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el
index 8b55a78f84d..beaad2e835f 100644
--- a/lisp/vc/add-log.el
+++ b/lisp/vc/add-log.el
@@ -590,9 +590,8 @@ Compatibility function for \\[next-error] invocations."
["Go To Source" change-log-goto-source
:help "Go to source location of ChangeLog tag near point"]))
-;; It used to be called change-log-time-zone-rule but really should be
-;; called add-log-time-zone-rule since it's only used from add-log-* code.
-(defvaralias 'change-log-time-zone-rule 'add-log-time-zone-rule)
+(define-obsolete-variable-alias 'change-log-time-zone-rule
+ 'add-log-time-zone-rule "29.1")
(defvar add-log-time-zone-rule nil
"Time zone rule used for calculating change log time stamps.
If nil, use local time. If t, use Universal Time.
@@ -1069,8 +1068,23 @@ the change log file in another window."
(insert-before-markers "("))
(error nil)))))
+;; If we're filling a line that has a whole bunch of file names, and
+;; we're still in the file names, then transform this so that it'll
+;; still font-lock properly.
+(defun change-log-fill-file-list ()
+ (save-excursion
+ (unless (bobp)
+ (forward-line -1)
+ (when (looking-at change-log-file-names-re)
+ (goto-char (match-end 0))
+ (while (looking-at "\\=, \\([^ ,:([\n]+\\)")
+ (goto-char (match-end 0)))
+ (when (looking-at ", *\n")
+ (replace-match ":\n *" t t))))))
+
(defun change-log-indent ()
(change-log-fill-parenthesized-list)
+ (change-log-fill-file-list)
(let* ((indent
(save-excursion
(beginning-of-line)
diff --git a/lisp/vc/cvs-status.el b/lisp/vc/cvs-status.el
index c368da88754..7f921a73398 100644
--- a/lisp/vc/cvs-status.el
+++ b/lisp/vc/cvs-status.el
@@ -29,23 +29,21 @@
;;; Code:
(require 'cl-lib)
-(require 'pcvs-util)
+(require 'pcvs)
;;;
-(easy-mmode-defmap cvs-status-mode-map
- '(("n" . next-line)
- ("p" . previous-line)
- ("N" . cvs-status-next)
- ("P" . cvs-status-prev)
- ("\M-n" . cvs-status-next)
- ("\M-p" . cvs-status-prev)
- ("t" . cvs-status-cvstrees)
- ("T" . cvs-status-trees)
- (">" . cvs-mode-checkout))
- "CVS-Status' keymap."
- :group 'cvs-status
- :inherit 'cvs-mode-map)
+(defvar-keymap cvs-status-mode-map
+ :parent cvs-mode-map
+ "n" #'next-line
+ "p" #'previous-line
+ "N" #'cvs-status-next
+ "P" #'cvs-status-prev
+ "M-n" #'cvs-status-next
+ "M-p" #'cvs-status-prev
+ "t" #'cvs-status-cvstrees
+ "T" #'cvs-status-trees
+ ">" #'cvs-mode-checkout)
;;(easy-menu-define cvs-status-menu cvs-status-mode-map
;; "Menu for `cvs-status-mode'."
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index cd1e1b9d087..511cc89778d 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -55,6 +55,7 @@
;;; Code:
(eval-when-compile (require 'cl-lib))
(eval-when-compile (require 'subr-x))
+(require 'easy-mmode)
(autoload 'vc-find-revision "vc")
(autoload 'vc-find-revision-no-save "vc")
@@ -162,57 +163,55 @@ and hunk-based syntax highlighting otherwise as a fallback."
;;;; keymap, menu, ...
;;;;
-(easy-mmode-defmap diff-mode-shared-map
- '(("n" . diff-hunk-next)
- ("N" . diff-file-next)
- ("p" . diff-hunk-prev)
- ("P" . diff-file-prev)
- ("\t" . diff-hunk-next)
- ([backtab] . diff-hunk-prev)
- ("k" . diff-hunk-kill)
- ("K" . diff-file-kill)
- ("}" . diff-file-next) ; From compilation-minor-mode.
- ("{" . diff-file-prev)
- ("\C-m" . diff-goto-source)
- ([mouse-2] . diff-goto-source)
- ("W" . widen)
- ("o" . diff-goto-source) ; other-window
- ("A" . diff-ediff-patch)
- ("r" . diff-restrict-view)
- ("R" . diff-reverse-direction)
- ([remap undo] . diff-undo))
- "Basic keymap for `diff-mode', bound to various prefix keys."
- :inherit special-mode-map)
-
-(easy-mmode-defmap diff-mode-map
- `(("\e" . ,(let ((map (make-sparse-keymap)))
- ;; We want to inherit most bindings from diff-mode-shared-map,
- ;; but not all since they may hide useful M-<foo> global
- ;; bindings when editing.
- (set-keymap-parent map diff-mode-shared-map)
- (dolist (key '("A" "r" "R" "g" "q" "W" "z"))
- (define-key map key nil))
- map))
- ;; From compilation-minor-mode.
- ("\C-c\C-c" . diff-goto-source)
- ;; By analogy with the global C-x 4 a binding.
- ("\C-x4A" . diff-add-change-log-entries-other-window)
- ;; Misc operations.
- ("\C-c\C-a" . diff-apply-hunk)
- ("\C-c\C-e" . diff-ediff-patch)
- ("\C-c\C-n" . diff-restrict-view)
- ("\C-c\C-s" . diff-split-hunk)
- ("\C-c\C-t" . diff-test-hunk)
- ("\C-c\C-r" . diff-reverse-direction)
- ("\C-c\C-u" . diff-context->unified)
- ;; `d' because it duplicates the context :-( --Stef
- ("\C-c\C-d" . diff-unified->context)
- ("\C-c\C-w" . diff-ignore-whitespace-hunk)
- ;; `l' because it "refreshes" the hunk like C-l refreshes the screen
- ("\C-c\C-l" . diff-refresh-hunk)
- ("\C-c\C-b" . diff-refine-hunk) ;No reason for `b' :-(
- ("\C-c\C-f" . next-error-follow-minor-mode))
- "Keymap for `diff-mode'. See also `diff-mode-shared-map'.")
+(defvar-keymap diff-mode-shared-map
+ :parent special-mode-map
+ "n" #'diff-hunk-next
+ "N" #'diff-file-next
+ "p" #'diff-hunk-prev
+ "P" #'diff-file-prev
+ "TAB" #'diff-hunk-next
+ "<backtab>" #'diff-hunk-prev
+ "k" #'diff-hunk-kill
+ "K" #'diff-file-kill
+ "}" #'diff-file-next ; From compilation-minor-mode.
+ "{" #'diff-file-prev
+ "RET" #'diff-goto-source
+ "<mouse-2>" #'diff-goto-source
+ "W" #'widen
+ "o" #'diff-goto-source ; other-window
+ "A" #'diff-ediff-patch
+ "r" #'diff-restrict-view
+ "R" #'diff-reverse-direction
+ "<remap> <undo>" #'diff-undo)
+
+(defvar-keymap diff-mode-map
+ :doc "Keymap for `diff-mode'. See also `diff-mode-shared-map'."
+ "ESC" (let ((map (define-keymap :parent diff-mode-shared-map)))
+ ;; We want to inherit most bindings from
+ ;; `diff-mode-shared-map', but not all since they may hide
+ ;; useful `M-<foo>' global bindings when editing.
+ (dolist (key '("A" "r" "R" "g" "q" "W" "z"))
+ (keymap-set map key nil))
+ map)
+ ;; From compilation-minor-mode.
+ "C-c C-c" #'diff-goto-source
+ ;; By analogy with the global C-x 4 a binding.
+ "C-x 4 A" #'diff-add-change-log-entries-other-window
+ ;; Misc operations.
+ "C-c C-a" #'diff-apply-hunk
+ "C-c C-e" #'diff-ediff-patch
+ "C-c C-n" #'diff-restrict-view
+ "C-c C-s" #'diff-split-hunk
+ "C-c C-t" #'diff-test-hunk
+ "C-c C-r" #'diff-reverse-direction
+ "C-c C-u" #'diff-context->unified
+ ;; `d' because it duplicates the context :-( --Stef
+ "C-c C-d" #'diff-unified->context
+ "C-c C-w" #'diff-ignore-whitespace-hunk
+ ;; `l' because it "refreshes" the hunk like C-l refreshes the screen
+ "C-c C-l" #'diff-refresh-hunk
+ "C-c C-b" #'diff-refine-hunk ;No reason for `b' :-(
+ "C-c C-f" #'next-error-follow-minor-mode)
(easy-menu-define diff-mode-menu diff-mode-map
"Menu for `diff-mode'."
@@ -267,11 +266,12 @@ and hunk-based syntax highlighting otherwise as a fallback."
(defcustom diff-minor-mode-prefix "\C-c="
"Prefix key for `diff-minor-mode' commands."
- :type '(choice (string "\e") (string "C-c=") string))
+ :type '(choice (string "ESC")
+ (string "\C-c=") string))
-(easy-mmode-defmap diff-minor-mode-map
- `((,diff-minor-mode-prefix . ,diff-mode-shared-map))
- "Keymap for `diff-minor-mode'. See also `diff-mode-shared-map'.")
+(defvar-keymap diff-minor-mode-map
+ :doc "Keymap for `diff-minor-mode'. See also `diff-mode-shared-map'."
+ (key-description diff-minor-mode-prefix) diff-mode-shared-map)
(define-minor-mode diff-auto-refine-mode
"Toggle automatic diff hunk finer highlighting (Diff Auto Refine mode).
@@ -894,6 +894,9 @@ data such as \"Index: ...\" and such."
;; Fix the original hunk-header.
(diff-fixup-modifs start pos))))
+(defun diff--outline-level ()
+ (if (string-match-p diff-hunk-header-re (match-string 0))
+ 2 1))
;;;;
;;;; jump to other buffers
@@ -1476,6 +1479,14 @@ See `after-change-functions' for the meaning of BEG, END and LEN."
(defvar whitespace-style)
(defvar whitespace-trailing-regexp)
+(defvar-local diff-mode-read-only nil
+ "Non-nil when read-only diff buffer uses short keys.")
+
+;; It should be lower than `outline-minor-mode' and `view-mode'.
+(or (assq 'diff-mode-read-only minor-mode-map-alist)
+ (nconc minor-mode-map-alist
+ (list (cons 'diff-mode-read-only diff-mode-shared-map))))
+
;;;###autoload
(define-derived-mode diff-mode fundamental-mode "Diff"
"Major mode for viewing/editing context diffs.
@@ -1494,7 +1505,6 @@ a diff with \\[diff-reverse-direction].
(setq-local font-lock-defaults diff-font-lock-defaults)
(add-hook 'font-lock-mode-hook #'diff--font-lock-cleanup nil 'local)
- (setq-local outline-regexp diff-outline-regexp)
(setq-local imenu-generic-expression
diff-imenu-generic-expression)
;; These are not perfect. They would be better done separately for
@@ -1514,23 +1524,23 @@ a diff with \\[diff-reverse-direction].
(diff-setup-whitespace)
- (if diff-default-read-only
- (setq buffer-read-only t))
+ ;; read-only setup
+ (when diff-default-read-only
+ (setq buffer-read-only t))
+ (when buffer-read-only
+ (setq diff-mode-read-only t))
+ (add-hook 'read-only-mode-hook
+ (lambda ()
+ (setq diff-mode-read-only buffer-read-only))
+ nil t)
+
;; setup change hooks
(if (not diff-update-on-the-fly)
(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))
- ;; 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)
- ;; Turn off this little trick in case the buffer is put in view-mode.
- (add-hook 'view-mode-hook
- (lambda ()
- (setq minor-mode-overriding-map-alist
- (delq ro-bind minor-mode-overriding-map-alist)))
- nil t))
+
;; add-log support
(setq-local add-log-current-defun-function #'diff-current-defun)
(setq-local add-log-buffer-file-name-function
@@ -1539,11 +1549,7 @@ a diff with \\[diff-reverse-direction].
#'diff--filter-substring)
(unless buffer-file-name
(hack-dir-local-variables-non-file-buffer))
- (save-excursion
- (setq-local diff-buffer-type
- (if (re-search-forward "^diff --git" nil t)
- 'git
- nil))))
+ (diff-setup-buffer-type))
;;;###autoload
(define-minor-mode diff-minor-mode
@@ -1579,6 +1585,21 @@ modified lines of the diff."
"^[-+!] .*?\\([\t ]+\\)$"
"^[-+!<>].*?\\([\t ]+\\)$"))))
+(defun diff-setup-buffer-type ()
+ "Try to guess the `diff-buffer-type' from content of current Diff mode buffer.
+`outline-regexp' is updated accordingly."
+ (save-excursion
+ (goto-char (point-min))
+ (setq-local diff-buffer-type
+ (if (re-search-forward "^diff --git" nil t)
+ 'git
+ nil)))
+ (when (eq diff-buffer-type 'git)
+ (setq diff-outline-regexp
+ (concat "\\(^diff --git.*\n\\|" diff-hunk-header-re "\\)")))
+ (setq-local outline-level #'diff--outline-level)
+ (setq-local outline-regexp diff-outline-regexp))
+
(defun diff-delete-if-empty ()
;; An empty diff file means there's no more diffs to integrate, so we
;; can just remove the file altogether. Very handy for .rej files if we
@@ -2251,21 +2272,24 @@ Return new point, if it was moved."
"Iterate over all hunks between point and MAX.
Call FUN with two args (BEG and END) for each hunk."
(save-excursion
- (let* ((beg (or (ignore-errors (diff-beginning-of-hunk))
- (ignore-errors (diff-hunk-next) (point))
- max)))
- (while (< beg max)
- (goto-char beg)
- (cl-assert (looking-at diff-hunk-header-re))
- (let ((end
- (save-excursion (diff-end-of-hunk) (point))))
- (cl-assert (< beg end))
- (funcall fun beg end)
- (goto-char end)
- (setq beg (if (looking-at diff-hunk-header-re)
- end
- (or (ignore-errors (diff-hunk-next) (point))
- max))))))))
+ (catch 'malformed
+ (let* ((beg (or (ignore-errors (diff-beginning-of-hunk))
+ (ignore-errors (diff-hunk-next) (point))
+ max)))
+ (while (< beg max)
+ (goto-char beg)
+ (unless (looking-at diff-hunk-header-re)
+ (throw 'malformed nil))
+ (let ((end
+ (save-excursion (diff-end-of-hunk) (point))))
+ (unless (< beg end)
+ (throw 'malformed nil))
+ (funcall fun beg end)
+ (goto-char end)
+ (setq beg (if (looking-at diff-hunk-header-re)
+ end
+ (or (ignore-errors (diff-hunk-next) (point))
+ max)))))))))
(defun diff--font-lock-refined (max)
"Apply hunk refinement from font-lock."
@@ -2579,37 +2603,75 @@ fixed, visit it in a buffer."
(save-excursion
;; FIXME: Include the first space for context-style hunks!
(while (re-search-forward "^[-+! ]" limit t)
- (let ((spec (alist-get (char-before)
- '((?+ . (left-fringe diff-fringe-add diff-indicator-added))
- (?- . (left-fringe diff-fringe-del diff-indicator-removed))
- (?! . (left-fringe diff-fringe-rep diff-indicator-changed))
- (?\s . (left-fringe diff-fringe-nul fringe))))))
- (put-text-property (match-beginning 0) (match-end 0) 'display spec))))
+ (unless (eq (get-text-property (match-beginning 0) 'face) 'diff-header)
+ (let ((spec
+ (alist-get
+ (char-before)
+ '((?+ . (left-fringe diff-fringe-add diff-indicator-added))
+ (?- . (left-fringe diff-fringe-del diff-indicator-removed))
+ (?! . (left-fringe diff-fringe-rep diff-indicator-changed))
+ (?\s . (left-fringe diff-fringe-nul fringe))))))
+ (put-text-property (match-beginning 0) (match-end 0)
+ 'display spec)))))
;; Mimicks the output of Magit's diff.
;; FIXME: This has only been tested with Git's diff output.
+ ;; FIXME: Add support for Git's "rename from/to"?
(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!
+ ;; We split the regexp match into a search plus a looking-at because
+ ;; we want to use LIMIT for the search but we still want to match
+ ;; all the header's lines even if LIMIT falls in the middle of it.
(when (save-excursion
(forward-line 0)
(looking-at
(eval-when-compile
- (concat "diff.*\n"
- "\\(?:\\(?:new file\\|deleted\\).*\n\\)?"
- "\\(?:index.*\n\\)?"
- "--- \\(?:" null-device "\\|a/\\(.*\\)\\)\n"
- "\\+\\+\\+ \\(?:" null-device "\\|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 "")))))
+ (let* ((index "\\(?:index.*\n\\)?")
+ (file4 (concat
+ "\\(?:" null-device "\\|[ab]/\\(?4:.*\\)\\)"))
+ (file5 (concat
+ "\\(?:" null-device "\\|[ab]/\\(?5:.*\\)\\)"))
+ (header (concat "--- " file4 "\n"
+ "\\+\\+\\+ " file5 "\n"))
+ (binary (concat
+ "Binary files " file4
+ " and " file5 " \\(?7:differ\\)\n"))
+ (horb (concat "\\(?:" header "\\|" binary "\\)")))
+ (concat "diff.*?\\(?: a/\\(.*?\\) b/\\(.*\\)\\)?\n"
+ "\\(?:\\(?:old\\|new\\) mode .*\n\\)*"
+ "\\(?:"
+ ;; For new/deleted files, there might be no
+ ;; header (and no hunk) if the file is/was empty.
+ "\\(?3:new\\(?6:\\)\\|deleted\\) file.*\n"
+ index "\\(?:" horb "\\)?"
+ ;; Normal case.
+ "\\|" index horb "\\)")))))
+ ;; The file names can be extracted either from the `diff' line
+ ;; or from the two header lines. Prefer the header line info if
+ ;; available since the `diff' line is ambiguous in case the
+ ;; file names include " b/" or " a/".
+ ;; FIXME: This prettification throws away all the information
+ ;; about file modes (and the index hashes).
+ (let ((oldfile (or (match-string 4) (match-string 1)))
+ (newfile (or (match-string 5) (match-string 2)))
+ (kind (if (match-beginning 7) " BINARY"
+ (unless (or (match-beginning 4) (match-beginning 5))
+ " empty"))))
+ (add-text-properties
+ (match-beginning 0) (1- (match-end 0))
+ (list 'display
+ (propertize
+ (cond
+ ((match-beginning 3)
+ (concat (capitalize (match-string 3)) kind " file"
+ " "
+ (if (match-beginning 6) newfile oldfile)))
+ ((null (match-string 4))
+ (concat "New" kind " file " newfile))
+ ((null (match-string 2))
+ (concat "Deleted" kind " file " oldfile))
+ (t
+ (concat "Modified" kind " file " oldfile)))
+ 'face '(diff-file-header diff-header))
+ 'font-lock-multiline t))))))
nil)
;;; Syntax highlighting from font-lock
@@ -2654,7 +2716,8 @@ When OLD is non-nil, highlight the hunk from the old source."
;; Trim a trailing newline to find hunk in diff-syntax-fontify-props
;; in diffs that have no newline at end of diff file.
(text (string-trim-right
- (or (with-demoted-errors (diff-hunk-text hunk (not old) nil))
+ (or (with-demoted-errors "Error getting hunk text: %S"
+ (diff-hunk-text hunk (not old) nil))
"")))
(line (if (looking-at "\\(?:\\*\\{15\\}.*\n\\)?[-@* ]*\\([0-9,]+\\)\\([ acd+]+\\([0-9,]+\\)\\)?")
(if old (match-string 1)
diff --git a/lisp/vc/diff.el b/lisp/vc/diff.el
index 341a2891265..4abcf6c15a7 100644
--- a/lisp/vc/diff.el
+++ b/lisp/vc/diff.el
@@ -96,15 +96,15 @@ Non-interactively, OLD and NEW may each be a file or a buffer."
(interactive
(let* ((newf (if (and buffer-file-name (file-exists-p buffer-file-name))
(read-file-name
- (concat "Diff new file (default "
- (file-name-nondirectory buffer-file-name) "): ")
+ (format-prompt "Diff new file"
+ (file-name-nondirectory buffer-file-name))
nil buffer-file-name t)
(read-file-name "Diff new file: " nil nil t)))
(oldf (file-newest-backup newf)))
(setq oldf (if (and oldf (file-exists-p oldf))
(read-file-name
- (concat "Diff original file (default "
- (file-name-nondirectory oldf) "): ")
+ (format-prompt "Diff original file"
+ (file-name-nondirectory oldf))
(file-name-directory oldf) oldf t)
(read-file-name "Diff original file: "
(file-name-directory newf) nil t)))
diff --git a/lisp/vc/ediff-diff.el b/lisp/vc/ediff-diff.el
index ca56a2851db..07b853817d1 100644
--- a/lisp/vc/ediff-diff.el
+++ b/lisp/vc/ediff-diff.el
@@ -85,7 +85,10 @@ options after the default ones.
This variable is not for customizing the look of the differences produced by
the command \\[ediff-show-diff-output]. Use the variable
-`ediff-custom-diff-options' for that."
+`ediff-custom-diff-options' for that.
+
+Setting this variable directly may not yield the expected
+results. It should be set via the Customize interface instead."
:set #'ediff-set-diff-options
:type 'string)
diff --git a/lisp/vc/ediff-help.el b/lisp/vc/ediff-help.el
index 1a970f344e5..4e412041691 100644
--- a/lisp/vc/ediff-help.el
+++ b/lisp/vc/ediff-help.el
@@ -227,7 +227,9 @@ the value of this variable and the variables `ediff-help-message-*' in
((string= cmd "s") (re-search-forward "^['`‘]s['’]"))
((string= cmd "+") (re-search-forward "^['`‘]\\+['’]"))
((string= cmd "=") (re-search-forward "^['`‘]=['’]"))
- (t (user-error "Undocumented command! Type `G' in Ediff Control Panel to drop a note to the Ediff maintainer")))
+ (t (user-error (substitute-command-keys
+ "Undocumented command! Type \\`G' in Ediff Control \
+Panel to drop a note to the Ediff maintainer"))))
) ; let case-fold-search
))
diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el
index 896773067b7..de0a4d71ed2 100644
--- a/lisp/vc/ediff-init.el
+++ b/lisp/vc/ediff-init.el
@@ -615,8 +615,8 @@ Actually, Ediff restores the scope of visibility that existed at startup.")
(defcustom ediff-keep-variants t
"Nil means prompt to remove unmodified buffers A/B/C at session end.
-Supplying a prefix argument to the quit command `q' temporarily reverses the
-meaning of this variable."
+Supplying a prefix argument to the quit command \\`q' temporarily
+reverses the meaning of this variable."
:type 'boolean
:group 'ediff)
diff --git a/lisp/vc/ediff-ptch.el b/lisp/vc/ediff-ptch.el
index 8a6785e2c58..17654f80ec7 100644
--- a/lisp/vc/ediff-ptch.el
+++ b/lisp/vc/ediff-ptch.el
@@ -415,7 +415,9 @@ other files, enter `/dev/null'.
(with-output-to-temp-buffer ediff-msg-buffer
(ediff-with-current-buffer standard-output
(fundamental-mode))
- (princ (format-message "
+ (with-current-buffer standard-output
+ (insert (format-message
+ (substitute-command-keys "
Ediff has inferred that
%s
%s
@@ -423,10 +425,10 @@ are two possible targets for applying the patch.
Both files seem to be plausible alternatives.
Please advise:
- Type `y' to use %s as the target;
- Type `n' to use %s as the target.
-"
- file1 file2 file1 file2)))
+ Type \\`y' to use %s as the target;
+ Type \\`n' to use %s as the target.
+")
+ file1 file2 file1 file2))))
(setcar session-file-object
(if (y-or-n-p (format "Use %s ? " file1))
(progn
@@ -503,15 +505,11 @@ are two possible targets for this %spatch. However, these files do not exist."
patch-file-name)
(setq patch-file-name
(read-file-name
- (format "Patch is in file%s: "
- (cond ((and buffer-file-name
- (equal (expand-file-name dir)
- (file-name-directory buffer-file-name)))
- (concat
- " (default "
- (file-name-nondirectory buffer-file-name)
- ")"))
- (t "")))
+ (format-prompt "Patch is in file"
+ (and buffer-file-name
+ (equal (expand-file-name dir)
+ (file-name-directory buffer-file-name))
+ (file-name-nondirectory buffer-file-name)))
dir buffer-file-name 'must-match))
(if (file-directory-p patch-file-name)
(error "Patch file cannot be a directory: %s" patch-file-name)
@@ -827,7 +825,8 @@ you can still examine the changes via M-x ediff-files"
ediff-patch-diagnostics patch-diagnostics))
(bury-buffer patch-diagnostics)
- (message "Type `P', if you need to see patch diagnostics")
+ (message (substitute-command-keys
+ "Type \\`P', if you need to see patch diagnostics"))
ctl-buf))
(defun ediff-multi-patch-internal (patch-buf &optional startup-hooks)
diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el
index c757f71818b..b41def2aff3 100644
--- a/lisp/vc/ediff-util.el
+++ b/lisp/vc/ediff-util.el
@@ -3121,11 +3121,7 @@ Hit \\[ediff-recenter] to reset the windows afterward."
(lambda () (when defaults
(setq minibuffer-default defaults)))
(read-file-name
- (format "%s%s "
- prompt
- (cond (default-file
- (concat " (default " default-file "):"))
- (t (concat " (default " default-dir "):"))))
+ (format-prompt prompt (or default-file default-dir))
default-dir
(or default-file default-dir)
t ; must match, no-confirm
diff --git a/lisp/vc/ediff.el b/lisp/vc/ediff.el
index 7841c256034..840ab8cf51c 100644
--- a/lisp/vc/ediff.el
+++ b/lisp/vc/ediff.el
@@ -1558,7 +1558,9 @@ With optional NODE, goes to that node."
(info "ediff")
(if node
(Info-goto-node node)
- (message "Type `i' to search for a specific topic"))
+ (message (substitute-command-keys
+ (concat "Type \\<Info-mode-map>\\[Info-index] to"
+ " search for a specific topic"))))
(raise-frame))
(error (beep 1)
(with-output-to-temp-buffer ediff-msg-buffer
diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el
index c2000c7eec3..79dafe60cc2 100644
--- a/lisp/vc/log-edit.el
+++ b/lisp/vc/log-edit.el
@@ -54,21 +54,19 @@
(define-obsolete-variable-alias 'vc-log-mode-map 'log-edit-mode-map "28.1")
(define-obsolete-variable-alias 'vc-log-entry-mode 'log-edit-mode-map "28.1")
-(easy-mmode-defmap log-edit-mode-map
- '(("\C-c\C-c" . log-edit-done)
- ("\C-c\C-a" . log-edit-insert-changelog)
- ("\C-c\C-w" . log-edit-generate-changelog-from-diff)
- ("\C-c\C-d" . log-edit-show-diff)
- ("\C-c\C-f" . log-edit-show-files)
- ("\C-c\C-k" . log-edit-kill-buffer)
- ("\C-a" . log-edit-beginning-of-line)
- ("\M-n" . log-edit-next-comment)
- ("\M-p" . log-edit-previous-comment)
- ("\M-r" . log-edit-comment-search-backward)
- ("\M-s" . log-edit-comment-search-forward)
- ("\C-c?" . log-edit-mode-help))
- "Keymap for the `log-edit-mode' (to edit version control log messages)."
- :group 'log-edit)
+(defvar-keymap log-edit-mode-map
+ "C-c C-c" #'log-edit-done
+ "C-c C-a" #'log-edit-insert-changelog
+ "C-c C-w" #'log-edit-generate-changelog-from-diff
+ "C-c C-d" #'log-edit-show-diff
+ "C-c C-f" #'log-edit-show-files
+ "C-c C-k" #'log-edit-kill-buffer
+ "C-a" #'log-edit-beginning-of-line
+ "M-n" #'log-edit-next-comment
+ "M-p" #'log-edit-previous-comment
+ "M-r" #'log-edit-comment-search-backward
+ "M-s" #'log-edit-comment-search-forward
+ "C-c ?" #'log-edit-mode-help)
(easy-menu-define log-edit-menu log-edit-mode-map
"Menu used for `log-edit-mode'."
diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el
index bb2f49a7b65..9952345db50 100644
--- a/lisp/vc/log-view.el
+++ b/lisp/vc/log-view.el
@@ -110,6 +110,7 @@
;;; Code:
(require 'pcvs-util)
+(require 'easy-mmode)
(autoload 'vc-find-revision "vc")
(autoload 'vc-diff-internal "vc")
@@ -121,39 +122,23 @@
:group 'pcl-cvs
:prefix "log-view-")
-(easy-mmode-defmap log-view-mode-map
- '(
- ("-" . negative-argument)
- ("0" . digit-argument)
- ("1" . digit-argument)
- ("2" . digit-argument)
- ("3" . digit-argument)
- ("4" . digit-argument)
- ("5" . digit-argument)
- ("6" . digit-argument)
- ("7" . digit-argument)
- ("8" . digit-argument)
- ("9" . digit-argument)
-
- ("\C-m" . log-view-toggle-entry-display)
- ("m" . log-view-toggle-mark-entry)
- ("e" . log-view-modify-change-comment)
- ("d" . log-view-diff)
- ("=" . log-view-diff)
- ("D" . log-view-diff-changeset)
- ("a" . log-view-annotate-version)
- ("f" . log-view-find-revision)
- ("n" . log-view-msg-next)
- ("p" . log-view-msg-prev)
- ("\t" . log-view-msg-next)
- ([backtab] . log-view-msg-prev)
- ("N" . log-view-file-next)
- ("P" . log-view-file-prev)
- ("\M-n" . log-view-file-next)
- ("\M-p" . log-view-file-prev))
- "Log-View's keymap."
- :inherit special-mode-map
- :group 'log-view)
+(defvar-keymap log-view-mode-map
+ "RET" #'log-view-toggle-entry-display
+ "m" #'log-view-toggle-mark-entry
+ "e" #'log-view-modify-change-comment
+ "d" #'log-view-diff
+ "=" #'log-view-diff
+ "D" #'log-view-diff-changeset
+ "a" #'log-view-annotate-version
+ "f" #'log-view-find-revision
+ "n" #'log-view-msg-next
+ "p" #'log-view-msg-prev
+ "TAB" #'log-view-msg-next
+ "<backtab>" #'log-view-msg-prev
+ "N" #'log-view-file-next
+ "P" #'log-view-file-prev
+ "M-n" #'log-view-file-next
+ "M-p" #'log-view-file-prev)
(easy-menu-define log-view-mode-menu log-view-mode-map
"Log-View Display Menu."
diff --git a/lisp/vc/pcvs-defs.el b/lisp/vc/pcvs-defs.el
index f6b1895a5ca..2f11716bde9 100644
--- a/lisp/vc/pcvs-defs.el
+++ b/lisp/vc/pcvs-defs.el
@@ -264,160 +264,6 @@ This variable is buffer local and only used in the *cvs* buffer.")
(defconst cvs-vendor-branch "1.1.1"
"The default branch used by CVS for vendor code.")
-(easy-mmode-defmap cvs-mode-diff-map
- '(("E" "imerge" . cvs-mode-imerge)
- ("=" . cvs-mode-diff)
- ("e" "idiff" . cvs-mode-idiff)
- ("2" "other" . cvs-mode-idiff-other)
- ("d" "diff" . cvs-mode-diff)
- ("b" "backup" . cvs-mode-diff-backup)
- ("h" "head" . cvs-mode-diff-head)
- ("r" "repository" . cvs-mode-diff-repository)
- ("y" "yesterday" . cvs-mode-diff-yesterday)
- ("v" "vendor" . cvs-mode-diff-vendor))
- "Keymap for diff-related operations in `cvs-mode'."
- :name "Diff")
-;; This is necessary to allow correct handling of \\[cvs-mode-diff-map]
-;; in substitute-command-keys.
-(fset 'cvs-mode-diff-map cvs-mode-diff-map)
-
-(easy-mmode-defmap cvs-mode-map
- ;;(define-prefix-command 'cvs-mode-map-diff-prefix)
- ;;(define-prefix-command 'cvs-mode-map-control-c-prefix)
- '(;; various
- ;; (undo . cvs-mode-undo)
- ("?" . cvs-help)
- ("h" . cvs-help)
- ("q" . cvs-bury-buffer)
- ("z" . kill-this-buffer)
- ("F" . cvs-mode-set-flags)
- ;; ("\M-f" . cvs-mode-force-command)
- ("!" . cvs-mode-force-command)
- ("\C-c\C-c" . cvs-mode-kill-process)
- ;; marking
- ("m" . cvs-mode-mark)
- ("M" . cvs-mode-mark-all-files)
- ("S" . cvs-mode-mark-on-state)
- ("u" . cvs-mode-unmark)
- ("\C-?". cvs-mode-unmark-up)
- ("%" . cvs-mode-mark-matching-files)
- ("T" . cvs-mode-toggle-marks)
- ("\M-\C-?" . cvs-mode-unmark-all-files)
- ;; navigation keys
- (" " . cvs-mode-next-line)
- ("n" . cvs-mode-next-line)
- ("p" . cvs-mode-previous-line)
- ("\t" . cvs-mode-next-line)
- ([backtab] . cvs-mode-previous-line)
- ;; M- keys are usually those that operate on modules
- ;;("\M-C". cvs-mode-rcs2log) ; i.e. "Create a ChangeLog"
- ;;("\M-t". cvs-rtag)
- ;;("\M-l". cvs-rlog)
- ("\M-c". cvs-checkout)
- ("\M-e". cvs-examine)
- ("g" . cvs-mode-revert-buffer)
- ("\M-u". cvs-update)
- ("\M-s". cvs-status)
- ;; diff commands
- ("=" . cvs-mode-diff)
- ("d" . cvs-mode-diff-map)
- ;; keys that operate on individual files
- ("\C-k" . cvs-mode-acknowledge)
- ("A" . cvs-mode-add-change-log-entry-other-window)
- ;;("B" . cvs-mode-byte-compile-files)
- ("C" . cvs-mode-commit-setup)
- ("O" . cvs-mode-update)
- ("U" . cvs-mode-undo)
- ("I" . cvs-mode-insert)
- ("a" . cvs-mode-add)
- ("b" . cvs-set-branch-prefix)
- ("B" . cvs-set-secondary-branch-prefix)
- ("c" . cvs-mode-commit)
- ("e" . cvs-mode-examine)
- ("f" . cvs-mode-find-file)
- ("\C-m" . cvs-mode-find-file)
- ("i" . cvs-mode-ignore)
- ("l" . cvs-mode-log)
- ("o" . cvs-mode-find-file-other-window)
- ("r" . cvs-mode-remove)
- ("s" . cvs-mode-status)
- ("t" . cvs-mode-tag)
- ("v" . cvs-mode-view-file)
- ("x" . cvs-mode-remove-handled)
- ;; cvstree bindings
- ("+" . cvs-mode-tree)
- ;; mouse bindings
- ([mouse-2] . cvs-mode-find-file)
- ([follow-link] . (lambda (pos)
- (if (eq (get-char-property pos 'face) 'cvs-filename) t)))
- ([(down-mouse-3)] . cvs-menu)
- ;; dired-like bindings
- ("\C-o" . cvs-mode-display-file)
- ;; Emacs-21 toolbar
- ;;([tool-bar item1] . (menu-item "Examine" cvs-examine :image (image :file "/usr/share/icons/xpaint.xpm" :type xpm)))
- ;;([tool-bar item2] . (menu-item "Update" cvs-update :image (image :file "/usr/share/icons/mail1.xpm" :type xpm)))
- )
- "Keymap for `cvs-mode'."
- :dense t
- :suppress t)
-
-(fset 'cvs-mode-map cvs-mode-map)
-
-(easy-menu-define cvs-menu cvs-mode-map "Menu used in `cvs-mode'."
- '("CVS"
- ["Open file" cvs-mode-find-file t]
- ["Open in other window" cvs-mode-find-file-other-window t]
- ["Display in other window" cvs-mode-display-file t]
- ["Interactive merge" cvs-mode-imerge t]
- ("View diff"
- ["Interactive diff" cvs-mode-idiff t]
- ["Current diff" cvs-mode-diff t]
- ["Diff with head" cvs-mode-diff-head t]
- ["Diff with vendor" cvs-mode-diff-vendor t]
- ["Diff against yesterday" cvs-mode-diff-yesterday t]
- ["Diff with backup" cvs-mode-diff-backup t])
- ["View log" cvs-mode-log t]
- ["View status" cvs-mode-status t]
- ["View tag tree" cvs-mode-tree t]
- "----"
- ["Insert" cvs-mode-insert]
- ["Update" cvs-mode-update (cvs-enabledp 'update)]
- ["Re-examine" cvs-mode-examine t]
- ["Commit" cvs-mode-commit-setup (cvs-enabledp 'commit)]
- ["Tag" cvs-mode-tag (cvs-enabledp (when cvs-force-dir-tag 'tag))]
- ["Undo changes" cvs-mode-undo (cvs-enabledp 'undo)]
- ["Add" cvs-mode-add (cvs-enabledp 'add)]
- ["Remove" cvs-mode-remove (cvs-enabledp 'remove)]
- ["Ignore" cvs-mode-ignore (cvs-enabledp 'ignore)]
- ["Add ChangeLog" cvs-mode-add-change-log-entry-other-window t]
- "----"
- ["Mark" cvs-mode-mark t]
- ["Mark all" cvs-mode-mark-all-files t]
- ["Mark by regexp..." cvs-mode-mark-matching-files t]
- ["Mark by state..." cvs-mode-mark-on-state t]
- ["Unmark" cvs-mode-unmark t]
- ["Unmark all" cvs-mode-unmark-all-files t]
- ["Hide handled" cvs-mode-remove-handled t]
- "----"
- ["PCL-CVS Manual" (lambda () (interactive)
- (info "(pcl-cvs)Top")) t]
- "----"
- ["Quit" cvs-mode-quit t]))
-
-;;;;
-;;;; CVS-Minor mode
-;;;;
-
-(defcustom cvs-minor-mode-prefix "\C-xc"
- "Prefix key for the `cvs-mode' bindings in `cvs-minor-mode'."
- :type 'string)
-
-(easy-mmode-defmap cvs-minor-mode-map
- `((,cvs-minor-mode-prefix . cvs-mode-map)
- ("e" . (menu-item nil cvs-mode-edit-log
- :filter (lambda (x) (if (derived-mode-p 'log-view-mode) x)))))
- "Keymap for `cvs-minor-mode', used in buffers related to PCL-CVS.")
-
(defvar cvs-buffer nil
"(Buffer local) The *cvs* buffer associated with this buffer.")
(put 'cvs-buffer 'permanent-local t)
diff --git a/lisp/vc/pcvs-info.el b/lisp/vc/pcvs-info.el
index 11d14f95766..b48a4a1cbf1 100644
--- a/lisp/vc/pcvs-info.el
+++ b/lisp/vc/pcvs-info.el
@@ -130,9 +130,11 @@ to confuse some users sometimes."
(defvar cvs-bakprefix ".#"
"The prefix that CVS prepends to files when rcsmerge'ing.")
-(easy-mmode-defmap cvs-status-map
- '(([(mouse-2)] . cvs-mode-toggle-mark))
- "Local keymap for text properties of status.")
+(declare-function cvs-mode-toggle-mark "pcvs" (e))
+
+(defvar-keymap cvs-status-map
+ :doc "Local keymap for text properties of status."
+ "<mouse-2>" #'cvs-mode-toggle-mark)
;; Constructor:
diff --git a/lisp/vc/pcvs.el b/lisp/vc/pcvs.el
index 59b3d63c64a..c19fe9bd2ad 100644
--- a/lisp/vc/pcvs.el
+++ b/lisp/vc/pcvs.el
@@ -117,11 +117,11 @@
(require 'cl-lib)
(require 'ewoc) ;Ewoc was once cookie
-(require 'pcvs-defs)
(require 'pcvs-util)
(require 'pcvs-parse)
(require 'pcvs-info)
(require 'vc-cvs)
+(require 'easy-mmode)
;;;;
@@ -138,6 +138,147 @@
(defvar cvs-from-vc nil "Bound to t inside VC advice.")
+(defvar-keymap cvs-mode-diff-map
+ :name "Diff"
+ "E" (cons "imerge" #'cvs-mode-imerge)
+ "=" #'cvs-mode-diff
+ "e" (cons "idiff" #'cvs-mode-idiff)
+ "2" (cons "other" #'cvs-mode-idiff-other)
+ "d" (cons "diff" #'cvs-mode-diff)
+ "b" (cons "backup" #'cvs-mode-diff-backup)
+ "h" (cons "head" #'cvs-mode-diff-head)
+ "r" (cons "repository" #'cvs-mode-diff-repository)
+ "y" (cons "yesterday" #'cvs-mode-diff-yesterday)
+ "v" (cons "vendor" #'cvs-mode-diff-vendor))
+;; This is necessary to allow correct handling of \\[cvs-mode-diff-map]
+;; in substitute-command-keys.
+(fset 'cvs-mode-diff-map cvs-mode-diff-map)
+
+(defvar-keymap cvs-mode-map
+ :full t
+ :suppress t
+ ;; various
+ "?" #'cvs-help
+ "h" #'cvs-help
+ "q" #'cvs-bury-buffer
+ "z" #'kill-this-buffer
+ "F" #'cvs-mode-set-flags
+ "!" #'cvs-mode-force-command
+ "C-c C-c" #'cvs-mode-kill-process
+ ;; marking
+ "m" #'cvs-mode-mark
+ "M" #'cvs-mode-mark-all-files
+ "S" #'cvs-mode-mark-on-state
+ "u" #'cvs-mode-unmark
+ "DEL" #'cvs-mode-unmark-up
+ "%" #'cvs-mode-mark-matching-files
+ "T" #'cvs-mode-toggle-marks
+ "M-DEL" #'cvs-mode-unmark-all-files
+ ;; navigation keys
+ "SPC" #'cvs-mode-next-line
+ "n" #'cvs-mode-next-line
+ "p" #'cvs-mode-previous-line
+ "TAB" #'cvs-mode-next-line
+ "<backtab>" #'cvs-mode-previous-line
+ ;; M- keys are usually those that operate on modules
+ "M-c" #'cvs-checkout
+ "M-e" #'cvs-examine
+ "g" #'cvs-mode-revert-buffer
+ "M-u" #'cvs-update
+ "M-s" #'cvs-status
+ ;; diff commands
+ "=" #'cvs-mode-diff
+ "d" cvs-mode-diff-map
+ ;; keys that operate on individual files
+ "C-k" #'cvs-mode-acknowledge
+ "A" #'cvs-mode-add-change-log-entry-other-window
+ "C" #'cvs-mode-commit-setup
+ "O" #'cvs-mode-update
+ "U" #'cvs-mode-undo
+ "I" #'cvs-mode-insert
+ "a" #'cvs-mode-add
+ "b" #'cvs-set-branch-prefix
+ "B" #'cvs-set-secondary-branch-prefix
+ "c" #'cvs-mode-commit
+ "e" #'cvs-mode-examine
+ "f" #'cvs-mode-find-file
+ "RET" #'cvs-mode-find-file
+ "i" #'cvs-mode-ignore
+ "l" #'cvs-mode-log
+ "o" #'cvs-mode-find-file-other-window
+ "r" #'cvs-mode-remove
+ "s" #'cvs-mode-status
+ "t" #'cvs-mode-tag
+ "v" #'cvs-mode-view-file
+ "x" #'cvs-mode-remove-handled
+ ;; cvstree bindings
+ "+" #'cvs-mode-tree
+ ;; mouse bindings
+ "<mouse-2>" #'cvs-mode-find-file
+ "<follow-link>" (lambda (pos)
+ (eq (get-char-property pos 'face) 'cvs-filename))
+ "<down-mouse-3>" #'cvs-menu
+ ;; dired-like bindings
+ "C-o" #'cvs-mode-display-file)
+
+(easy-menu-define cvs-menu cvs-mode-map "Menu used in `cvs-mode'."
+ '("CVS"
+ ["Open file" cvs-mode-find-file t]
+ ["Open in other window" cvs-mode-find-file-other-window t]
+ ["Display in other window" cvs-mode-display-file t]
+ ["Interactive merge" cvs-mode-imerge t]
+ ("View diff"
+ ["Interactive diff" cvs-mode-idiff t]
+ ["Current diff" cvs-mode-diff t]
+ ["Diff with head" cvs-mode-diff-head t]
+ ["Diff with vendor" cvs-mode-diff-vendor t]
+ ["Diff against yesterday" cvs-mode-diff-yesterday t]
+ ["Diff with backup" cvs-mode-diff-backup t])
+ ["View log" cvs-mode-log t]
+ ["View status" cvs-mode-status t]
+ ["View tag tree" cvs-mode-tree t]
+ "----"
+ ["Insert" cvs-mode-insert]
+ ["Update" cvs-mode-update (cvs-enabledp 'update)]
+ ["Re-examine" cvs-mode-examine t]
+ ["Commit" cvs-mode-commit-setup (cvs-enabledp 'commit)]
+ ["Tag" cvs-mode-tag (cvs-enabledp (when cvs-force-dir-tag 'tag))]
+ ["Undo changes" cvs-mode-undo (cvs-enabledp 'undo)]
+ ["Add" cvs-mode-add (cvs-enabledp 'add)]
+ ["Remove" cvs-mode-remove (cvs-enabledp 'remove)]
+ ["Ignore" cvs-mode-ignore (cvs-enabledp 'ignore)]
+ ["Add ChangeLog" cvs-mode-add-change-log-entry-other-window t]
+ "----"
+ ["Mark" cvs-mode-mark t]
+ ["Mark all" cvs-mode-mark-all-files t]
+ ["Mark by regexp..." cvs-mode-mark-matching-files t]
+ ["Mark by state..." cvs-mode-mark-on-state t]
+ ["Unmark" cvs-mode-unmark t]
+ ["Unmark all" cvs-mode-unmark-all-files t]
+ ["Hide handled" cvs-mode-remove-handled t]
+ "----"
+ ["PCL-CVS Manual" (lambda () (interactive)
+ (info "(pcl-cvs)Top")) t]
+ "----"
+ ["Quit" cvs-mode-quit t]))
+
+;;;;
+;;;; CVS-Minor mode
+;;;;
+
+(defcustom cvs-minor-mode-prefix "\C-xc"
+ "Prefix key for the `cvs-mode' bindings in `cvs-minor-mode'."
+ :type 'string
+ :group 'pcl-cvs)
+
+(defvar-keymap cvs-minor-mode-map
+ (key-description cvs-minor-mode-prefix) 'cvs-mode-map
+ "e" '(menu-item nil cvs-mode-edit-log
+ :filter (lambda (x)
+ (and (derived-mode-p 'log-view-mode) x))))
+
+(require 'pcvs-defs)
+
;;;;
;;;; flags variables
;;;;
@@ -758,6 +899,7 @@ clear what alternative to use.
- `DOUBLE' is the generic case."
(declare (debug (&define sexp lambda-list stringp
("interactive" interactive) def-body))
+ (indent defun)
(doc-string 3))
(let ((style (cvs-cdr fun))
(fun (cvs-car fun)))
@@ -1284,8 +1426,7 @@ marked instead. A directory can never be marked."
(intern
(upcase
(completing-read
- (concat
- "Mark files in state" (if default (concat " [" default "]")) ": ")
+ (format-prompt "Mark files in state" default)
(mapcar (lambda (x)
(list (downcase (symbol-name (car x)))))
cvs-states)
diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el
index 51ad8293f65..003b26eca41 100644
--- a/lisp/vc/smerge-mode.el
+++ b/lisp/vc/smerge-mode.el
@@ -47,6 +47,7 @@
(require 'diff) ;For diff-check-labels.
(require 'diff-mode) ;For diff-refine.
(require 'newcomment)
+(require 'easy-mmode)
;;; The real definition comes later.
(defvar smerge-mode)
@@ -142,36 +143,34 @@ Used in `smerge-diff-base-upper' and related functions."
"Face used for added characters shown by `smerge-refine'."
:version "24.3")
-(easy-mmode-defmap smerge-basic-map
- `(("n" . smerge-next)
- ("p" . smerge-prev)
- ("r" . smerge-resolve)
- ("a" . smerge-keep-all)
- ("b" . smerge-keep-base)
- ("o" . smerge-keep-lower) ; for the obsolete keep-other
- ("l" . smerge-keep-lower)
- ("m" . smerge-keep-upper) ; for the obsolete keep-mine
- ("u" . smerge-keep-upper)
- ("E" . smerge-ediff)
- ("C" . smerge-combine-with-next)
- ("R" . smerge-refine)
- ("\C-m" . smerge-keep-current)
- ("=" . ,(make-sparse-keymap "Diff"))
- ("=<" "base-upper" . smerge-diff-base-upper)
- ("=>" "base-lower" . smerge-diff-base-lower)
- ("==" "upper-lower" . smerge-diff-upper-lower))
- "The base keymap for `smerge-mode'.")
+(defvar-keymap smerge-basic-map
+ "n" #'smerge-next
+ "p" #'smerge-prev
+ "r" #'smerge-resolve
+ "a" #'smerge-keep-all
+ "b" #'smerge-keep-base
+ "o" #'smerge-keep-lower ; for the obsolete keep-other
+ "l" #'smerge-keep-lower
+ "m" #'smerge-keep-upper ; for the obsolete keep-mine
+ "u" #'smerge-keep-upper
+ "E" #'smerge-ediff
+ "C" #'smerge-combine-with-next
+ "R" #'smerge-refine
+ "C-m" #'smerge-keep-current
+ "=" (define-keymap :name "Diff"
+ "<" (cons "base-upper" #'smerge-diff-base-upper)
+ ">" (cons "base-lower" #'smerge-diff-base-lower)
+ "=" (cons "upper-lower" #'smerge-diff-upper-lower)))
(defcustom smerge-command-prefix "\C-c^"
"Prefix for `smerge-mode' commands."
:type '(choice (const :tag "ESC" "\e")
- (const :tag "C-c ^" "\C-c^" )
+ (const :tag "C-c ^" "\C-c^")
(const :tag "none" "")
string))
-(easy-mmode-defmap smerge-mode-map
- `((,smerge-command-prefix . ,smerge-basic-map))
- "Keymap for `smerge-mode'.")
+(defvar-keymap smerge-mode-map
+ (key-description smerge-command-prefix) smerge-basic-map)
(defvar-local smerge-check-cache nil)
(defun smerge-check (n)
@@ -926,8 +925,11 @@ Its behavior has mainly two restrictions:
to `smerge-refine-regions'.
This only matters if `smerge-refine-weight-hack' is nil.")
-(defvar smerge-refine-ignore-whitespace t
- "If non-nil, `smerge-refine' should try to ignore change in whitespace.")
+(defcustom smerge-refine-ignore-whitespace t
+ "If non-nil, `smerge-refine' should try to ignore change in whitespace."
+ :type 'boolean
+ :version "29.1"
+ :group 'diff)
(defvar smerge-refine-weight-hack t
"If non-nil, pass to diff as many lines as there are chars in the region.
diff --git a/lisp/vc/vc-annotate.el b/lisp/vc/vc-annotate.el
index bd4ff3e015a..4a511f1f688 100644
--- a/lisp/vc/vc-annotate.el
+++ b/lisp/vc/vc-annotate.el
@@ -57,7 +57,7 @@ is applied to the background."
:set (lambda (symbol value)
(set-default symbol value)
(when (boundp 'vc-annotate-color-map)
- (with-demoted-errors
+ (with-demoted-errors "VC color map error: %S"
;; Update the value of the dependent variable.
(custom-reevaluate-setting 'vc-annotate-color-map))))
:version "25.1"
diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el
index 559bb25d091..e234b9a0447 100644
--- a/lisp/vc/vc-cvs.el
+++ b/lisp/vc/vc-cvs.el
@@ -309,10 +309,11 @@ to the CVS command."
(defun vc-cvs-responsible-p (file)
"Return non-nil if CVS thinks it is responsible for FILE."
- (file-directory-p (expand-file-name "CVS"
- (if (file-directory-p file)
- file
- (file-name-directory file)))))
+ (let ((dir (if (file-directory-p file)
+ file
+ (file-name-directory file))))
+ (and (file-directory-p (expand-file-name "CVS" dir))
+ (file-name-directory (expand-file-name "CVS" dir)))))
(defun vc-cvs-could-register (file)
"Return non-nil if FILE could be registered in CVS.
diff --git a/lisp/vc/vc-dav.el b/lisp/vc/vc-dav.el
index 1cc447fe0f9..61e2cd23900 100644
--- a/lisp/vc/vc-dav.el
+++ b/lisp/vc/vc-dav.el
@@ -136,10 +136,10 @@ It should return a status of either 0 (no differences found), or
"Find the version control state of all files in DIR in a fast way."
)
-(defun vc-dav-responsible-p (_url)
+(defun vc-dav-responsible-p (url)
"Return non-nil if DAV considers itself `responsible' for URL."
;; Check for DAV support on the web server.
- t)
+ (and t url))
;;; Unimplemented functions
;;
diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el
index b7315cfed54..0d750515c3d 100644
--- a/lisp/vc/vc-dir.el
+++ b/lisp/vc/vc-dir.el
@@ -1427,7 +1427,12 @@ These are the commands available for use in the file status buffer:
(vc-dir-refresh)
;; FIXME: find a better way to pass the backend to `vc-dir-mode'.
(let ((use-vc-backend backend))
- (vc-dir-mode))))
+ (vc-dir-mode)
+ ;; Activate the backend-specific minor mode, if any.
+ (when-let ((minor-mode
+ (intern-soft (format "vc-dir-%s-mode"
+ (downcase (symbol-name backend))))))
+ (funcall minor-mode 1)))))
(defun vc-default-dir-extra-headers (_backend _dir)
;; Be loud by default to remind people to add code to display
@@ -1533,9 +1538,8 @@ These are the commands available for use in the file status buffer:
This implements the `bookmark-make-record-function' type for
`vc-dir' buffers."
(let* ((bookmark-name
- (concat "(" (symbol-name vc-dir-backend) ") "
- (file-name-nondirectory
- (directory-file-name default-directory))))
+ (file-name-nondirectory
+ (directory-file-name default-directory)))
(defaults (list bookmark-name default-directory)))
`(,bookmark-name
,@(bookmark-make-record-default 'no-file)
@@ -1555,6 +1559,8 @@ type returned by `vc-dir-bookmark-make-record'."
(bookmark-default-handler
`("" (buffer . ,buf) . ,(bookmark-get-bookmark-record bmk)))))
+(put 'vc-dir-bookmark-jump 'bookmark-handler-type "VC")
+
(provide 'vc-dir)
diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el
index a55954467e0..5c664d58f1a 100644
--- a/lisp/vc/vc-dispatcher.el
+++ b/lisp/vc/vc-dispatcher.el
@@ -127,8 +127,12 @@ preserve the setting."
:group 'vc)
(defcustom vc-command-messages nil
- "If non-nil, display run messages from back-end commands."
- :type 'boolean
+ "If non-nil, display and log messages about running back-end commands.
+If the value is `log', messages about running VC back-end commands are
+logged in the *Messages* buffer, but not displayed."
+ :type '(choice (const :tag "No messages" nil)
+ (const :tag "Display and log messages" t)
+ (const :tag "Log messages, but don't display" log))
:group 'vc)
(defcustom vc-suppress-confirm nil
@@ -311,7 +315,10 @@ case, and the process object in the asynchronous case."
(substring command 0 -1)
command)
" " (vc-delistify flags)
- " " (vc-delistify files))))
+ " " (vc-delistify files)))
+ (vc-inhibit-message
+ (or (eq vc-command-messages 'log)
+ (eq (selected-window) (active-minibuffer-window)))))
(save-current-buffer
(unless (or (eq buffer t)
(and (stringp buffer)
@@ -335,7 +342,7 @@ case, and the process object in the asynchronous case."
(apply #'start-file-process command (current-buffer)
command squeezed))))
(when vc-command-messages
- (let ((inhibit-message (eq (selected-window) (active-minibuffer-window))))
+ (let ((inhibit-message vc-inhibit-message))
(message "Running in background: %s" full-command)))
;; Get rid of the default message insertion, in case we don't
;; set a sentinel explicitly.
@@ -345,11 +352,11 @@ case, and the process object in the asynchronous case."
(when vc-command-messages
(vc-run-delayed
(let ((message-truncate-lines t)
- (inhibit-message (eq (selected-window) (active-minibuffer-window))))
+ (inhibit-message vc-inhibit-message))
(message "Done in background: %s" full-command)))))
;; Run synchronously
(when vc-command-messages
- (let ((inhibit-message (eq (selected-window) (active-minibuffer-window))))
+ (let ((inhibit-message vc-inhibit-message))
(message "Running in foreground: %s" full-command)))
(let ((buffer-undo-list t))
(setq status (apply #'process-file command nil t nil squeezed)))
@@ -364,7 +371,7 @@ case, and the process object in the asynchronous case."
(if (integerp status) (format "status %d" status) status)
full-command))
(when vc-command-messages
- (let ((inhibit-message (eq (selected-window) (active-minibuffer-window))))
+ (let ((inhibit-message vc-inhibit-message))
(message "Done (status=%d): %s" status full-command)))))
(vc-run-delayed
(run-hook-with-args 'vc-post-command-functions
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 7072b8e483b..ad39dc604a9 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -290,12 +290,14 @@ Good example of file name that needs this: \"test[56].xx\".")
(vc-git--run-command-string nil "version")))
(setq vc-git--program-version
(if (and version-string
- ;; Git for Windows appends ".windows.N" to the
- ;; numerical version reported by Git.
- (string-match
- "git version \\([0-9.]+\\)\\(\\.windows\\.[0-9]+\\)?$"
- version-string))
- (match-string 1 version-string)
+ ;; Some Git versions append additional strings
+ ;; to the numerical version string. E.g., Git
+ ;; for Windows appends ".windows.N", while Git
+ ;; for Mac appends " (Apple Git-N)". Capture
+ ;; numerical version and ignore the rest.
+ (string-match "git version \\([0-9][0-9.]+\\)"
+ version-string))
+ (string-trim-right (match-string 1 version-string) "\\.")
"0")))))
(defun vc-git--git-status-to-vc-state (code-list)
@@ -1680,7 +1682,7 @@ This command shares argument histories with \\[rgrep] and \\[grep]."
(let ((stash (completing-read
prompt
(split-string
- (or (vc-git--run-command-string nil "stash" "list") "") "\n")
+ (or (vc-git--run-command-string nil "stash" "list") "") "\n" t)
nil :require-match nil 'vc-git-stash-read-history)))
(if (string-equal stash "")
(user-error "Not a stash")
@@ -1693,8 +1695,8 @@ This command shares argument histories with \\[rgrep] and \\[grep]."
(vc-setup-buffer "*vc-git-stash*")
(vc-git-command "*vc-git-stash*" 'async nil "stash" "show" "-p" name)
(set-buffer "*vc-git-stash*")
- (diff-mode)
(setq buffer-read-only t)
+ (diff-mode)
(pop-to-buffer (current-buffer)))
(defun vc-git-stash-apply (name)
@@ -1725,12 +1727,11 @@ This command shares argument histories with \\[rgrep] and \\[grep]."
(defun vc-git-stash-list ()
(when-let ((out (vc-git--run-command-string nil "stash" "list")))
- (delete
- ""
- (split-string
- (replace-regexp-in-string
- "^stash@" " " out)
- "\n"))))
+ (split-string
+ (replace-regexp-in-string
+ "^stash@" " " out)
+ "\n"
+ t)))
(defun vc-git-stash-get-at-point (point)
(save-excursion
@@ -1867,6 +1868,17 @@ Returns nil if not possible."
(1- (point-max)))))))
(and name (not (string= name "undefined")) name))))
+(defvar-keymap vc-dir-git-mode-map
+ "z c" #'vc-git-stash
+ "z s" #'vc-git-stash-snapshot
+ "z p" #'vc-git-stash-pop)
+
+(define-minor-mode vc-dir-git-mode
+ "A minor mode for git-specific commands in `vc-dir-mode' buffers.
+Also note that there are git stash commands available in the
+\"Stash\" section at the head of the buffer."
+ :lighter " Git")
+
(provide 'vc-git)
;;; vc-git.el ends here
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index 1b94311a817..026f125396e 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -672,7 +672,6 @@ Return the byte's value as an integer."
(let* ((result nil)
(flen (length fname))
(case-fold-search nil)
- (inhibit-changing-match-data t)
;; Find a conservative bound for the loop below by using
;; Boyer-Moore on the raw dirstate without parsing it; we
;; know we can't possibly find fname _after_ the last place
@@ -976,10 +975,9 @@ REPO must be the directory name of an hg repository."
"Test whether the ignore pattern set HGIP says to ignore FILENAME.
FILENAME must be the file's true absolute name."
(let ((patterns (vc-hg--ignore-patterns-ignore-patterns hgip))
- (inhibit-changing-match-data t)
(ignored nil))
(while (and patterns (not ignored))
- (setf ignored (string-match (pop patterns) filename)))
+ (setf ignored (string-match-p (pop patterns) filename)))
ignored))
(defvar vc-hg--cached-ignore-patterns nil
@@ -1043,7 +1041,8 @@ Avoids the need to repeatedly scan dirstate on repeated calls to
(equal size (pop cache))
(equal ascii-fname (pop cache)))
(pop cache)
- (let ((result (vc-hg--raw-dirstate-search dirstate ascii-fname)))
+ (let ((result (save-match-data
+ (vc-hg--raw-dirstate-search dirstate ascii-fname))))
(setf vc-hg--dirstate-scan-cache
(list dirstate mtime size ascii-fname result))
result))))
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el
index ee295b17c73..bd2ea337b16 100644
--- a/lisp/vc/vc-hooks.el
+++ b/lisp/vc/vc-hooks.el
@@ -143,6 +143,7 @@ visited and a warning displayed."
(const :tag "Visit link and warn" nil)
(const :tag "Follow link" t))
:group 'vc)
+(put 'vc-follow-symlinks 'safe-local-variable #'null)
(defcustom vc-display-status t
"If non-nil, display revision number and lock status in mode line.
@@ -798,9 +799,10 @@ In the latter case, VC mode is deactivated for this buffer."
(add-hook 'vc-mode-line-hook #'vc-mode-line nil t)
(let (backend)
(cond
- ((setq backend (with-demoted-errors (vc-backend buffer-file-name)))
- ;; Let the backend setup any buffer-local things he needs.
- (vc-call-backend backend 'find-file-hook)
+ ((setq backend (with-demoted-errors "VC refresh error: %S"
+ (vc-backend buffer-file-name)))
+ ;; Let the backend setup any buffer-local things he needs.
+ (vc-call-backend backend 'find-file-hook)
;; Compute the state and put it in the mode line.
(vc-mode-line buffer-file-name backend)
(unless vc-make-backup-files
@@ -864,7 +866,8 @@ In the latter case, VC mode is deactivated for this buffer."
(defvar vc-prefix-map
(let ((map (make-sparse-keymap)))
(define-key map "a" #'vc-update-change-log)
- (define-key map "b" #'vc-switch-backend)
+ (with-suppressed-warnings ((obsolete vc-switch-backend))
+ (define-key map "b" #'vc-switch-backend))
(define-key map "d" #'vc-dir)
(define-key map "g" #'vc-annotate)
(define-key map "G" #'vc-ignore)
diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el
index 4137ece8d61..20f3b1fba71 100644
--- a/lisp/vc/vc-rcs.el
+++ b/lisp/vc/vc-rcs.el
@@ -290,10 +290,11 @@ to the RCS command."
(defun vc-rcs-responsible-p (file)
"Return non-nil if RCS thinks it would be responsible for registering FILE."
;; TODO: check for all the patterns in vc-rcs-master-templates
- (file-directory-p (expand-file-name "RCS"
- (if (file-directory-p file)
- file
- (file-name-directory file)))))
+ (let ((dir (if (file-directory-p file)
+ file
+ (file-name-directory file))))
+ (and (file-directory-p (expand-file-name "RCS" dir))
+ (file-name-directory (expand-file-name "RCS" dir)))))
(defun vc-rcs-receive-file (file rev)
"Implementation of receive-file for RCS."
diff --git a/lisp/vc/vc-sccs.el b/lisp/vc/vc-sccs.el
index 2ca848dae16..4bbf92b3274 100644
--- a/lisp/vc/vc-sccs.el
+++ b/lisp/vc/vc-sccs.el
@@ -214,9 +214,13 @@ to the SCCS command."
(defun vc-sccs-responsible-p (file)
"Return non-nil if SCCS thinks it would be responsible for registering FILE."
;; TODO: check for all the patterns in vc-sccs-master-templates
- (or (file-directory-p (expand-file-name "SCCS" (file-name-directory file)))
- (stringp (vc-sccs-search-project-dir (or (file-name-directory file) "")
- (file-name-nondirectory file)))))
+ (or (and (file-directory-p
+ (expand-file-name "SCCS" (file-name-directory file)))
+ (file-name-directory file))
+ (let ((dir (vc-sccs-search-project-dir (or (file-name-directory file) "")
+ (file-name-nondirectory file))))
+ (and (stringp dir)
+ dir))))
(defun vc-sccs-checkin (files comment &optional rev)
"SCCS-specific version of `vc-backend-checkin'."
diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el
index b38a676acbd..3cf692bfdaa 100644
--- a/lisp/vc/vc-svn.el
+++ b/lisp/vc/vc-svn.el
@@ -201,8 +201,8 @@ switches."
;; FIXME are there other possible combinations?
(cond ((eq state 'edited) (setq state 'needs-merge))
((not state) (setq state 'needs-update))))
- (when (and state (not (string= "." filename)))
- (setq result (cons (list filename state) result)))))
+ (when state
+ (setq result (cons (list filename state) result)))))
(funcall callback result)))
;; dir-status-files called from vc-dir, which loads vc,
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 45c09ae1c6a..a6124acadd2 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -739,6 +739,7 @@
(require 'cl-lib)
(declare-function diff-setup-whitespace "diff-mode" ())
+(declare-function diff-setup-buffer-type "diff-mode" ())
(eval-when-compile
(require 'dired))
@@ -937,11 +938,20 @@ repository, prompting for the directory and the VC backend to
use."
(catch 'found
;; First try: find a responsible backend, it must be a backend
- ;; under which FILE is not yet registered.
- (dolist (backend vc-handled-backends)
- (and (not (vc-call-backend backend 'registered file))
- (vc-call-backend backend 'responsible-p file)
- (throw 'found backend)))
+ ;; under which FILE is not yet registered and with the most
+ ;; specific path to FILE.
+ (let ((max 0)
+ bk)
+ (dolist (backend vc-handled-backends)
+ (when (not (vc-call-backend backend 'registered file))
+ (let* ((dir-name (vc-call-backend backend 'responsible-p file))
+ (len (and dir-name
+ (length (file-name-split
+ (expand-file-name dir-name))))))
+ (when (and len (> len max))
+ (setq max len bk backend)))))
+ (when bk
+ (throw 'found bk)))
;; no responsible backend
(let* ((possible-backends
(let (pos)
@@ -969,7 +979,7 @@ use."
(message "arg %s" arg)
(and (file-directory-p arg)
(string-prefix-p (expand-file-name arg) def-dir)))))))
- (let ((default-directory repo-dir))
+ (let ((default-directory repo-dir))
(vc-call-backend bk 'create-repo))
(throw 'found bk))))
@@ -994,13 +1004,14 @@ responsible for the given file."
;;
;; First try: find a responsible backend. If this is for registration,
;; it must be a backend under which FILE is not yet registered.
- (let ((dirs (delq nil
- (mapcar
- (lambda (backend)
- (when-let ((dir (vc-call-backend
- backend 'responsible-p file)))
- (cons backend dir)))
- vc-handled-backends))))
+ (let* ((file (expand-file-name file))
+ (dirs (delq nil
+ (mapcar
+ (lambda (backend)
+ (when-let ((dir (vc-call-backend
+ backend 'responsible-p file)))
+ (cons backend dir)))
+ vc-handled-backends))))
;; Just a single response (or none); use it.
(if (< (length dirs) 2)
(caar dirs)
@@ -1188,7 +1199,11 @@ For old-style locking-based version control systems, like RCS:
*vc-log* buffer to check in the changes. Leave a
read-only copy of each changed file after checking in.
If every file is locked by you and unchanged, unlock them.
- If every file is locked by someone else, offer to steal the lock."
+ If every file is locked by someone else, offer to steal the lock.
+
+When using this command to register a new file (or files), it
+will automatically deduce which VC repository to register it
+with, using the most specific one."
(interactive "P")
(let* ((vc-fileset (vc-deduce-fileset nil t 'state-model-only-files))
(backend (car vc-fileset))
@@ -1716,21 +1731,48 @@ to override the value of `vc-diff-switches' and `diff-switches'."
;; any switches in diff-switches.
(when (listp switches) switches))))
-(defun vc-diff-finish (buffer messages)
+(defun vc-shrink-buffer-window (&optional buffer)
+ "Call `shrink-window-if-larger-than-buffer' only when BUFFER is visible.
+BUFFER defaults to the current buffer."
+ (let ((window (get-buffer-window buffer t)))
+ (when window
+ (shrink-window-if-larger-than-buffer window))))
+
+(defvar vc-diff-finish-functions '(vc-shrink-buffer-window)
+ "Functions run at the end of the diff command.
+Each function runs in the diff output buffer without args.")
+
+(defun vc-diff-restore-buffer (original new)
+ "Restore point in buffer NEW to where it was in ORIGINAL.
+
+This function works by updating buffer ORIGINAL with the contents
+of NEW (without destroying existing markers), swapping their text
+objects, and finally killing buffer ORIGINAL."
+ (with-current-buffer original
+ (let ((inhibit-read-only t))
+ (replace-buffer-contents new)))
+ (with-current-buffer new
+ (buffer-swap-text original))
+ (kill-buffer original))
+
+(defun vc-diff-finish (buffer messages &optional oldbuf)
;; The empty sync output case has already been handled, so the only
;; possibility of an empty output is for an async process.
(when (buffer-live-p buffer)
- (let ((window (get-buffer-window buffer t))
- (emptyp (zerop (buffer-size buffer))))
+ (let ((emptyp (zerop (buffer-size buffer))))
(with-current-buffer buffer
(and messages emptyp
(let ((inhibit-read-only t))
(insert (cdr messages) ".\n")
(message "%s" (cdr messages))))
(diff-setup-whitespace)
- (goto-char (point-min))
- (when window
- (shrink-window-if-larger-than-buffer window)))
+ (diff-setup-buffer-type)
+ ;; `oldbuf' is the buffer that used to show this diff. Make
+ ;; sure that we restore point in it if it's given.
+ (if oldbuf
+ (vc-diff-restore-buffer oldbuf buffer)
+ (goto-char (point-min)))
+ (run-hooks 'vc-diff-finish-functions))
(when (and messages (not emptyp))
(message "%sdone" (car messages))))))
@@ -1754,7 +1796,11 @@ Return t if the buffer had changes, nil otherwise."
;; but the only way to set it for each file included would
;; be to call the back end separately for each file.
(coding-system-for-read
- (if files (vc-coding-system-for-diff (car files)) 'undecided)))
+ (if files (vc-coding-system-for-diff (car files)) 'undecided))
+ (orig-diff-buffer-clone
+ (if revert-buffer-in-progress-p
+ (clone-buffer
+ (generate-new-buffer-name " *vc-diff-clone*") nil))))
;; On MS-Windows and MS-DOS, Diff is likely to produce DOS-style
;; EOLs, which will look ugly if (car files) happens to have Unix
;; EOLs.
@@ -1793,16 +1839,16 @@ Return t if the buffer had changes, nil otherwise."
(setq files (nreverse filtered))))
(vc-call-backend (car vc-fileset) 'diff files rev1 rev2 buffer async)
(set-buffer buffer)
+ ;; Make the *vc-diff* buffer read only, the diff-mode key
+ ;; bindings are nicer for read only buffers. pcl-cvs does the
+ ;; same thing.
+ (setq buffer-read-only t)
(diff-mode)
(setq-local diff-vc-backend (car vc-fileset))
(setq-local diff-vc-revisions (list rev1 rev2))
(setq-local revert-buffer-function
(lambda (_ignore-auto _noconfirm)
(vc-diff-internal async vc-fileset rev1 rev2 verbose)))
- ;; Make the *vc-diff* buffer read only, the diff-mode key
- ;; bindings are nicer for read only buffers. pcl-cvs does the
- ;; same thing.
- (setq buffer-read-only t)
(if (and (zerop (buffer-size))
(not (get-buffer-process (current-buffer))))
;; Treat this case specially so as not to pop the buffer.
@@ -1815,7 +1861,8 @@ Return t if the buffer had changes, nil otherwise."
;; after `pop-to-buffer'; the former assumes the diff buffer is
;; shown in some window.
(let ((buf (current-buffer)))
- (vc-run-delayed (vc-diff-finish buf (when verbose messages))))
+ (vc-run-delayed (vc-diff-finish buf (when verbose messages)
+ orig-diff-buffer-clone)))
;; In the async case, we return t even if there are no differences
;; because we don't know that yet.
t)))
@@ -1863,13 +1910,10 @@ Return t if the buffer had changes, nil otherwise."
(vc-working-revision first))))
(when (string= rev1-default "") (setq rev1-default nil))))
;; construct argument list
- (let* ((rev1-prompt (if rev1-default
- (concat "Older revision (default "
- rev1-default "): ")
- "Older revision: "))
- (rev2-prompt (concat "Newer revision (default "
- ;; (or rev2-default
- "current source): "))
+ (let* ((rev1-prompt (format-prompt "Older revision" rev1-default))
+ (rev2-prompt (format-prompt "Newer revision"
+ ;; (or rev2-default
+ "current source"))
(rev1 (vc-read-revision rev1-prompt files backend rev1-default))
(rev2 (vc-read-revision rev2-prompt files backend nil))) ;; rev2-default
(when (string= rev1 "") (setq rev1 nil))
@@ -2082,7 +2126,7 @@ If `F.~REV~' already exists, use it instead of checking it out again."
(with-current-buffer (or (buffer-base-buffer) (current-buffer))
(vc-ensure-vc-buffer)
(list
- (vc-read-revision "Revision to visit (default is working revision): "
+ (vc-read-revision (format-prompt "Revision to visit" "working revision")
(list buffer-file-name)))))
(set-buffer (or (buffer-base-buffer) (current-buffer)))
(vc-ensure-vc-buffer)
@@ -2378,7 +2422,7 @@ This function runs the hook `vc-retrieve-tag-hook' when finished."
(read-directory-name "Directory: " default-directory nil t))))
(list
dir
- (vc-read-revision "Tag name to retrieve (default latest revisions): "
+ (vc-read-revision (format-prompt "Tag name to retrieve" "latest revisions")
(list dir)
(vc-responsible-backend dir)))))
(let* ((backend (vc-responsible-backend dir))
@@ -2486,6 +2530,10 @@ earlier revisions. Show up to LIMIT entries (non-nil means unlimited)."
(put 'vc-log-view-type 'permanent-local t)
(defvar vc-sentinel-movepoint)
+(defvar vc-log-finish-functions '(vc-shrink-buffer-window)
+ "Functions run at the end of the log command.
+Each function runs in the log output buffer without args.")
+
(defun vc-log-internal-common (backend
buffer-name
files
@@ -2517,11 +2565,11 @@ earlier revisions. Show up to LIMIT entries (non-nil means unlimited)."
(vc-run-delayed
(let ((inhibit-read-only t))
(funcall setup-buttons-func backend files retval)
- (shrink-window-if-larger-than-buffer)
(when goto-location-func
(funcall goto-location-func backend)
(setq vc-sentinel-movepoint (point)))
- (set-buffer-modified-p nil)))))
+ (set-buffer-modified-p nil)
+ (run-hooks 'vc-log-finish-functions)))))
(defun vc-incoming-outgoing-internal (backend remote-location buffer-name type)
(vc-log-internal-common
@@ -2743,7 +2791,7 @@ to the working revision (except for keyword expansion)."
(unwind-protect
(when (if vc-revert-show-diff
(progn
- (setq diff-buffer (generate-new-buffer-name "*vc-diff*"))
+ (setq diff-buffer (generate-new-buffer "*vc-diff*"))
(vc-diff-internal vc-allow-async-revert vc-fileset
nil nil nil diff-buffer))
;; Avoid querying the user again.
generated by cgit v1.2.3 (git 2.39.1) at 2025-05-05 13:46:26 +0000