diff options
Diffstat (limited to 'lisp/vc')
36 files changed, 780 insertions, 937 deletions
diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el index 8b55a78f84d..e02d84f1f56 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. @@ -790,10 +789,9 @@ Optional arg BUFFER-FILE overrides `buffer-file-name'." If a ChangeLog file does not already exist, a non-nil value means to put log entries in a suitably named buffer." :type 'boolean + :safe #'booleanp :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 @@ -1069,8 +1067,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/compare-w.el b/lisp/vc/compare-w.el index b56b4c0d83a..64d5d1081a3 100644 --- a/lisp/vc/compare-w.el +++ b/lisp/vc/compare-w.el @@ -1,7 +1,6 @@ ;;; compare-w.el --- compare text between windows for Emacs -*- lexical-binding: t; -*- -;; Copyright (C) 1986, 1989, 1993, 1997, 2001-2022 Free Software -;; Foundation, Inc. +;; Copyright (C) 1986-2022 Free Software Foundation, Inc. ;; Maintainer: emacs-devel@gnu.org ;; Keywords: convenience files vc @@ -99,7 +98,7 @@ may fail by finding the wrong match. The bigger number makes difference regions more coarse-grained. The default value 32 is good for the most cases." - :type 'integer + :type 'natnum :version "22.1") (defcustom compare-windows-recenter nil 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 f366261ae05..aa426446d73 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") @@ -146,6 +147,12 @@ and hunk-based syntax highlighting otherwise as a fallback." (const :tag "Highlight syntax" t) (const :tag "Allow hunk-based fallback" hunk-also))) +(defcustom diff-whitespace-style '(face trailing) + "Specify `whitespace-style' variable for `diff-mode' buffers." + :require 'whitespace + :type (get 'whitespace-style 'custom-type) + :version "29.1") + (defvar diff-vc-backend nil "The VC backend that created the current Diff buffer, if any.") @@ -162,57 +169,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 +272,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 +900,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 @@ -1473,6 +1482,14 @@ See `after-change-functions' for the meaning of BEG, END and LEN." ;; Added when diff--font-lock-prettify is non-nil! (cl-pushnew 'display font-lock-extra-managed-props))) +(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)))) + (defvar whitespace-style) (defvar whitespace-trailing-regexp) @@ -1494,7 +1511,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 +1530,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 +1555,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 @@ -1566,7 +1578,7 @@ a diff with \\[diff-reverse-direction]. This sets `whitespace-style' and `whitespace-trailing-regexp' so that Whitespace mode shows trailing whitespace problems on the modified lines of the diff." - (setq-local whitespace-style '(face trailing)) + (setq-local whitespace-style diff-whitespace-style) (let ((style (save-excursion (goto-char (point-min)) ;; FIXME: For buffers filled from async processes, this search @@ -1579,6 +1591,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 +2278,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." @@ -2576,40 +2606,103 @@ fixed, visit it in a buffer." (defun diff--font-lock-prettify (limit) (when diff-font-lock-prettify - (save-excursion - ;; FIXME: Include the first space for context-style hunks! - (while (re-search-forward "^[-+! ]" limit t) - (let ((spec (alist-get (char-before) - '((?+ . (left-fringe diff-fringe-add diff-indicator-added)) - (?- . (left-fringe diff-fringe-del diff-indicator-removed)) - (?! . (left-fringe diff-fringe-rep diff-indicator-changed)) - (?\s . (left-fringe diff-fringe-nul fringe)))))) - (put-text-property (match-beginning 0) (match-end 0) 'display spec)))) + (when (> (frame-parameter nil 'left-fringe) 0) + (save-excursion + ;; FIXME: Include the first space for context-style hunks! + (while (re-search-forward "^[-+! ]" limit t) + (unless (eq (get-text-property (match-beginning 0) 'face) + 'diff-header) + (put-text-property + (match-beginning 0) (match-end 0) + 'display + (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))))))))) ;; 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" + "\\(?:" + ;; For new/deleted files, there might be no + ;; header (and no hunk) if the file is/was empty. + "\\(?3:new\\(?6:\\)\\|deleted\\) file mode \\(?10:[0-7]\\{6\\}\\)\n" + index horb + ;; Normal case. There might be no header + ;; (and no hunk) if only the file mode + ;; changed. + "\\|" + "\\(?:old mode \\(?8:[0-7]\\{6\\}\\)\n\\)?" + "\\(?:new mode \\(?9:[0-7]\\{6\\}\\)\n\\)?" + 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 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) + (not (match-beginning 3))) + " empty"))) + (filemode + (cond + ((match-beginning 10) + (concat " file with mode " (match-string 10) " ")) + ((and (match-beginning 8) (match-beginning 9)) + (concat " file (mode changed from " + (match-string 8) " to " (match-string 9) ") ")) + (t " file ")))) + (add-text-properties + (match-beginning 0) (1- (match-end 0)) + (list 'display + (propertize + (cond + ((match-beginning 3) + (concat (capitalize (match-string 3)) kind filemode + (if (match-beginning 6) newfile oldfile))) + ((and (null (match-string 4)) (match-string 5)) + (concat "New " kind filemode newfile)) + ((null (match-string 2)) + ;; We used to use + ;; (concat "Deleted" kind filemode oldfile) + ;; here but that misfires for `diff-buffers' + ;; (see 24 Jun 2022 message in bug#54034). + ;; AFAIK if (match-string 2) is nil then so is + ;; (match-string 1), so "Deleted" doesn't sound right, + ;; so better just let the header in plain sight for now. + ;; FIXME: `diff-buffers' should maybe try to better + ;; mimic Git's format with "a/" and "b/" so prettification + ;; can "just work!" + nil) + (t + (concat "Modified" kind filemode oldfile))) + 'face '(diff-file-header diff-header)) + 'font-lock-multiline t)))))) nil) ;;; Syntax highlighting from font-lock @@ -2654,7 +2747,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..3e35a3329b1 100644 --- a/lisp/vc/diff.el +++ b/lisp/vc/diff.el @@ -52,6 +52,12 @@ set (`vc-git-diff-switches' for git, for instance), and "The command to use to run diff." :type 'string) +(defcustom diff-entire-buffers t + "If non-nil, diff the entire buffers, not just the visible part. +If nil, only use the narrowed-to parts of the buffers." + :type 'boolean + :version "29.1") + ;; prompt if prefix arg present (defun diff-switches () (if current-prefix-arg @@ -96,15 +102,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))) @@ -119,7 +125,9 @@ temporary file with the buffer's contents." (if (bufferp file-or-buf) (with-current-buffer file-or-buf (let ((tempfile (make-temp-file "buffer-content-"))) - (write-region nil nil tempfile nil 'nomessage) + (if diff-entire-buffers + (write-region nil nil tempfile nil 'nomessage) + (write-region (point-min) (point-max) tempfile nil 'nomessage)) tempfile)) (file-local-copy file-or-buf))) @@ -145,7 +153,7 @@ Possible values are: ;; Noninteractive helper for creating and reverting diff buffers "Compare the OLD and NEW file/buffer. If the optional SWITCHES is nil, the switches specified in the -variable ‘diff-switches’ are passed to the diff command, +variable `diff-switches' are passed to the diff command, otherwise SWITCHES is used. SWITCHES can be a string or a list of strings. @@ -274,7 +282,9 @@ interactively for diff switches. Otherwise, the switches specified in the variable `diff-switches' are passed to the diff command. -OLD and NEW may each be a buffer or a buffer name." +OLD and NEW may each be a buffer or a buffer name. + +Also see the `diff-entire-buffers' variable." (interactive (let ((newb (read-buffer "Diff new buffer" (current-buffer) t)) (oldb (read-buffer "Diff original buffer" 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..42fbde21659 100644 --- a/lisp/vc/ediff-help.el +++ b/lisp/vc/ediff-help.el @@ -152,7 +152,7 @@ the value of this variable and the variables `ediff-help-message-*' in ;; the keymap that defines clicks over the quick help regions -(defvar ediff-help-region-map (make-sparse-keymap)) +(defvar-keymap ediff-help-region-map) (define-key ediff-help-region-map [mouse-2] #'ediff-help-for-quick-help) @@ -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-hook.el b/lisp/vc/ediff-hook.el index cee376de302..0160d9f6848 100644 --- a/lisp/vc/ediff-hook.el +++ b/lisp/vc/ediff-hook.el @@ -50,12 +50,12 @@ (make-sparse-keymap "Ediff Miscellanea")) (fset 'menu-bar-ediff-misc-menu menu-bar-ediff-misc-menu) -(defvar menu-bar-epatch-menu (make-sparse-keymap "Apply Patch")) +(defvar-keymap menu-bar-epatch-menu :name "Apply Patch") (fset 'menu-bar-epatch-menu menu-bar-epatch-menu) -(defvar menu-bar-ediff-merge-menu (make-sparse-keymap "Merge")) +(defvar-keymap menu-bar-ediff-merge-menu :name "Merge") (fset 'menu-bar-ediff-merge-menu menu-bar-ediff-merge-menu) -(defvar menu-bar-ediff-menu (make-sparse-keymap "Compare")) +(defvar-keymap menu-bar-ediff-menu :name "Compare") (fset 'menu-bar-ediff-menu menu-bar-ediff-menu) ;; define ediff compare menu diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el index 896773067b7..273bad5d353 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) @@ -955,9 +955,9 @@ this variable represents.") (((class color)) (:foreground "red3" :background "green")) (t (:underline t :stipple "gray3"))) - "Face for highlighting the refinement of the selected diff in the ancestor buffer. -At present, this face is not used and no fine differences are computed for the -ancestor buffer." + "Face for highlighting refinement of the selected diff in the ancestor buffer. +At present, this face is not used and no fine differences are +computed for the ancestor buffer." :group 'ediff-highlighting) ;; An internal variable. Ediff takes the face from here. When unhighlighting, ;; this variable is set to nil, then again to the appropriate face. @@ -1055,7 +1055,7 @@ this variable represents.") (:foreground "cyan3" :background "light grey" :weight bold :extend t)) (t (:italic t :stipple ,stipple-pixmap :extend t))) - "Face for highlighting even-numbered non-current differences in the ancestor buffer." + "Face for highlighting even-numbered non-current differences in ancestor buffer." :group 'ediff-highlighting) ;; An internal variable. Ediff takes the face from here. When unhighlighting, ;; this variable is set to nil, then again to the appropriate face. @@ -1146,7 +1146,7 @@ this variable represents.") (((class color)) (:foreground "green3" :background "black" :weight bold :extend t)) (t (:italic t :stipple "gray1" :extend t))) - "Face for highlighting odd-numbered non-current differences in the ancestor buffer." + "Face for highlighting odd-numbered non-current differences in ancestor buffer." :group 'ediff-highlighting) ;; An internal variable. Ediff takes the face from here. When unhighlighting, ;; this variable is set to nil, then again to the appropriate face. diff --git a/lisp/vc/ediff-merg.el b/lisp/vc/ediff-merg.el index de8c587b1ca..aae6ad549ea 100644 --- a/lisp/vc/ediff-merg.el +++ b/lisp/vc/ediff-merg.el @@ -54,7 +54,7 @@ Valid values are the symbols `default-A', `default-B', and `combined'." The value must be a list of the form \(STRING1 bufspec1 STRING2 bufspec2 STRING3 bufspec3 STRING4) where bufspec is the symbol A, B, or Ancestor. For instance, if the value is -'(STRING1 A STRING2 Ancestor STRING3 B STRING4) then the +`(STRING1 A STRING2 Ancestor STRING3 B STRING4)' then the combined text will look like this: STRING1 diff --git a/lisp/vc/ediff-mult.el b/lisp/vc/ediff-mult.el index 48716901116..b7c349fc1cd 100644 --- a/lisp/vc/ediff-mult.el +++ b/lisp/vc/ediff-mult.el @@ -128,7 +128,7 @@ (defconst ediff-meta-buffer-verbose-message "Ediff Session Group Panel: %s Useful commands (type ? to hide them and free up screen): - button2, v, or RET over session record: start that Ediff session + mouse-2, v, or RET over session record: start that Ediff session M:\tin sessions invoked from here, brings back this group panel R:\tdisplay the registry of active Ediff sessions h:\tmark session for hiding (toggle) @@ -1236,7 +1236,7 @@ behavior." (insert "\t\t*** Directory Differences ***\n") (insert " Useful commands: - C,button2: over file name -- copy this file to directory that doesn't have it + C,mouse-2: over file name -- copy this file to directory that doesn't have it q: hide this buffer n,SPC: next line p,DEL: previous line\n\n") @@ -1429,7 +1429,7 @@ Useful commands: This is a registry of all active Ediff sessions. Useful commands: - button2, `v', RET over a session record: switch to that session + mouse-2, `v', RET over a session record: switch to that session M over a session record: display the associated session group R in any Ediff session: display session registry n,SPC: next session 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..040a9a63c5a 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 @@ -3435,6 +3431,9 @@ Without an argument, it saves customized diff argument, if available )) (defun ediff-show-diff-output (arg) + "With prefix argument ARG, show plain diff output. +Without an argument, save the customized diff argument, if available +(and plain output, if customized output was not generated)." (interactive "P") (ediff-barf-if-not-control-buffer) (ediff-compute-custom-diffs-maybe) @@ -3442,7 +3441,10 @@ Without an argument, it saves customized diff argument, if available (ediff-skip-unsuitable-frames ' ok-unsplittable)) (let ((buf (cond ((and arg (ediff-buffer-live-p ediff-diff-buffer)) ediff-diff-buffer) - ((ediff-buffer-live-p ediff-custom-diff-buffer) + ((and (ediff-buffer-live-p ediff-custom-diff-buffer) + ;; We may not have gotten a custom output if + ;; we're working on unsaved buffers. + (> (buffer-size ediff-custom-diff-buffer) 0)) ediff-custom-diff-buffer) ((ediff-buffer-live-p ediff-diff-buffer) ediff-diff-buffer) diff --git a/lisp/vc/ediff-wind.el b/lisp/vc/ediff-wind.el index 1e702edb419..6db3667545e 100644 --- a/lisp/vc/ediff-wind.el +++ b/lisp/vc/ediff-wind.el @@ -1135,7 +1135,8 @@ It assumes that it is called from within the control buffer." (setq mode-line-format (if (ediff-narrow-control-frame-p) (list " " mode-line-buffer-identification) - (list "-- " mode-line-buffer-identification " Quick Help"))) + (list "-- " mode-line-buffer-identification + (list 'ediff-use-long-help-message " Quick Help")))) ;; control buffer id (setq mode-line-buffer-identification (if (ediff-narrow-control-frame-p) @@ -1213,18 +1214,20 @@ It assumes that it is called from within the control buffer." ediff-control-buffer-suffix)) (defun ediff-make-wide-control-buffer-id () - (cond ((< ediff-current-difference 0) - (list (format "%%b At start of %d diffs" - ediff-number-of-differences))) - ((>= ediff-current-difference ediff-number-of-differences) - (list (format "%%b At end of %d diffs" - ediff-number-of-differences))) - (t - (list (format "%%b diff %d of %d" - (1+ ediff-current-difference) - ediff-number-of-differences))))) - - + (list + (concat "%b " + (propertize + (cond ((< ediff-current-difference 0) + (format "At start of %d diffs" + ediff-number-of-differences)) + ((>= ediff-current-difference ediff-number-of-differences) + (format "At end of %d diffs" + ediff-number-of-differences)) + (t + (format "diff %d of %d" + (1+ ediff-current-difference) + ediff-number-of-differences))) + 'face 'mode-line-buffer-id)))) ;; If buff is not live, return nil (defun ediff-get-visible-buffer-window (buff) 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/emerge.el b/lisp/vc/emerge.el index b2fdb07d5fb..422ed5c0a4d 100644 --- a/lisp/vc/emerge.el +++ b/lisp/vc/emerge.el @@ -221,7 +221,7 @@ depend on the flags." (defcustom emerge-min-visible-lines 3 "Number of lines to show above and below the flags when displaying a difference." - :type 'integer) + :type 'natnum) (defcustom emerge-temp-file-prefix (expand-file-name "emerge" temporary-file-directory) @@ -1647,7 +1647,7 @@ the height of the merge window. (defun emerge-scroll-left (&optional arg) "Scroll left all three merge buffers, if they are in windows. If an argument is given, that is how many columns are scrolled, else nearly -the width of the A and B windows. `C-u -' alone as argument scrolls half the +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 @@ -1675,7 +1675,7 @@ width of the A and B windows." (defun emerge-scroll-right (&optional arg) "Scroll right all three merge buffers, if they are in windows. If an argument is given, that is how many columns are scrolled, else nearly -the width of the A and B windows. `C-u -' alone as argument scrolls half the +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 diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index c2000c7eec3..e958673fea8 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'." @@ -712,10 +710,14 @@ different header separator appropriate for `log-edit-mode'." (interactive) (when (or (called-interactively-p 'interactive) (log-edit-empty-buffer-p)) - (insert "Summary: ") - (when log-edit-setup-add-author - (insert "\nAuthor: ")) - (insert "\n\n") + (dolist (header (append '("Summary") (and log-edit-setup-add-author + '("Author")))) + ;; Make `C-a' work like in other buffers with header names. + (insert (propertize (concat header ": ") + 'field 'header + 'rear-nonsticky t) + "\n")) + (insert "\n") (message-position-point))) (defun log-edit-insert-cvs-template () diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el index bb2f49a7b65..415b1564eda 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,19 @@ :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) (easy-menu-define log-view-mode-menu log-view-mode-map "Log-View Display Menu." @@ -181,9 +162,15 @@ ["Previous Log Entry" log-view-msg-prev :help "Go to the previous count'th log message"] ["Next File" log-view-file-next - :help "Go to the next count'th file"] + :help "Go to the next count'th file" + :active (derived-mode-p vc-cvs-log-view-mode + vc-rcs-log-view-mode + vc-sccs-log-view-mode)] ["Previous File" log-view-file-prev - :help "Go to the previous count'th file"])) + :help "Go to the previous count'th file" + :active (derived-mode-p vc-cvs-log-view-mode + vc-rcs-log-view-mode + vc-sccs-log-view-mode)])) (defvar log-view-mode-hook nil "Hook run at the end of `log-view-mode'.") 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..1f19c4cfe26 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" @@ -451,7 +451,8 @@ should be applied to the background or to the foreground." (setq-local vc-annotate-backend backend) (setq-local vc-annotate-parent-file file) (setq-local vc-annotate-parent-rev rev) - (setq-local vc-annotate-parent-display-mode display-mode)))) + (setq-local vc-annotate-parent-display-mode display-mode) + (kill-local-variable 'revert-buffer-function)))) (with-current-buffer temp-buffer-name (vc-run-delayed diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index ee394a93af4..072bd72b441 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -64,9 +64,13 @@ :version "22.2" :group 'vc) -(defcustom vc-bzr-program "bzr" +(defcustom vc-bzr-program + (or (executable-find "bzr") + (executable-find "brz") + "bzr") "Name of the bzr command (excluding any arguments)." - :type 'string) + :type 'string + :version "29.1") (defcustom vc-bzr-diff-switches nil "String or list of strings specifying switches for bzr diff under VC. diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el index 8f06d5a847a..1f81ff2e0fe 100644 --- a/lisp/vc/vc-cvs.el +++ b/lisp/vc/vc-cvs.el @@ -26,6 +26,7 @@ (require 'vc-rcs) (eval-when-compile (require 'vc)) +(require 'log-view) (declare-function vc-checkout "vc" (file &optional rev)) (declare-function vc-expand-dirs "vc" (file-or-dir-list backend)) @@ -1257,6 +1258,14 @@ ignore file." (if sort (sort-lines nil (point-min) (point-max))) (save-buffer))))) +(defvar-keymap vc-cvs-log-view-mode-map + "N" #'log-view-file-next + "P" #'log-view-file-prev + "M-n" #'log-view-file-next + "M-p" #'log-view-file-prev) + +(define-derived-mode vc-cvs-log-view-mode log-view-mode "CVS-Log-View") + (provide 'vc-cvs) ;;; vc-cvs.el ends here diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index 9cf6422de00..9335da10065 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -325,6 +325,7 @@ See `run-hooks'." (define-key map "U" #'vc-dir-unmark-all-files) (define-key map "\C-?" #'vc-dir-unmark-file-up) (define-key map "\M-\C-?" #'vc-dir-unmark-all-files) + (define-key map "%" #'vc-dir-mark-by-regexp) ;; Movement. (define-key map "n" #'vc-dir-next-line) (define-key map " " #'vc-dir-next-line) @@ -750,6 +751,23 @@ share the same state." (vc-dir-mark-file crt))) (setq crt (ewoc-next vc-ewoc crt)))))))) +(defun vc-dir-mark-by-regexp (regexp &optional unmark) + "Mark all files that match REGEXP. +If UNMARK (interactively, the prefix), unmark instead." + (interactive "sMark files matching: \nP") + (ewoc-map + (lambda (filearg) + (when (and (not (vc-dir-fileinfo->directory filearg)) + (eq (not unmark) + (not (vc-dir-fileinfo->marked filearg))) + ;; We don't want to match on the part of the file + ;; that's above the current directory. + (string-match-p regexp (file-relative-name + (vc-dir-fileinfo->name filearg)))) + (setf (vc-dir-fileinfo->marked filearg) (not unmark)) + t)) + vc-ewoc)) + (defun vc-dir-mark-files (mark-files) "Mark files specified by file names in the argument MARK-FILES. MARK-FILES should be a list of absolute filenames." @@ -1433,7 +1451,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 @@ -1539,9 +1562,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) @@ -1561,6 +1583,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..e2a490092b5 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 @@ -629,23 +636,23 @@ NOT-URGENT means it is ok to continue if the user says not to save." (and (local-variable-p 'vc-log-fileset) (not (equal vc-log-fileset fileset)))) `((log-edit-listfun - . (lambda () - ;; FIXME: When fileset includes directories, and - ;; there are relevant ChangeLog files inside their - ;; children, we don't find them. Either handle it - ;; in `log-edit-insert-changelog-entries' by - ;; walking down the file trees, or somehow pass - ;; `fileset-only-files' from `vc-next-action' - ;; through to this function. - (let ((root (vc-root-dir))) - ;; Returns paths relative to the root, so that - ;; `log-edit-changelog-insert-entries' - ;; substitutes them in correctly later, even when - ;; `vc-checkin' was called from a file buffer, or - ;; a non-root VC-Dir buffer. - (mapcar - (lambda (file) (file-relative-name file root)) - ',fileset)))) + . ,(lambda () + ;; FIXME: When fileset includes directories, and + ;; there are relevant ChangeLog files inside their + ;; children, we don't find them. Either handle it + ;; in `log-edit-insert-changelog-entries' by + ;; walking down the file trees, or somehow pass + ;; `fileset-only-files' from `vc-next-action' + ;; through to this function. + (let ((root (vc-root-dir))) + ;; Returns paths relative to the root, so that + ;; `log-edit-changelog-insert-entries' + ;; substitutes them in correctly later, even when + ;; `vc-checkin' was called from a file buffer, or + ;; a non-root VC-Dir buffer. + (mapcar + (lambda (file) (file-relative-name file root)) + fileset)))) (log-edit-diff-function . vc-diff) (log-edit-vc-backend . ,backend) (vc-log-fileset . ,fileset)) @@ -754,8 +761,7 @@ the buffer contents as a comment." ;; (while (and (not member) fileset) ;; (let ((elem (pop fileset))) ;; (if (if (file-directory-p elem) -;; (eq t (compare-strings buffer-file-name nil (length elem) -;; elem nil nil)) +;; (string-prefix-p elem buffer-file-name) ;; (eq (current-buffer) (get-file-buffer elem))) ;; (setq member t)))) ;; member)) diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 7072b8e483b..8937454d111 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) @@ -1597,7 +1599,7 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"." (declare-function grep-read-regexp "grep" ()) (declare-function grep-read-files "grep" (regexp)) (declare-function grep-expand-template "grep" - (template &optional regexp files dir excl)) + (template &optional regexp files dir excl more-opts)) (defvar compilation-environment) ;; Derived from `lgrep'. @@ -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..80508570f32 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -99,7 +99,7 @@ interpreted as hostnames." :type 'regexp :group 'vc) -(defcustom vc-handled-backends '(RCS CVS SVN SCCS SRC Bzr Git Hg Mtn) +(defcustom vc-handled-backends '(RCS CVS SVN SCCS SRC Bzr Git Hg) ;; RCS, CVS, SVN, SCCS, and SRC come first because they are per-dir ;; rather than per-tree. RCS comes first because of the multibackend ;; support intended to use RCS for local commits (with a remote CVS server). @@ -141,7 +141,8 @@ confirmation whether it should follow the link. If nil, the link is visited and a warning displayed." :type '(choice (const :tag "Ask for confirmation" ask) (const :tag "Visit link and warn" nil) - (const :tag "Follow link" t)) + (const :tag "Follow link" t)) + :safe #'null :group 'vc) (defcustom vc-display-status t @@ -555,15 +556,6 @@ this function." templates)))) -;; toggle-read-only is obsolete since 24.3, but since vc-t-r-o was made -;; obsolete earlier, it is ok for the latter to be an alias to the former, -;; since the latter will be removed first. We can't just make it -;; an alias for read-only-mode, since that is not 100% the same. -(defalias 'vc-toggle-read-only 'toggle-read-only) -(make-obsolete 'vc-toggle-read-only - "use `read-only-mode' instead (or `toggle-read-only' in older versions of Emacs)." - "24.1") - (defun vc-default-make-version-backups-p (_backend _file) "Return non-nil if unmodified versions should be backed up locally. The default is to switch off this feature." @@ -798,9 +790,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 +857,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) @@ -963,7 +957,7 @@ In the latter case, VC mode is deactivated for this buffer." (defalias 'vc-menu-map vc-menu-map) -(declare-function vc-responsible-backend "vc" (file)) +(declare-function vc-responsible-backend "vc" (file &optional no-error)) (defun vc-menu-map-filter (orig-binding) (if (and (symbolp orig-binding) (fboundp orig-binding)) diff --git a/lisp/vc/vc-mtn.el b/lisp/vc/vc-mtn.el deleted file mode 100644 index 20fbf92bb12..00000000000 --- a/lisp/vc/vc-mtn.el +++ /dev/null @@ -1,380 +0,0 @@ -;;; vc-mtn.el --- VC backend for Monotone -*- lexical-binding: t -*- - -;; Copyright (C) 2007-2022 Free Software Foundation, Inc. - -;; Author: Stefan Monnier <monnier@iro.umontreal.ca> -;; Keywords: vc -;; Package: vc - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: - -;; - -;;; TODO: - -;; - The `previous-version' VC method needs to be supported, 'D' in -;; log-view-mode uses it. - -;;; Code: - -(eval-when-compile (require 'vc)) - -(defgroup vc-mtn nil - "VC Monotone (mtn) backend." - :version "24.1" - :group 'vc) - -(defcustom vc-mtn-diff-switches t - "String or list of strings specifying switches for monotone diff under VC. -If nil, use the value of `vc-diff-switches'. If t, use no switches." - :type '(choice (const :tag "Unspecified" nil) - (const :tag "None" t) - (string :tag "Argument String") - (repeat :tag "Argument List" :value ("") string)) - :version "23.1") - -(defcustom vc-mtn-annotate-switches nil - "String or list of strings specifying switches for mtn annotate under VC. -If nil, use the value of `vc-annotate-switches'. If t, use no -switches." - :type '(choice (const :tag "Unspecified" nil) - (const :tag "None" t) - (string :tag "Argument String") - (repeat :tag "Argument List" :value ("") string)) - :version "25.1") - -(defcustom vc-mtn-program "mtn" - "Name of the monotone executable." - :type 'string) - -;; Clear up the cache to force vc-call to check again and discover -;; new functions when we reload this file. -(put 'Mtn 'vc-functions nil) - -(unless (executable-find vc-mtn-program) - ;; vc-mtn.el is 100% non-functional without the `mtn' executable. - (setq vc-handled-backends (delq 'Mtn vc-handled-backends))) - -;;;###autoload -(defconst vc-mtn-admin-dir "_MTN" "Name of the monotone directory.") -;;;###autoload -(defconst vc-mtn-admin-format (concat vc-mtn-admin-dir "/format") - "Name of the monotone directory's format file.") - -;;;###autoload (defun vc-mtn-registered (file) -;;;###autoload (if (vc-find-root file vc-mtn-admin-format) -;;;###autoload (progn -;;;###autoload (load "vc-mtn" nil t) -;;;###autoload (vc-mtn-registered file)))) - -(defun vc-mtn-revision-granularity () 'repository) -(defun vc-mtn-checkout-model (_files) 'implicit) - -(defun vc-mtn-root (file) - (setq file (expand-file-name file) - file (if (file-directory-p file) - (file-name-as-directory file) - (file-name-directory file))) - (or (vc-file-getprop file 'vc-mtn-root) - (vc-file-setprop file 'vc-mtn-root - (vc-find-root file vc-mtn-admin-format)))) - -(defun vc-mtn-find-admin-dir (file) - "Return the administrative directory of FILE." - (expand-file-name vc-mtn-admin-dir (vc-mtn-root file))) - -(defun vc-mtn-find-ignore-file (file) - "Return the mtn ignore file that controls FILE." - (expand-file-name ".mtnignore" (vc-mtn-root file))) - -(defun vc-mtn-registered (file) - (let ((root (vc-mtn-root file))) - (when root - (vc-mtn-state file)))) - -(defun vc-mtn-command (buffer okstatus files &rest flags) - "A wrapper around `vc-do-command' for use in vc-mtn.el." - (let ((process-environment - ;; Avoid localization of messages so we can parse the output. - (cons "LC_MESSAGES=C" process-environment))) - (apply #'vc-do-command (or buffer "*vc*") okstatus vc-mtn-program - files flags))) - -(defun vc-mtn-state (file) - ;; If `mtn' fails or returns status>0, or if the search files, just - ;; return nil. - (ignore-errors - (with-temp-buffer - (vc-mtn-command t 0 file "status") - (goto-char (point-min)) - (re-search-forward - "^ \\(?:\\(patched\\)\\|\\(added\\) \\(?:.*\\)\\)\\|no changes$") - (cond ((match-end 1) 'edited) - ((match-end 2) 'added) - (t 'up-to-date))))) - -(defun vc-mtn-after-dir-status (update-function) - (let (result) - (goto-char (point-min)) - (re-search-forward "\\(?:Current b\\|B\\)ranch: *\\(.*\\)\n?\nChanges against parent \\(.*\\)" nil t) - (while (re-search-forward - "^ \\(?:\\(patched \\)\\|\\(added \\)\\)\\(.*\\)$" nil t) - (cond ((match-end 1) (push (list (match-string 3) 'edited) result)) - ((match-end 2) (push (list (match-string 3) 'added) result)))) - (funcall update-function result))) - -;; dir-status-files called from vc-dir, which loads vc, -;; which loads vc-dispatcher. -(declare-function vc-exec-after "vc-dispatcher" (code)) - -(defun vc-mtn-dir-status-files (dir _files update-function) - (vc-mtn-command (current-buffer) 'async dir "status") - (vc-run-delayed - (vc-mtn-after-dir-status update-function))) - -(defun vc-mtn-working-revision (file) - ;; If `mtn' fails or returns status>0, or if the search fails, just - ;; return nil. - (ignore-errors - (with-temp-buffer - (vc-mtn-command t 0 file "status") - (goto-char (point-min)) - (re-search-forward "\\(?:Current b\\|B\\)ranch: *\\(.*\\)\n?\nChanges against parent \\(.*\\)") - (match-string 2)))) - -(defun vc-mtn-workfile-branch (file) - ;; If `mtn' fails or returns status>0, or if the search files, just - ;; return nil. - (ignore-errors - (with-temp-buffer - (vc-mtn-command t 0 file "status") - (goto-char (point-min)) - (re-search-forward "\\(?:Current b\\|B\\)ranch: *\\(.*\\)\n?\nChanges against parent \\(.*\\)") - (match-string 1)))) - -;; Mode-line rewrite code copied from vc-arch.el. - -(defcustom vc-mtn-mode-line-rewrite - '(("\\`[^:/#]*[:/#]" . "")) ;Drop the host part. - "Rewrite rules to shorten Mtn's revision names on the mode-line." - :type '(repeat (cons regexp string)) - :version "22.2") - -(defun vc-mtn-mode-line-string (file) - "Return a string for `vc-mode-line' to put in the mode line for FILE." - (let ((branch (vc-mtn-workfile-branch file))) - (if branch - (progn - (dolist (rule vc-mtn-mode-line-rewrite) - (if (string-match (car rule) branch) - (setq branch (replace-match (cdr rule) t nil branch)))) - (format "Mtn%c%s" - (pcase (vc-state file) - ((or 'up-to-date 'needs-update) ?-) - ('added ?@) - (_ ?:)) - branch)) - ""))) - -(defun vc-mtn-register (files &optional _comment) - (vc-mtn-command nil 0 files "add")) - -(defun vc-mtn-responsible-p (file) (vc-mtn-root file)) - -(declare-function log-edit-extract-headers "log-edit" (headers string)) - -(defun vc-mtn-checkin (files comment &optional _rev) - (apply #'vc-mtn-command nil 0 files - (nconc (list "commit" "-m") - (log-edit-extract-headers '(("Author" . "--author") - ("Date" . "--date")) - comment)))) - -(defun vc-mtn-find-revision (file rev buffer) - ;; null rev means latest revision - (if rev - (vc-mtn-command buffer 0 file "cat" "-r" rev) - (vc-mtn-command buffer 0 file "cat"))) - -;; (defun vc-mtn-checkout (file &optional rev) -;; ) - -(defun vc-mtn-revert (file &optional contents-done) - (unless contents-done - (vc-mtn-command nil 0 file "revert"))) - -(defun vc-mtn-print-log (files buffer &optional _shortlog start-revision limit) - "Print commit logs associated with FILES into specified BUFFER. -_SHORTLOG is ignored. -If START-REVISION is non-nil, it is the newest revision to show. -If LIMIT is non-nil, show no more than this many entries." - (apply #'vc-mtn-command buffer 0 files "log" - (append - (when start-revision (list "--from" (format "%s" start-revision))) - (when limit (list "--last" (format "%s" limit)))))) - -(defvar log-view-message-re) -(defvar log-view-file-re) -(defvar log-view-font-lock-keywords) -(defvar log-view-per-file-logs) - -(define-derived-mode vc-mtn-log-view-mode log-view-mode "Mtn-Log-View" - ;; Don't match anything. - (setq-local log-view-file-re regexp-unmatchable) - (setq-local log-view-per-file-logs nil) - ;; TODO: Use a more precise regexp than "[ |/]+" to avoid false positives - ;; in the ChangeLog text. - (setq-local log-view-message-re - "^[ |/]+Revision: \\([0-9a-f]+\\)") - (require 'add-log) ;For change-log faces. - (setq-local log-view-font-lock-keywords - (append log-view-font-lock-keywords - '(("^[ |]+Author: \\(.*\\)" (1 'change-log-email)) - ("^[ |]+Date: \\(.*\\)" (1 'change-log-date)))))) - -;; (defun vc-mtn-show-log-entry (revision) -;; ) - -(autoload 'vc-switches "vc") - -(defun vc-mtn-diff (files &optional rev1 rev2 buffer _async) - "Get a difference report using monotone between two revisions of FILES." - (apply #'vc-mtn-command (or buffer "*vc-diff*") - 1 ; bug#21969 - files "diff" - (append - (vc-switches 'mtn 'diff) - (if rev1 (list "-r" rev1)) (if rev2 (list "-r" rev2))))) - -(defun vc-mtn-annotate-command (file buf &optional rev) - (apply #'vc-mtn-command buf 'async file "annotate" - (append (vc-switches 'mtn 'annotate) - (if rev (list "-r" rev))))) - -(declare-function vc-annotate-convert-time "vc-annotate" (&optional time)) - -(defconst vc-mtn-annotate-full-re - "^ *\\([0-9a-f]+\\)\\.* by [^ ]+ \\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\): ") -(defconst vc-mtn-annotate-any-re - (concat "^\\(?: +: \\|" vc-mtn-annotate-full-re "\\)")) - -(defun vc-mtn-annotate-time () - (when (looking-at vc-mtn-annotate-any-re) - (goto-char (match-end 0)) - (let ((year (match-string 2))) - (if (not year) - ;; Look for the date on a previous line. - (save-excursion - (get-text-property (1- (previous-single-property-change - (point) 'vc-mtn-time nil (point-min))) - 'vc-mtn-time)) - (let ((time (vc-annotate-convert-time - (encode-time 0 0 0 - (string-to-number (match-string 4)) - (string-to-number (match-string 3)) - (string-to-number year) - t)))) - (let ((inhibit-read-only t) - (inhibit-modification-hooks t)) - (put-text-property (match-beginning 0) (match-end 0) - 'vc-mtn-time time)) - time))))) - -(defun vc-mtn-annotate-extract-revision-at-line () - (save-excursion - (when (or (looking-at vc-mtn-annotate-full-re) - (re-search-backward vc-mtn-annotate-full-re nil t)) - (match-string 1)))) - -;;; Revision completion. - -(defun vc-mtn-list-tags () - (with-temp-buffer - (vc-mtn-command t 0 nil "list" "tags") - (goto-char (point-min)) - (let ((tags ())) - (while (re-search-forward "^[^ ]+" nil t) - (push (match-string 0) tags)) - tags))) - -(defun vc-mtn-list-branches () - (with-temp-buffer - (vc-mtn-command t 0 nil "list" "branches") - (goto-char (point-min)) - (let ((branches ())) - (while (re-search-forward "^.+" nil t) - (push (match-string 0) branches)) - branches))) - -(defun vc-mtn-list-revision-ids (prefix) - (with-temp-buffer - (vc-mtn-command t 0 nil "complete" "revision" prefix) - (goto-char (point-min)) - (let ((ids ())) - (while (re-search-forward "^.+" nil t) - (push (match-string 0) ids)) - ids))) - -(defun vc-mtn-revision-completion-table (_files) - ;; What about using `files'?!? --Stef - (lambda (string pred action) - (cond - ;; Special chars for composite selectors. - ((string-match ".*[^\\]\\(\\\\\\\\\\)*[/|;(]" string) - (completion-table-with-context (substring string 0 (match-end 0)) - (vc-mtn-revision-completion-table nil) - (substring string (match-end 0)) - pred action)) - ;; "Tag" selectors. - ((string-match "\\`t:" string) - (complete-with-action action - (mapcar (lambda (tag) (concat "t:" tag)) - (vc-mtn-list-tags)) - string pred)) - ;; "Branch" or "Head" selectors. - ((string-match "\\`[hb]:" string) - (let ((prefix (match-string 0 string))) - (complete-with-action action - (mapcar (lambda (tag) (concat prefix tag)) - (vc-mtn-list-branches)) - string pred))) - ;; "ID" selectors. - ((string-match "\\`i:" string) - (complete-with-action action - (mapcar (lambda (tag) (concat "i:" tag)) - (vc-mtn-list-revision-ids - (substring string (match-end 0)))) - string pred)) - (t - (complete-with-action action - '("t:" "b:" "h:" "i:" - ;; Completion not implemented for these. - "c:" "a:" "k:" "d:" "m:" "e:" "l:" "i:" "p:" - ;; These have no arg to complete. - "u:" "w:" - ;; Selector functions. - "difference(" "lca(" "max(" "ancestors(" - "descendants(" "parents(" "children(" - "pick(") - string pred))))) - - - -(provide 'vc-mtn) - -;;; vc-mtn.el ends here diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el index fb57b2bbc6e..a4345c7d7e2 100644 --- a/lisp/vc/vc-rcs.el +++ b/lisp/vc/vc-rcs.el @@ -40,6 +40,7 @@ (eval-when-compile (require 'cl-lib) (require 'vc)) +(require 'log-view) (declare-function vc-read-revision "vc" (prompt &optional files backend default initial-input)) @@ -99,7 +100,7 @@ to use --brief and sets this variable to remember whether it worked." "Where to look for RCS master files. For a description of possible values, see `vc-check-master-templates'." :type '(choice (const :tag "Use standard RCS file names" - '("%sRCS/%s,v" "%s%s,v" "%sRCS/%s")) + ("%sRCS/%s,v" "%s%s,v" "%sRCS/%s")) (repeat :tag "User-specified" (choice string function))) @@ -1062,9 +1063,9 @@ file." (defun vc-rcs-consult-headers (file) "Search for RCS headers in FILE, and set properties accordingly. -Returns: nil if no headers were found - 'rev if a workfile revision was found - 'rev-and-lock if revision and lock info was found" +Returns: nil if no headers were found + `rev' if a workfile revision was found + `rev-and-lock' if revision and lock info was found" (cond ((not (get-file-buffer file)) nil) ((let (status version) @@ -1456,6 +1457,14 @@ The `:insn' key is a keyword to distinguish it as a vc-rcs.el extension." `((headers ,desc ,@headers) (revisions ,@revs))))) +(defvar-keymap vc-rcs-log-view-mode-map + "N" #'log-view-file-next + "P" #'log-view-file-prev + "M-n" #'log-view-file-next + "M-p" #'log-view-file-prev) + +(define-derived-mode vc-rcs-log-view-mode log-view-mode "RCS-Log-View") + (provide 'vc-rcs) ;;; vc-rcs.el ends here diff --git a/lisp/vc/vc-sccs.el b/lisp/vc/vc-sccs.el index 0df70c8f232..9622bf5e097 100644 --- a/lisp/vc/vc-sccs.el +++ b/lisp/vc/vc-sccs.el @@ -27,6 +27,7 @@ (eval-when-compile (require 'vc)) +(require 'log-view) ;;; ;;; Customization options @@ -216,7 +217,7 @@ to the SCCS command." ;; TODO: check for all the patterns in vc-sccs-master-templates (or (and (file-directory-p (expand-file-name "SCCS" (file-name-directory file))) - file) + (file-name-directory file)) (let ((dir (vc-sccs-search-project-dir (or (file-name-directory file) "") (file-name-nondirectory file)))) (and (stringp dir) @@ -518,6 +519,14 @@ If NAME is nil or a revision number string it's just passed through." (file-name-directory (vc-master-name file)))) (vc-parse-buffer (concat name "\t:\t" file "\t\\(.+\\)") 1)))) +(defvar-keymap vc-sccs-log-view-mode-map + "N" #'log-view-file-next + "P" #'log-view-file-prev + "M-n" #'log-view-file-next + "M-p" #'log-view-file-prev) + +(define-derived-mode vc-sccs-log-view-mode log-view-mode "SCCS-Log-View") + (provide 'vc-sccs) ;;; vc-sccs.el ends here diff --git a/lisp/vc/vc-src.el b/lisp/vc/vc-src.el index 5a252c55cb2..432448bde58 100644 --- a/lisp/vc/vc-src.el +++ b/lisp/vc/vc-src.el @@ -120,7 +120,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." "Where to look for SRC master files. For a description of possible values, see `vc-check-master-templates'." :type '(choice (const :tag "Use standard SRC file names" - '("%s.src/%s,v")) + ("%s.src/%s,v")) (repeat :tag "User-specified" (choice string function)))) diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el index b38a676acbd..270877041aa 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, @@ -212,7 +212,7 @@ switches." (autoload 'vc-expand-dirs "vc") (defun vc-svn-dir-status-files (_dir files callback) - "Run 'svn status' for DIR and update BUFFER via CALLBACK. + "Run \"svn status\" for DIR and update BUFFER via CALLBACK. CALLBACK is called as (CALLBACK RESULT BUFFER), where RESULT is a list of conses (FILE . STATE) for directory DIR." ;; FIXME shouldn't this rather default to all the files in dir? diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index bebd0946dee..d3e53858c16 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)) @@ -823,7 +824,7 @@ for the backend you use." "Limit the number of items shown by the VC log commands. Zero means unlimited. Not all VC backends are able to support this feature." - :type 'integer) + :type 'natnum) (defcustom vc-allow-async-revert nil "Specifies whether the diff during \\[vc-revert] may be asynchronous. @@ -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 @@ -2606,7 +2654,10 @@ with its diffs (if the underlying VCS supports that)." (error "Directory is not version controlled"))) (setq default-directory rootdir) (vc-print-log-internal backend (list rootdir) revision revision limit - (when with-diff 'with-diff)))) + (when with-diff 'with-diff)) + ;; We're looking at the root, so displaying " from <some-file>" in + ;; the mode line isn't helpful. + (setq vc-parent-buffer-name nil))) ;;;###autoload (defun vc-print-branch-log (branch) @@ -2743,7 +2794,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. |