diff options
Diffstat (limited to 'lisp/vc')
37 files changed, 1273 insertions, 1349 deletions
diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el index 8b55a78f84d..d617d5aebb2 100644 --- a/lisp/vc/add-log.el +++ b/lisp/vc/add-log.el @@ -208,8 +208,6 @@ a case simply use the directory containing the changed file." '((t (:inherit font-lock-comment-face))) "Face for highlighting acknowledgments." :version "21.1") -(define-obsolete-face-alias 'change-log-acknowledgement - 'change-log-acknowledgment "24.3") (defconst change-log-file-names-re "^\\( +\\|\t\\)\\* \\([^ ,:([\n]+\\)") (defconst change-log-start-entry-re "^\\sw.........[0-9:+ ]*") @@ -568,14 +566,12 @@ Compatibility function for \\[next-error] invocations." ;; Select window displaying source file. (select-window change-log-find-window))))) -(defvar change-log-mode-map - (let ((map (make-sparse-keymap))) - (define-key map [?\C-c ?\C-p] #'add-log-edit-prev-comment) - (define-key map [?\C-c ?\C-n] #'add-log-edit-next-comment) - (define-key map [?\C-c ?\C-f] #'change-log-find-file) - (define-key map [?\C-c ?\C-c] #'change-log-goto-source) - map) - "Keymap for Change Log major mode.") +(defvar-keymap change-log-mode-map + :doc "Keymap for Change Log major mode." + "C-c C-p" #'add-log-edit-prev-comment + "C-c C-n" #'add-log-edit-next-comment + "C-c C-f" #'change-log-find-file + "C-c C-c" #'change-log-goto-source) (easy-menu-define change-log-mode-menu change-log-mode-map "Menu for Change Log major mode." @@ -590,9 +586,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 +785,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 +1063,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 322074106f9..a9591c9d82e 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,26 +272,28 @@ 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). +(with-suppressed-warnings ((obsolete diff-auto-refine-mode)) + (define-minor-mode diff-auto-refine-mode + "Toggle automatic diff hunk finer highlighting (Diff Auto Refine mode). Diff Auto Refine mode is a buffer-local minor mode used with `diff-mode'. When enabled, Emacs automatically highlights changes in detail as the user visits hunks. When transitioning from disabled to enabled, it tries to refine the current hunk, as well." - :group 'diff-mode :init-value nil :lighter nil ;; " Auto-Refine" - (if diff-auto-refine-mode - (progn - (customize-set-variable 'diff-refine 'navigation) - (condition-case-unless-debug nil (diff-refine-hunk) (error nil))) - (customize-set-variable 'diff-refine nil))) + :group 'diff-mode :init-value nil :lighter nil ;; " Auto-Refine" + (if diff-auto-refine-mode + (progn + (customize-set-variable 'diff-refine 'navigation) + (condition-case-unless-debug nil (diff-refine-hunk) (error nil))) + (customize-set-variable 'diff-refine nil)))) (make-obsolete 'diff-auto-refine-mode "set `diff-refine' instead." "27.1") (make-obsolete-variable 'diff-auto-refine-mode "set `diff-refine' instead." "27.1") @@ -627,7 +634,7 @@ See https://lists.gnu.org/r/emacs-devel/2007-11/msg01990.html") (when (looking-at regexp-hunk) ; Hunk header. (throw 'headerp (point))) (forward-line -1) - (when (re-search-forward regexp-file (point-at-eol 4) t) ; File header. + (when (re-search-forward regexp-file (line-end-position 4) t) ; File header. (forward-line 0) (throw 'headerp (point))) (goto-char orig) @@ -894,6 +901,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 +1483,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 +1512,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 +1531,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 +1556,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 +1579,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 +1592,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 +2279,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." @@ -2306,10 +2337,22 @@ Call FUN with two args (BEG and END) for each hunk." (let ((inhibit-read-only t)) (undo arg))) +;;;###autoload +(defcustom diff-add-log-use-relative-names nil + "Use relative file names when generating ChangeLog skeletons. +The files will be relative to the root directory of the VC +repository. This option affects the behavior of +`diff-add-log-current-defuns'." + :type 'boolean + :safe #'booleanp + :version "29.1") + (defun diff-add-log-current-defuns () "Return an alist of defun names for the current diff. The elements of the alist are of the form (FILE . (DEFUN...)), -where DEFUN... is a list of function names found in FILE." +where DEFUN... is a list of function names found in FILE. If +`diff-add-log-use-relative-names' is non-nil, file names in the alist +are relative to the root directory of the VC repository." (save-excursion (goto-char (point-min)) (let* ((defuns nil) @@ -2343,7 +2386,12 @@ where DEFUN... is a list of function names found in FILE." ;; hunks (e.g., "diff --git ..." etc). (re-search-forward diff-hunk-header-re nil t) (setq hunk-end (save-excursion (diff-end-of-hunk))) - (pcase-let* ((filename (substring-no-properties (diff-find-file-name))) + (pcase-let* ((filename (substring-no-properties + (if diff-add-log-use-relative-names + (file-relative-name + (diff-find-file-name) + (vc-root-dir)) + (diff-find-file-name)))) (=lines 0) (+lines 0) (-lines 0) @@ -2576,40 +2624,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 +2765,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) @@ -2834,6 +2946,15 @@ hunk text is not found in the source file." (forward-line 1))) (nreverse props))) +;;;###autoload +(defun diff-vc-deduce-fileset () + (let ((backend (vc-responsible-backend default-directory)) + files) + (save-excursion + (goto-char (point-min)) + (while (progn (diff-file-next) (not (eobp))) + (push (diff-find-file-name nil t) files))) + (list backend (nreverse files) nil nil 'patch))) (defun diff--filter-substring (str) (when diff-font-lock-prettify 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..e2d93d2b31b 100644 --- a/lisp/vc/ediff-help.el +++ b/lisp/vc/ediff-help.el @@ -24,10 +24,6 @@ ;;; Code: -;; Compiler pacifier start -(defvar ediff-multiframe) -;; end pacifier - (require 'ediff-init) (defvar ediff-multiframe) @@ -152,7 +148,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 +223,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..d1eff0151a8 100644 --- a/lisp/vc/ediff-hook.el +++ b/lisp/vc/ediff-hook.el @@ -35,27 +35,19 @@ ;; (define-key menu-bar-tools-menu [ediff] ;; '("Compare" . menu-bar-ediff-menu)) -;; Compiler pacifier -(defvar ediff-menu) -(defvar ediff-merge-menu) -(defvar epatch-menu) -(defvar ediff-misc-menu) -;; end pacifier - ;; allow menus to be set up without ediff-wind.el being loaded -;; Emacs ;; initialize menu bar keymaps (defvar menu-bar-ediff-misc-menu (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..c956cdd2ee6 100644 --- a/lisp/vc/ediff-init.el +++ b/lisp/vc/ediff-init.el @@ -27,35 +27,26 @@ (require 'cl-lib) (require 'ediff-util) -;; Start compiler pacifier (defvar ediff-metajob-name) (defvar ediff-meta-buffer) (defvar ediff-grab-mouse) (defvar ediff-mouse-pixel-position) (defvar ediff-mouse-pixel-threshold) -(defvar ediff-whitespace) (defvar ediff-multiframe) (defvar ediff-use-toolbar-p) -(defvar mswindowsx-bitmap-file-path) -;; end pacifier (defvar ediff-force-faces nil "If t, Ediff will think that it is running on a display that supports faces. This is provided as a temporary relief for users of face-capable displays that Ediff doesn't know about.") -;; Are we running as a window application or on a TTY? (defsubst ediff-device-type () - (declare (obsolete nil "27.1")) + (declare (obsolete window-system "27.1")) window-system) -(defun ediff-window-display-p () - (and window-system - (not (memq window-system '(tty pc stream))))) - ;; test if supports faces (defun ediff-has-face-support-p () - (cond ((ediff-window-display-p)) + (cond ((display-graphic-p)) (ediff-force-faces) ((display-color-p)) (t (memq window-system '(pc))))) @@ -64,11 +55,6 @@ that Ediff doesn't know about.") (defun ediff-has-toolbar-support-p () nil) - -(defun ediff-has-gutter-support-p () - (declare (obsolete nil "27.1")) - nil) - (defun ediff-use-toolbar-p () (and (ediff-has-toolbar-support-p) ;Can it do it ? (boundp 'ediff-use-toolbar-p) @@ -259,7 +245,7 @@ It needs to be killed when we quit the session.") (defsubst ediff-multiframe-setup-p () - (and (ediff-window-display-p) ediff-multiframe)) + (and (display-graphic-p) ediff-multiframe)) (defmacro ediff-narrow-control-frame-p () '(and (ediff-multiframe-setup-p) @@ -615,8 +601,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) @@ -722,18 +708,6 @@ Ediff needs to find fine differences." :type 'symbol :group 'ediff) - -(define-obsolete-function-alias 'ediff-read-event #'read-event "27.1") - -(define-obsolete-function-alias 'ediff-overlayp #'overlayp "27.1") - -(define-obsolete-function-alias 'ediff-make-overlay #'make-overlay "27.1") - -(define-obsolete-function-alias 'ediff-delete-overlay #'delete-overlay "27.1") - -(define-obsolete-function-alias 'ediff-color-display-p #'display-color-p "27.1") - - ;; A var local to each control panel buffer. Indicates highlighting style ;; in effect for this buffer: `face', `ascii', ;; `off' -- turned off (on a dumb terminal only). @@ -789,9 +763,9 @@ Ediff needs to find fine differences." (defun ediff-set-face-pixmap (face pixmap) "Set stipple pixmap of FACE to PIXMAP on a monochrome display." - (if (and (ediff-window-display-p) (not (display-color-p))) + (if (and (display-graphic-p) (not (display-color-p))) (condition-case nil - (set-face-background-pixmap face pixmap) + (set-face-stipple face pixmap) (error (message "Pixmap not found for %S: %s" (face-name face) pixmap) (sit-for 1))))) @@ -955,9 +929,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. @@ -972,8 +946,6 @@ this variable represents.") (cond ((not (ediff-has-face-support-p)) nil) ((and (boundp 'x-bitmap-file-path) (locate-library "stipple" t x-bitmap-file-path)) "stipple") - ((and (boundp 'mswindowsx-bitmap-file-path) - (locate-library "stipple" t mswindowsx-bitmap-file-path)) "stipple") (t "Stipple"))) (defface ediff-even-diff-A @@ -1055,7 +1027,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 +1118,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. @@ -1273,9 +1245,6 @@ This default should work without changes." "Temporary file used for refining difference regions in buffer C.") -(defun ediff-file-remote-p (file-name) - (file-remote-p file-name)) - ;; File for which we can get attributes, such as size or date (defun ediff-listable-file (file-name) (let ((handler (find-file-name-handler file-name 'file-local-copy))) @@ -1283,6 +1252,7 @@ This default should work without changes." (defsubst ediff-frame-unsplittable-p (frame) + (declare (obsolete nil "29.1")) (cdr (assq 'unsplittable (frame-parameters frame)))) (defsubst ediff-get-next-window (wind prev-wind) @@ -1357,52 +1327,40 @@ This default should work without changes." (ediff-clear-fine-differences-in-one-buffer n 'C))) -(defsubst ediff-mouse-event-p (event) - (string-match "mouse" (format "%S" (event-basic-type event)))) - - (defsubst ediff-key-press-event-p (event) (or (char-or-string-p event) (symbolp event))) (defun ediff-event-point (event) - (cond ((ediff-mouse-event-p event) + (cond ((mouse-event-p event) (posn-point (event-start event))) ((ediff-key-press-event-p event) (point)) (t (error "Error")))) (defun ediff-event-buffer (event) - (cond ((ediff-mouse-event-p event) + (cond ((mouse-event-p event) (window-buffer (posn-window (event-start event)))) ((ediff-key-press-event-p event) (current-buffer)) (t (error "Error")))) -(define-obsolete-function-alias 'ediff-event-key #'identity "27.1") - (defun ediff-last-command-char () - (declare (obsolete nil "27.1")) + (declare (obsolete last-command-event "27.1")) last-command-event) (defsubst ediff-frame-iconified-p (frame) - (and (ediff-window-display-p) + (and (display-graphic-p) (frame-live-p frame) (eq (frame-visible-p frame) 'icon))) (defsubst ediff-window-visible-p (wind) - ;; under TTY, window-live-p also means window is visible (and (window-live-p wind) - (or (not (ediff-window-display-p)) - (frame-visible-p (window-frame wind))))) - - -(define-obsolete-function-alias 'ediff-frame-char-width - #'frame-char-width "27.1") + (frame-visible-p (window-frame wind)))) (defun ediff-reset-mouse (&optional frame do-not-grab-mouse) (or frame (setq frame (selected-frame))) - (if (ediff-window-display-p) + (if (display-graphic-p) (let ((frame-or-wind frame)) (or do-not-grab-mouse ;; don't set mouse if the user said to never do this @@ -1419,29 +1377,28 @@ This default should work without changes." ))) (defsubst ediff-spy-after-mouse () - (setq ediff-mouse-pixel-position (mouse-pixel-position))) + (declare (obsolete nil "29.1")) + (with-suppressed-warnings ((obsolete ediff-mouse-pixel-position)) + (setq ediff-mouse-pixel-position (mouse-pixel-position)))) -;; It is not easy to find out when the user grabs the mouse, since emacs and -;; xemacs behave differently when mouse is not in any frame. Also, this is -;; sensitive to when the user grabbed mouse. Not used for now. (defun ediff-user-grabbed-mouse () - (if ediff-mouse-pixel-position - (cond ((not (eq (car ediff-mouse-pixel-position) - (car (mouse-pixel-position))))) - ((and (car (cdr ediff-mouse-pixel-position)) - (car (cdr (mouse-pixel-position))) - (cdr (cdr ediff-mouse-pixel-position)) - (cdr (cdr (mouse-pixel-position)))) - (not (and (< (abs (- (car (cdr ediff-mouse-pixel-position)) - (car (cdr (mouse-pixel-position))))) - ediff-mouse-pixel-threshold) - (< (abs (- (cdr (cdr ediff-mouse-pixel-position)) - (cdr (cdr (mouse-pixel-position))))) - ediff-mouse-pixel-threshold)))) - (t nil)))) - -(define-obsolete-function-alias 'ediff-frame-char-height - #'frame-char-height "27.1") + (declare (obsolete nil "29.1")) + (with-suppressed-warnings ((obsolete ediff-mouse-pixel-position)) + (if ediff-mouse-pixel-position + (cond ((not (eq (car ediff-mouse-pixel-position) + (car (mouse-pixel-position))))) + ((and (car (cdr ediff-mouse-pixel-position)) + (car (cdr (mouse-pixel-position))) + (cdr (cdr ediff-mouse-pixel-position)) + (cdr (cdr (mouse-pixel-position)))) + (not (and (< (abs (- (car (cdr ediff-mouse-pixel-position)) + (car (cdr (mouse-pixel-position))))) + ediff-mouse-pixel-threshold) + (< (abs (- (cdr (cdr ediff-mouse-pixel-position)) + (cdr (cdr (mouse-pixel-position))))) + ediff-mouse-pixel-threshold)))) + (t nil))))) + ;; Some overlay functions @@ -1456,12 +1413,6 @@ This default should work without changes." (defsubst ediff-empty-overlay-p (overl) (= (ediff-overlay-start overl) (ediff-overlay-end overl))) -(define-obsolete-function-alias 'ediff-overlay-buffer - #'overlay-buffer "27.1") - -(define-obsolete-function-alias 'ediff-overlay-get #'overlay-get "27.1") - - (defun ediff-move-overlay (overlay beg end &optional buffer) "If OVERLAY's buffer exists, call `move-overlay'." (let ((buf (and overlay (overlay-buffer overlay)))) @@ -1500,7 +1451,7 @@ This default should work without changes." (ediff-abbreviate-file-name (file-name-directory dir)))) (defsubst ediff-nonempty-string-p (string) - (and (stringp string) (not (string= string "")))) + (and (stringp string) (string-empty-p string))) (defun ediff-abbrev-jobname (jobname) (cond ((eq jobname 'ediff-directories) @@ -1561,16 +1512,23 @@ This default should work without changes." (ediff-file-attributes filename 5)) -;;; Obsolete - -(defun ediff-convert-standard-filename (fname) - (declare (obsolete convert-standard-filename "28.1")) - (convert-standard-filename fname)) - -(define-obsolete-function-alias 'ediff-with-syntax-table - #'with-syntax-table "27.1") - +(define-obsolete-function-alias 'ediff-has-gutter-support-p #'ignore "27.1") +(define-obsolete-function-alias 'ediff-event-key #'identity "27.1") +(define-obsolete-function-alias 'ediff-frame-char-width #'frame-char-width "27.1") +(define-obsolete-function-alias 'ediff-frame-char-height #'frame-char-height "27.1") +(define-obsolete-function-alias 'ediff-overlay-buffer #'overlay-buffer "27.1") +(define-obsolete-function-alias 'ediff-overlay-get #'overlay-get "27.1") +(define-obsolete-function-alias 'ediff-read-event #'read-event "27.1") +(define-obsolete-function-alias 'ediff-overlayp #'overlayp "27.1") +(define-obsolete-function-alias 'ediff-make-overlay #'make-overlay "27.1") +(define-obsolete-function-alias 'ediff-delete-overlay #'delete-overlay "27.1") +(define-obsolete-function-alias 'ediff-color-display-p #'display-color-p "27.1") +(define-obsolete-function-alias 'ediff-with-syntax-table #'with-syntax-table "27.1") +(define-obsolete-function-alias 'ediff-convert-standard-filename #'convert-standard-filename "28.1") (define-obsolete-function-alias 'ediff-hide-face #'ignore "28.1") +(define-obsolete-function-alias 'ediff-file-remote-p #'file-remote-p "29.1") +(define-obsolete-function-alias 'ediff-window-display-p #'display-graphic-p "29.1") +(define-obsolete-function-alias 'ediff-mouse-event-p #'mouse-event-p "29.1") (provide 'ediff-init) ;;; ediff-init.el ends here 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..52e356d8e9b 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) @@ -144,20 +144,18 @@ Useful commands (type ? to hide them and free up screen): (ediff-defvar-local ediff-meta-buffer-map nil "The keymap for the meta buffer.") -(defvar ediff-dir-diffs-buffer-map - (let ((map (make-sparse-keymap))) - (suppress-keymap map) - (define-key map "q" #'ediff-bury-dir-diffs-buffer) - (define-key map " " #'next-line) - (define-key map "n" #'next-line) - (define-key map "\C-?" #'previous-line) - (define-key map "p" #'previous-line) - (define-key map "C" #'ediff-dir-diff-copy-file) - (define-key map [mouse-2] #'ediff-dir-diff-copy-file) - (define-key map [delete] #'previous-line) - (define-key map [backspace] #'previous-line) - map) - "Keymap for buffer showing differences between directories.") +(defvar-keymap ediff-dir-diffs-buffer-map + :doc "Keymap for buffer showing differences between directories." + :suppress t + "q" #'ediff-bury-dir-diffs-buffer + "SPC" #'next-line + "n" #'next-line + "DEL" #'previous-line + "p" #'previous-line + "C" #'ediff-dir-diff-copy-file + "<mouse-2>" #'ediff-dir-diff-copy-file + "<delete>" #'previous-line + "<backspace>" #'previous-line) ;; Variable specifying the action to take when the use invokes ediff in the ;; meta buffer. This is usually ediff-registry-action or ediff-filegroup-action @@ -1236,7 +1234,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 +1427,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 @@ -1861,7 +1859,6 @@ all marked sessions must be active." ;; handle an individual session with a live control buffer ((ediff-buffer-live-p session-buf) (ediff-with-current-buffer session-buf - (setq ediff-mouse-pixel-position (mouse-pixel-position)) (ediff-recenter 'no-rehighlight))) ((ediff-problematic-session-p info) @@ -2005,7 +2002,6 @@ all marked sessions must be active." (ediff-show-meta-buffer ctl-buf t) ;; it's a session buffer -- invoke go back to session (ediff-with-current-buffer ctl-buf - (setq ediff-mouse-pixel-position (mouse-pixel-position)) (ediff-recenter 'no-rehighlight))) (beep) (message "You've selected a stale session --- try again") @@ -2056,14 +2052,14 @@ all marked sessions must be active." ((and (setq wind (ediff-get-visible-buffer-window ediff-registry-buffer)) - (ediff-window-display-p)) + (display-graphic-p)) (select-window wind) (other-window 1) (set-window-buffer (selected-window) meta-buf)) (t (ediff-skip-unsuitable-frames 'ok-unsplittable) (set-window-buffer (selected-window) meta-buf))) )) - (if (and (ediff-window-display-p) + (if (and (display-graphic-p) (window-live-p (setq wind (ediff-get-visible-buffer-window meta-buf)))) (progn @@ -2117,14 +2113,14 @@ all marked sessions must be active." (select-window ediff-window-B)) ((and (setq wind (ediff-get-visible-buffer-window ediff-meta-buffer)) - (ediff-window-display-p)) + (display-graphic-p)) (select-window wind) (other-window 1) (set-window-buffer (selected-window) ediff-registry-buffer)) (t (ediff-skip-unsuitable-frames 'ok-unsplittable) (set-window-buffer (selected-window) ediff-registry-buffer))) )) - (if (ediff-window-display-p) + (if (display-graphic-p) (progn (setq frame (window-frame diff --git a/lisp/vc/ediff-ptch.el b/lisp/vc/ediff-ptch.el index 8a6785e2c58..4d471e21b4c 100644 --- a/lisp/vc/ediff-ptch.el +++ b/lisp/vc/ediff-ptch.el @@ -24,10 +24,8 @@ ;;; Code: - (require 'diff-mode) ; For `diff-file-junk-re'. - (defgroup ediff-ptch nil "Ediff patch support." :tag "Patch" @@ -415,7 +413,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 +423,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 +503,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) @@ -800,7 +796,7 @@ you can still examine the changes via M-x ediff-files" ;; the orig file. (setq target-filename (concat - (if (ediff-file-remote-p (file-truename source-filename)) + (if (file-remote-p (file-truename source-filename)) magic-file-name source-filename) "_patched")) @@ -827,7 +823,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..0d96a195ade 100644 --- a/lisp/vc/ediff-util.el +++ b/lisp/vc/ediff-util.el @@ -24,24 +24,11 @@ ;;; Code: - (provide 'ediff-util) ;FIXME: Break cyclic dependencies and move to the end! -;; Compiler pacifier (defvar ediff-use-toolbar-p) -(defvar ediff-toolbar-height) -(defvar ediff-toolbar) -(defvar ediff-toolbar-3way) -(defvar bottom-toolbar) -(defvar bottom-toolbar-visible-p) -(defvar bottom-toolbar-height) -(defvar mark-active) - (defvar ediff-after-quit-hook-internal nil) -;; end pacifier - - (require 'ediff-init) (require 'ediff-help) (require 'ediff-mult) @@ -296,10 +283,6 @@ to invocation.") (if (string-match "buffer" (symbol-name ediff-job-name)) (setq ediff-keep-variants t)) - (if (ediff-window-display-p) - (add-hook 'pre-command-hook 'ediff-spy-after-mouse nil 'local)) - (setq ediff-mouse-pixel-position (mouse-pixel-position)) - ;; adjust for merge jobs (if ediff-merge-job (let ((buf @@ -739,7 +722,7 @@ buffers." ;; set visibility range appropriate to this invocation of Ediff. (ediff-visible-region) ;; raise - (if (and (ediff-window-display-p) + (if (and (display-graphic-p) (symbolp this-command) (symbolp last-command) ;; Either one of the display-changing commands @@ -764,7 +747,7 @@ buffers." (raise-frame (window-frame ediff-window-B))) (if (window-live-p ediff-window-C) (raise-frame (window-frame ediff-window-C))))) - (if (and (ediff-window-display-p) + (if (and (display-graphic-p) (frame-live-p ediff-control-frame) (not ediff-use-long-help-message) (not (ediff-frame-iconified-p ediff-control-frame))) @@ -1256,7 +1239,7 @@ of the current buffer." This is especially useful when comparing buffers side-by-side." (interactive) (ediff-barf-if-not-control-buffer) - (or (ediff-window-display-p) + (or (display-graphic-p) (user-error "Emacs is not running as a window application")) (ediff-recenter 'no-rehighlight) ; make sure buffs are displayed in windows (let ((ctl-buf ediff-control-buffer)) @@ -1283,7 +1266,7 @@ To change the default, set the variable `ediff-window-setup-function', which see." (interactive) (let (window-setup-func) - (or (ediff-window-display-p) + (or (display-graphic-p) (user-error "Emacs is not running as a window application")) (cond ((eq ediff-window-setup-function #'ediff-setup-windows-multiframe) @@ -1327,7 +1310,7 @@ To change the default, set the variable `ediff-use-toolbar-p', which see." ;; FIXME: Make it work in Emacs! (if (featurep 'ediff-tbar) (progn - (or (ediff-window-display-p) + (or (display-graphic-p) (user-error "Emacs is not running as a window application")) ;; do this only after killing the toolbar (setq ediff-use-toolbar-p (not ediff-use-toolbar-p)) @@ -1341,10 +1324,6 @@ To change the default, set the variable `ediff-use-toolbar-p', which see." (if (ediff-in-control-buffer-p) (ediff-recenter 'no-rehighlight))))) - -(define-obsolete-function-alias 'ediff-kill-bottom-toolbar #'ignore "27.1") -(define-obsolete-function-alias 'ediff-make-bottom-toolbar #'ignore "27.1") - ;; Merging (defun ediff-toggle-show-clashes-only () @@ -2442,7 +2421,7 @@ reverse the meaning of this variable." (after-quit-hook-internal (remq t ediff-after-quit-hook-internal)) (session-number ediff-meta-session-number) ;; suitable working frame - (warp-frame (if (and (ediff-window-display-p) (eq ediff-grab-mouse t)) + (warp-frame (if (and (display-graphic-p) (eq ediff-grab-mouse t)) (cond ((window-live-p ediff-window-A) (window-frame ediff-window-A)) ((window-live-p ediff-window-B) @@ -2516,7 +2495,7 @@ reverse the meaning of this variable." (setq warp-frame ; if mouse is over a reasonable frame, use it (cond ((ediff-good-frame-under-mouse)) (t warp-frame))) - (if (and (ediff-window-display-p) (frame-live-p warp-frame) ediff-grab-mouse) + (if (and (display-graphic-p) (frame-live-p warp-frame) ediff-grab-mouse) (set-mouse-position warp-frame 2 1)) (mapc #'funcall after-quit-hook-internal) @@ -2573,7 +2552,7 @@ reverse the meaning of this variable." (ediff-kill-buffer-carefully ediff-patch-diagnostics)) ;; delete control frame or window - (cond ((and (ediff-window-display-p) (frame-live-p ctl-frame)) + (cond ((and (display-graphic-p) (frame-live-p ctl-frame)) (delete-frame ctl-frame)) ((window-live-p ctl-wind) (delete-window ctl-wind))) @@ -2748,7 +2727,7 @@ only if this merge job is part of a group, i.e., was invoked from within (buf-fine-diff ediff-fine-diff-buffer)) ;; hide the control panel - (if (and (ediff-window-display-p) (frame-live-p ediff-control-frame)) + (if (and (display-graphic-p) (frame-live-p ediff-control-frame)) (iconify-frame ediff-control-frame) (bury-buffer)) (if buf-err (bury-buffer buf-err)) @@ -3086,10 +3065,6 @@ Hit \\[ediff-recenter] to reset the windows afterward." ) -;; for compatibility -(define-obsolete-function-alias 'ediff-minibuffer-with-setup-hook - #'minibuffer-with-setup-hook "28.1") - ;; This is adapted from a similar function in `emerge.el'. ;; PROMPT should not have a trailing ': ', so that it can be modified ;; according to context. @@ -3121,11 +3096,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 @@ -3201,13 +3172,7 @@ Hit \\[ediff-recenter] to reset the windows afterward." (progn (if (or (file-exists-p file) (not keep-proposed-name)) (setq file (make-temp-name proposed-name))) - ;; the with-temp-buffer thing is a workaround for an XEmacs - ;; bug: write-region complains that we are trying to visit a - ;; file in an indirect buffer, failing to notice that the - ;; VISIT flag is unset and that we are actually writing from a - ;; string and not from any buffer. - (with-temp-buffer - (write-region "" nil file nil 'silent nil 'excl)) + (write-region "" nil file nil 'silent nil 'excl) nil) (file-already-exists t)) ;; the file was somehow created by someone else between @@ -3216,16 +3181,6 @@ Hit \\[ediff-recenter] to reset the windows afterward." file)) -;; Quote metacharacters (using \) when executing diff in Unix. -;;(defun ediff-protect-metachars (str) -;; (let ((limit 0)) -;; (while (string-match ediff-metachars str limit) -;; (setq str (concat (substring str 0 (match-beginning 0)) -;; "\\" -;; (substring str (match-beginning 0)))) -;; (setq limit (1+ (match-end 0))))) -;; str) - ;; Make sure the current buffer (for a file) has the same contents as the ;; file on disk, and attempt to remedy the situation if not. ;; Signal an error if we can't make them the same, or the user doesn't want @@ -3286,8 +3241,9 @@ Hit \\[ediff-recenter] to reset the windows afterward." (defun ediff-filename-magic-p (file) + (declare (obsolete nil "29.1")) (or (ediff-file-compressed-p file) - (ediff-file-remote-p file))) + (file-remote-p file))) (defun ediff-save-buffer (arg) @@ -3334,7 +3290,8 @@ Without an argument, it saves customized diff argument, if available (select-window wind) (delete-other-windows) (or (mark) (push-mark)) - (ediff-activate-mark) + (setq mark-active 'ediff-util) + (setq-local transient-mark-mode t) (split-window-vertically) (ediff-select-lowest-window) (setq other-wind (selected-window)) @@ -3408,11 +3365,11 @@ Without an argument, it saves customized diff argument, if available file-A file-B) (unless (and buf-A-file-name (file-exists-p buf-A-file-name) - (not (ediff-file-remote-p buf-A-file-name))) + (not (file-remote-p buf-A-file-name))) (setq file-A (ediff-make-temp-file ediff-buffer-A))) (unless (and buf-B-file-name (file-exists-p buf-B-file-name) - (not (ediff-file-remote-p buf-B-file-name))) + (not (file-remote-p buf-B-file-name))) (setq file-B (ediff-make-temp-file ediff-buffer-B))) (or (ediff-buffer-live-p ediff-custom-diff-buffer) (setq ediff-custom-diff-buffer @@ -3435,6 +3392,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 +3402,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) @@ -3907,11 +3870,9 @@ Ediff Control Panel to restore highlighting." "Submit bug report on Ediff." (interactive) (ediff-barf-if-not-control-buffer) - (defvar ediff-device-type) (defvar ediff-buffer-name) (let ((reporter-prompt-for-summary-p t) (ctl-buf ediff-control-buffer) - (ediff-device-type window-system) varlist salutation ediff-buffer-name) (setq varlist '(ediff-diff-program ediff-diff-options ediff-diff3-program ediff-diff3-options @@ -3930,8 +3891,7 @@ Ediff Control Panel to restore highlighting." ediff-job-name ediff-word-mode ediff-buffer-name - ediff-device-type - )) + window-system)) (setq salutation " Congratulations! You may have unearthed a bug in Ediff! @@ -4009,24 +3969,19 @@ Mail anyway? (y or n) ") (defun ediff-choose-syntax-table () (setq ediff-syntax-table (ediff-with-current-buffer ediff-buffer-A - (if (not (memq major-mode - '(fundamental-mode text-mode indented-text-mode))) - (syntax-table)))) + (unless (memq major-mode '(fundamental-mode text-mode)) + (syntax-table)))) (if (not ediff-syntax-table) (setq ediff-syntax-table (ediff-with-current-buffer ediff-buffer-B (syntax-table)))) ) - -(define-obsolete-function-alias 'ediff-deactivate-mark #'deactivate-mark "27.1") - (defun ediff-activate-mark () + (declare (obsolete nil "29.1")) (setq mark-active 'ediff-util) (setq-local transient-mark-mode t)) -(define-obsolete-function-alias 'ediff-nuke-selective-display #'ignore "27.1") - ;; The next two are modified versions from emerge.el. ;; VARS must be a list of symbols ;; ediff-save-variables returns an association list: ((var . val) ...) @@ -4092,11 +4047,11 @@ Mail anyway? (y or n) ") ;;; Debug -(ediff-defvar-local ediff-command-begin-time '(0 0 0)) +(ediff-defvar-local ediff-command-begin-time 0) ;; calculate time used by command (defun ediff-calc-command-time () - (or (equal ediff-command-begin-time '(0 0 0)) + (or (equal ediff-command-begin-time 0) (message "Elapsed time: %g second(s)" (float-time (time-since ediff-command-begin-time))))) @@ -4110,10 +4065,10 @@ Mail anyway? (y or n) ") (let ((pre-hook 'pre-command-hook) (post-hook 'post-command-hook)) - (if (not (equal ediff-command-begin-time '(0 0 0))) + (if (not (equal ediff-command-begin-time 0)) (progn (remove-hook pre-hook 'ediff-save-time) (remove-hook post-hook 'ediff-calc-command-time) - (setq ediff-command-begin-time '(0 0 0)) + (setq ediff-command-begin-time 0) (message "Ediff profiling disabled")) (add-hook pre-hook 'ediff-save-time t 'local) (add-hook post-hook 'ediff-calc-command-time nil 'local) @@ -4178,7 +4133,12 @@ Mail anyway? (y or n) ") (key-description desc) (format "M-x %s" func-def)))) +(define-obsolete-function-alias 'ediff-kill-bottom-toolbar #'ignore "27.1") +(define-obsolete-function-alias 'ediff-make-bottom-toolbar #'ignore "27.1") +(define-obsolete-function-alias 'ediff-deactivate-mark #'deactivate-mark "27.1") +(define-obsolete-function-alias 'ediff-nuke-selective-display #'ignore "27.1") (define-obsolete-function-alias 'ediff-add-to-history #'add-to-history "27.1") +(define-obsolete-function-alias 'ediff-minibuffer-with-setup-hook #'minibuffer-with-setup-hook "28.1") (define-obsolete-function-alias 'ediff-copy-list #'copy-sequence "28.1") (define-obsolete-function-alias 'ediff-union #'seq-union "28.1") (define-obsolete-function-alias 'ediff-intersection #'seq-intersection "28.1") diff --git a/lisp/vc/ediff-wind.el b/lisp/vc/ediff-wind.el index 1e702edb419..bd2e9f19773 100644 --- a/lisp/vc/ediff-wind.el +++ b/lisp/vc/ediff-wind.el @@ -1,6 +1,6 @@ ;;; ediff-wind.el --- window manipulation utilities -*- lexical-binding:t -*- -;; Copyright (C) 1994-1997, 2000-2022 Free Software Foundation, Inc. +;; Copyright (C) 1994-2022 Free Software Foundation, Inc. ;; Author: Michael Kifer <kifer@cs.stonybrook.edu> ;; Package: ediff @@ -24,23 +24,11 @@ ;;; Code: - -;; Compiler pacifier (defvar icon-title-format) -(defvar top-toolbar-height) -(defvar bottom-toolbar-height) -(defvar left-toolbar-height) -(defvar right-toolbar-height) -(defvar left-toolbar-width) -(defvar right-toolbar-width) -(defvar default-menubar) -(defvar top-gutter) -(defvar frame-icon-title-format) (defvar ediff-diff-status) (require 'ediff-init) (require 'ediff-help) -;; end pacifier (defgroup ediff-window nil "Ediff window manipulation." @@ -48,14 +36,6 @@ :group 'ediff :group 'frames) - -;; Determine which window setup function to use based on current window system. -(defun ediff-choose-window-setup-function-automatically () - (declare (obsolete ediff-setup-windows-default "24.3")) - (if (ediff-window-display-p) - #'ediff-setup-windows-multiframe - #'ediff-setup-windows-plain)) - (defcustom ediff-window-setup-function #'ediff-setup-windows-default "Function called to set up windows. Ediff provides a choice of three functions: @@ -179,6 +159,7 @@ Used internally---not a user option.") (ediff-defvar-local ediff-mouse-pixel-position nil "Position of the mouse. Used to decide whether to warp the mouse into control frame.") +(make-obsolete-variable 'ediff-mouse-pixel-position "it is unused." "29.1") ;; not used for now (defvar ediff-mouse-pixel-threshold 30 @@ -260,8 +241,8 @@ keyboard input to go into icons." (let (event) (message "Select windows by clicking. Please click on Window %d " wind-number) - (while (not (ediff-mouse-event-p (setq event - (read--potential-mouse-event)))) + (while (not (mouse-event-p (setq event + (read--potential-mouse-event)))) (if (sit-for 1) ; if sequence of events, wait till the final word (beep 1)) (message "Please click on Window %d " wind-number)) @@ -303,7 +284,7 @@ keyboard input to go into icons." (other-window 1)) ;; in case user did a no-no on a tty - (or (ediff-window-display-p) + (or (display-graphic-p) (setq ediff-window-setup-function #'ediff-setup-windows-plain)) (or (ediff-keep-window-config control-buffer) @@ -843,9 +824,9 @@ keyboard input to go into icons." (defun ediff-skip-unsuitable-frames (&optional ok-unsplittable) "Skip unsplittable frames and frames that have dedicated windows. Create a new splittable frame if none is found." - (if (ediff-window-display-p) + (if (display-graphic-p) (let ((wind-frame (window-frame)) - seen-windows) + seen-windows) (while (and (not (memq (selected-window) seen-windows)) (or (ediff-frame-has-dedicated-windows wind-frame) @@ -854,8 +835,8 @@ Create a new splittable frame if none is found." (< (frame-height wind-frame) (* 3 window-min-height)) (if ok-unsplittable - nil - (ediff-frame-unsplittable-p wind-frame)))) + nil + (cdr (assq 'unsplittable (frame-parameters wind-frame)))))) ;; remember history (setq seen-windows (cons (selected-window) seen-windows)) ;; try new window @@ -901,7 +882,6 @@ Create a new splittable frame if none is found." fheight fwidth adjusted-parameters) (with-current-buffer ctl-buffer - ;;(setq user-grabbed-mouse (ediff-user-grabbed-mouse)) (run-hooks 'ediff-before-setup-control-frame-hook)) (setq old-ctl-frame (with-current-buffer ctl-buffer ediff-control-frame)) @@ -993,7 +973,7 @@ Create a new splittable frame if none is found." ;; synchronize so the cursor will move to control frame ;; per RMS suggestion - (if (ediff-window-display-p) + (if (display-graphic-p) (let ((count 7)) (sit-for .1) (while (and (not (frame-visible-p ctl-frame)) (> count 0)) @@ -1012,7 +992,7 @@ Create a new splittable frame if none is found." (defun ediff-destroy-control-frame (ctl-buffer) (ediff-with-current-buffer ctl-buffer - (if (and (ediff-window-display-p) (frame-live-p ediff-control-frame)) + (if (and (display-graphic-p) (frame-live-p ediff-control-frame)) (let ((ctl-frame ediff-control-frame)) (setq ediff-control-frame nil) (delete-frame ctl-frame)))) @@ -1135,7 +1115,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) @@ -1144,7 +1125,7 @@ It assumes that it is called from within the control buffer." ;; Force mode-line redisplay (force-mode-line-update) - (if (and (ediff-window-display-p) (frame-live-p ediff-control-frame)) + (if (and (display-graphic-p) (frame-live-p ediff-control-frame)) (ediff-refresh-control-frame)) (ediff-with-current-buffer ediff-buffer-A @@ -1213,18 +1194,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 46ad94c1828..40473a2c03f 100644 --- a/lisp/vc/ediff.el +++ b/lisp/vc/ediff.el @@ -106,8 +106,6 @@ ;;; Code: (require 'ediff-util) -;; end pacifier - (require 'ediff-init) (require 'ediff-mult) ; required because of the registry stuff @@ -282,7 +280,8 @@ deleted. Returns the buffer into which the file is visited. Also sets `ediff--magic-file-name' to indicate where the file's content has been saved (if not in `buffer-file-name')." - (let* ((file-magic (ediff-filename-magic-p file)) + (let* ((file-magic (or (ediff-file-compressed-p file) + (file-remote-p file))) (temp-file-name-prefix (file-name-nondirectory file))) (cond ((not (file-readable-p file)) (user-error "File `%s' does not exist or is not readable" file)) @@ -1557,7 +1556,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..de09be80e7c 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 @@ -2942,6 +2942,7 @@ If some prefix of KEY has a non-prefix definition, it is redefined." ;; Define a key if it (or a prefix) is not already defined in the map. (defun emerge-define-key-if-possible (keymap key definition) + (declare (obsolete keymap-set "29.1")) ;; look up the present definition of the key (let ((present (lookup-key keymap key))) (if (integerp present) @@ -2959,6 +2960,7 @@ If some prefix of KEY has a non-prefix definition, it is redefined." If the name won't fit on one line, the minibuffer is expanded to hold it, and the command waits for a keystroke from the user. If the keystroke is SPC, it is ignored; if it is anything else, it is processed as a command." + (declare (obsolete nil "29.1")) (interactive) (let ((name (buffer-file-name))) (or name diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index c2000c7eec3..52906163024 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'." @@ -666,6 +664,19 @@ comment history, see `log-edit-comment-ring', and hides `log-edit-files-buf'." (indent-rigidly (point) (point-max) (- log-edit-common-indent common))))) +(defvar vc-patch-string) + +(autoload 'vc-diff-patch-string "vc") +(defun log-edit-diff-patch () + (vc-diff-patch-string vc-patch-string)) + +(defvar vc-log-fileset) + +(defun log-edit-diff-fileset () + "Display diffs for the files to be committed." + (interactive) + (vc-diff nil nil (list log-edit-vc-backend vc-log-fileset))) + (defun log-edit-show-diff () "Show the diff for the files to be committed." (interactive) @@ -712,10 +723,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-util.el b/lisp/vc/pcvs-util.el index 702033dd88a..ddc3ea6e810 100644 --- a/lisp/vc/pcvs-util.el +++ b/lisp/vc/pcvs-util.el @@ -38,6 +38,7 @@ (apply #'append (mapcar (lambda (x) (if (listp x) x (list x))) xs))) (defun cvs-first (l &optional n) + ;; FIXME: Replace this with `seq-take'? (if (null n) (car l) (when l (let* ((nl (list (pop l))) @@ -53,10 +54,9 @@ The function returns a `cons' cell where the `car' contains elements of L for which P is true while the `cdr' contains the other elements. The ordering among elements is maintained." - (let (car cdr) - (dolist (x l) - (if (funcall p x) (push x car) (push x cdr))) - (cons (nreverse car) (nreverse cdr)))) + (let ((res (seq-group-by p l))) + (cons (cdr (assq t res)) + (cdr (assq nil res))))) ;;; ;;; frame, window, buffer handling @@ -164,8 +164,6 @@ arguments. If ARGS is not a list, no argument will be passed." (if oneline (line-end-position) (point-max)))) (file-error nil))) -(define-obsolete-function-alias 'cvs-string-prefix-p #'string-prefix-p "24.3") - ;;;; ;;;; file names ;;;; 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..a15cf417de3 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" @@ -162,22 +162,20 @@ List of factors, used to expand/compress the time scale. See `vc-annotate'." :type '(repeat number) :group 'vc) -(defvar vc-annotate-mode-map - (let ((m (make-sparse-keymap))) - (define-key m "a" #'vc-annotate-revision-previous-to-line) - (define-key m "d" #'vc-annotate-show-diff-revision-at-line) - (define-key m "=" #'vc-annotate-show-diff-revision-at-line) - (define-key m "D" #'vc-annotate-show-changeset-diff-revision-at-line) - (define-key m "f" #'vc-annotate-find-revision-at-line) - (define-key m "j" #'vc-annotate-revision-at-line) - (define-key m "l" #'vc-annotate-show-log-revision-at-line) - (define-key m "n" #'vc-annotate-next-revision) - (define-key m "p" #'vc-annotate-prev-revision) - (define-key m "w" #'vc-annotate-working-revision) - (define-key m "v" #'vc-annotate-toggle-annotation-visibility) - (define-key m "\C-m" #'vc-annotate-goto-line) - m) - "Local keymap used for VC-Annotate mode.") +(defvar-keymap vc-annotate-mode-map + :doc "Local keymap used for VC-Annotate mode." + "a" #'vc-annotate-revision-previous-to-line + "d" #'vc-annotate-show-diff-revision-at-line + "=" #'vc-annotate-show-diff-revision-at-line + "D" #'vc-annotate-show-changeset-diff-revision-at-line + "f" #'vc-annotate-find-revision-at-line + "j" #'vc-annotate-revision-at-line + "l" #'vc-annotate-show-log-revision-at-line + "n" #'vc-annotate-next-revision + "p" #'vc-annotate-prev-revision + "w" #'vc-annotate-working-revision + "v" #'vc-annotate-toggle-annotation-visibility + "RET" #'vc-annotate-goto-line) ;;; Annotate functionality @@ -451,7 +449,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..f6b17d4ce09 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. @@ -1004,19 +1008,17 @@ stream. Standard error output is discarded." ;; frob the results accordingly. (file-relative-name dir (vc-bzr-root dir))))) -(defvar vc-bzr-shelve-map - (let ((map (make-sparse-keymap))) - ;; Turn off vc-dir marking - (define-key map [mouse-2] #'ignore) - - (define-key map [down-mouse-3] #'vc-bzr-shelve-menu) - (define-key map "\C-k" #'vc-bzr-shelve-delete-at-point) - (define-key map "=" #'vc-bzr-shelve-show-at-point) - (define-key map "\C-m" #'vc-bzr-shelve-show-at-point) - (define-key map "A" #'vc-bzr-shelve-apply-and-keep-at-point) - (define-key map "P" #'vc-bzr-shelve-apply-at-point) - (define-key map "S" #'vc-bzr-shelve-snapshot) - map)) +(defvar-keymap vc-bzr-shelve-map + ;; Turn off vc-dir marking + "<mouse-2>" #'ignore + + "<down-mouse-3>" #'vc-bzr-shelve-menu + "C-k" #'vc-bzr-shelve-delete-at-point + "=" #'vc-bzr-shelve-show-at-point + "RET" #'vc-bzr-shelve-show-at-point + "A" #'vc-bzr-shelve-apply-and-keep-at-point + "P" #'vc-bzr-shelve-apply-at-point + "S" #'vc-bzr-shelve-snapshot) (defvar vc-bzr-shelve-menu-map (let ((map (make-sparse-keymap "Bzr Shelve"))) diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el index 8f06d5a847a..52cc42791fa 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)) @@ -249,7 +250,7 @@ See also variable `vc-cvs-sticky-date-format-string'." (let ((checkout-time (vc-file-getprop file 'vc-checkout-time)) (lastmod (file-attribute-modification-time (file-attributes file)))) (cond - ((equal checkout-time lastmod) 'up-to-date) + ((time-equal-p checkout-time lastmod) 'up-to-date) ((string= (vc-working-revision file) "0") 'added) ((null checkout-time) 'unregistered) (t 'edited)))) @@ -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..b4568727ea0 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) @@ -355,10 +356,10 @@ See `run-hooks'." (define-key map "G" #'vc-dir-ignore) (let ((branch-map (make-sparse-keymap))) - (define-key map "B" branch-map) - (define-key branch-map "c" #'vc-create-tag) + (define-key map "b" branch-map) + (define-key branch-map "c" #'vc-create-branch) (define-key branch-map "l" #'vc-print-branch-log) - (define-key branch-map "s" #'vc-retrieve-tag)) + (define-key branch-map "s" #'vc-switch-branch)) (let ((mark-map (make-sparse-keymap))) (define-key map "*" mark-map) @@ -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 @@ -1444,17 +1467,13 @@ These are the commands available for use in the file status buffer: (propertize "Please add backend specific headers here. It's easy!" 'face 'vc-dir-status-warning))) -(defvar vc-dir-status-mouse-map - (let ((map (make-sparse-keymap))) - (define-key map [mouse-2] #'vc-dir-toggle-mark) - map) - "Local keymap for toggling mark.") +(defvar-keymap vc-dir-status-mouse-map + :doc "Local keymap for toggling mark." + "<mouse-2>" #'vc-dir-toggle-mark) -(defvar vc-dir-filename-mouse-map - (let ((map (make-sparse-keymap))) - (define-key map [mouse-2] #'vc-dir-find-file-other-window) - map) - "Local keymap for visiting a file.") +(defvar-keymap vc-dir-filename-mouse-map + :doc "Local keymap for visiting a file." + "<mouse-2>" #'vc-dir-find-file-other-window) (defun vc-default-dir-printer (_backend fileentry) "Pretty print FILEENTRY." @@ -1539,9 +1558,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 +1579,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..36a6f27891b 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 @@ -617,6 +624,8 @@ NOT-URGENT means it is ok to continue if the user says not to save." (declare-function log-edit-empty-buffer-p "log-edit" ()) +(defvar vc-patch-string) + (defun vc-log-edit (fileset mode backend) "Set up `log-edit' for use on FILE." (setq default-directory @@ -629,32 +638,34 @@ 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)))) - (log-edit-diff-function . vc-diff) + . ,(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 + . ,(if vc-patch-string 'log-edit-diff-patch 'log-edit-diff-fileset)) (log-edit-vc-backend . ,backend) - (vc-log-fileset . ,fileset)) + (vc-log-fileset . ,fileset) + (vc-patch-string . ,vc-patch-string)) nil mode) (set-buffer-modified-p nil) (setq buffer-file-name nil)) -(defun vc-start-logentry (files comment initial-contents msg logbuf mode action &optional after-hook backend) +(defun vc-start-logentry (files comment initial-contents msg logbuf mode action &optional after-hook backend patch-string) "Accept a comment for an operation on FILES. If COMMENT is nil, pop up a LOGBUF buffer, emit MSG, and set the action on close to ACTION. If COMMENT is a string and @@ -666,7 +677,8 @@ empty comment. Remember the file's buffer in `vc-parent-buffer' \(current one if no file). Puts the log-entry buffer in major mode MODE, defaulting to `log-edit-mode' if MODE is nil. AFTER-HOOK specifies the local value for `vc-log-after-operation-hook'. -BACKEND, if non-nil, specifies a VC backend for the Log Edit buffer." +BACKEND, if non-nil, specifies a VC backend for the Log Edit buffer. +PATCH-STRING is a patch to check in." (let ((parent (if (vc-dispatcher-browsing) ;; If we are called from a directory browser, the parent buffer is @@ -681,6 +693,8 @@ BACKEND, if non-nil, specifies a VC backend for the Log Edit buffer." (setq-local vc-parent-buffer parent) (setq-local vc-parent-buffer-name (concat " from " (buffer-name vc-parent-buffer))) + (when patch-string + (setq-local vc-patch-string patch-string)) (vc-log-edit files mode backend) (make-local-variable 'vc-log-after-operation-hook) (when after-hook @@ -746,7 +760,8 @@ the buffer contents as a comment." (defun vc-dispatcher-browsing () "Are we in a directory browser buffer?" (or (derived-mode-p 'vc-dir-mode) - (derived-mode-p 'dired-mode))) + (derived-mode-p 'dired-mode) + (derived-mode-p 'diff-mode))) ;; These are unused. ;; (defun vc-dispatcher-in-fileset-p (fileset) @@ -754,8 +769,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..8d8ea33f8b3 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -53,7 +53,8 @@ ;; - responsible-p (file) OK ;; - receive-file (file rev) NOT NEEDED ;; - unregister (file) OK -;; * checkin (files rev comment) OK +;; * checkin (files comment rev) OK +;; - checkin-patch (patch-string comment) OK ;; * find-revision (file rev buffer) OK ;; * checkout (file &optional rev) OK ;; * revert (file &optional contents-done) OK @@ -81,7 +82,7 @@ ;; - annotate-time () OK ;; - annotate-current-time () NOT NEEDED ;; - annotate-extract-revision-at-line () OK -;; TAG SYSTEM +;; TAG/BRANCH SYSTEM ;; - create-tag (dir name branchp) OK ;; - retrieve-tag (dir name update) OK ;; MISCELLANEOUS @@ -118,6 +119,14 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (repeat :tag "Argument List" :value ("") string)) :version "23.1") +;;;###autoload +(defun vc-git-annotate-switches-safe-p (switches) + "Check if local value of `vc-git-annotate-switches' is safe. +Currently only \"-w\" (ignore whitespace) is considered safe, but +this list might be extended in the future." + ;; TODO: Probably most options are perfectly safe. + (equal switches "-w")) + (defcustom vc-git-annotate-switches nil "String or list of strings specifying switches for Git blame under VC. If nil, use the value of `vc-annotate-switches'. If t, use no switches." @@ -126,6 +135,7 @@ If nil, use the value of `vc-annotate-switches'. If t, use no switches." (string :tag "Argument String") (repeat :tag "Argument List" :value ("") string)) :version "25.1") +;;;###autoload(put 'vc-git-annotate-switches 'safe-local-variable #'vc-git-annotate-switches-safe-p) (defcustom vc-git-log-switches nil "String or list of strings specifying switches for Git log under VC." @@ -290,12 +300,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) @@ -662,32 +674,26 @@ or an empty string if none." :files files :update-function update-function))) -(defvar vc-git-stash-shared-map - (let ((map (make-sparse-keymap))) - (define-key map "S" #'vc-git-stash-snapshot) - (define-key map "C" #'vc-git-stash) - map)) +(defvar-keymap vc-git-stash-shared-map + "S" #'vc-git-stash-snapshot + "C" #'vc-git-stash) -(defvar vc-git-stash-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map vc-git-stash-shared-map) - ;; Turn off vc-dir marking - (define-key map [mouse-2] #'ignore) - - (define-key map [down-mouse-3] #'vc-git-stash-menu) - (define-key map "\C-k" #'vc-git-stash-delete-at-point) - (define-key map "=" #'vc-git-stash-show-at-point) - (define-key map "\C-m" #'vc-git-stash-show-at-point) - (define-key map "A" #'vc-git-stash-apply-at-point) - (define-key map "P" #'vc-git-stash-pop-at-point) - map)) +(defvar-keymap vc-git-stash-map + :parent vc-git-stash-shared-map + ;; Turn off vc-dir marking + "<mouse-2>" #'ignore -(defvar vc-git-stash-button-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map vc-git-stash-shared-map) - (define-key map [mouse-2] #'push-button) - (define-key map "\C-m" #'push-button) - map)) + "<down-mouse-3>" #'vc-git-stash-menu + "C-k" #'vc-git-stash-delete-at-point + "=" #'vc-git-stash-show-at-point + "RET" #'vc-git-stash-show-at-point + "A" #'vc-git-stash-apply-at-point + "P" #'vc-git-stash-pop-at-point) + +(defvar-keymap vc-git-stash-button-map + :parent vc-git-stash-shared-map + "<mouse-2>" #'push-button + "RET" #'push-button) (defconst vc-git-stash-shared-help "\\<vc-git-stash-shared-map>\\[vc-git-stash]: Create named stash\n\\[vc-git-stash-snapshot]: Snapshot stash") @@ -861,6 +867,47 @@ The car of the list is the current branch." ;;; STATE-CHANGING FUNCTIONS +(defcustom vc-git-log-edit-summary-target-len nil + "Target length for Git commit summary lines. +If a number, characters in Summary: lines beyond this length are +displayed in the `vc-git-log-edit-summary-target-warning' face. +A value of any other type means no highlighting. + +By setting this to an integer around 50, you can improve the +compatibility of your commit messages with Git commands that +print the summary line in width-constrained contexts. However, +many commit summaries will need to exceed this length. + +See also `vc-git-log-edit-summary-max-len'." + :type '(choice (const :tag "No target" nil) + (natnum :tag "Target length")) + :safe (lambda (x) (or (not x) (natnump x)))) + +(defface vc-git-log-edit-summary-target-warning + '((t :inherit warning)) + "Face for Git commit summary lines beyond the target length. +See `vc-git-log-edit-summary-target-len'.") + +(defcustom vc-git-log-edit-summary-max-len 68 + "Maximum length for Git commit summary lines. +If a number, characters in summary lines beyond this length are +displayed in the `vc-git-log-edit-summary-max-warning' face. +A value of any other type means no highlighting. + +It is good practice to avoid writing summary lines longer than +this because otherwise the summary line will be truncated in many +contexts in which Git commands display summary lines. + +See also `vc-git-log-edit-summary-target-len'." + :type '(choice (const :tag "No target" nil) + (natnum :tag "Target length")) + :safe (lambda (x) (or (not x) (natnump x)))) + +(defface vc-git-log-edit-summary-max-warning + '((t :inherit error)) + "Face for Git commit summary lines beyond the maximum length. +See `vc-git-log-edit-summary-max-len'.") + (defun vc-git-create-repo () "Create a new Git repository." (vc-git-command nil 0 nil "init")) @@ -908,16 +955,44 @@ If toggling on, also insert its message into the buffer." standard-output 1 nil "log" "--max-count=1" "--pretty=format:%B" "HEAD"))))) -(defvar vc-git-log-edit-mode-map - (let ((map (make-sparse-keymap "Git-Log-Edit"))) - (define-key map "\C-c\C-s" #'vc-git-log-edit-toggle-signoff) - (define-key map "\C-c\C-n" #'vc-git-log-edit-toggle-no-verify) - (define-key map "\C-c\C-e" #'vc-git-log-edit-toggle-amend) - map)) +(defvar-keymap vc-git-log-edit-mode-map + :name "Git-Log-Edit" + "C-c C-s" #'vc-git-log-edit-toggle-signoff + "C-c C-n" #'vc-git-log-edit-toggle-no-verify + "C-c C-e" #'vc-git-log-edit-toggle-amend) + +(defun vc-git--log-edit-summary-check (limit) + (and (re-search-forward "^Summary: " limit t) + (when-let ((regex + (cond ((and (natnump vc-git-log-edit-summary-max-len) + (natnump vc-git-log-edit-summary-target-len)) + (format ".\\{,%d\\}\\(.\\{,%d\\}\\)\\(.*\\)" + vc-git-log-edit-summary-target-len + (- vc-git-log-edit-summary-max-len + vc-git-log-edit-summary-target-len))) + ((natnump vc-git-log-edit-summary-max-len) + (format ".\\{,%d\\}\\(?2:.*\\)" + vc-git-log-edit-summary-max-len)) + ((natnump vc-git-log-edit-summary-target-len) + (format ".\\{,%d\\}\\(.*\\)" + vc-git-log-edit-summary-target-len))))) + (re-search-forward regex limit t)))) (define-derived-mode vc-git-log-edit-mode log-edit-mode "Log-Edit/git" "Major mode for editing Git log messages. -It is based on `log-edit-mode', and has Git-specific extensions.") +It is based on `log-edit-mode', and has Git-specific extensions." + (setq-local + log-edit-font-lock-keywords + (append log-edit-font-lock-keywords + '((vc-git--log-edit-summary-check + (1 'vc-git-log-edit-summary-target-warning prepend t) + (2 'vc-git-log-edit-summary-max-warning prepend t)))))) + +(defvar vc-git-patch-string nil) + +(defun vc-git-checkin-patch (patch-string comment) + (let ((vc-git-patch-string patch-string)) + (vc-git-checkin nil comment))) (defun vc-git-checkin (files comment &optional _rev) (let* ((file1 (or (car files) default-directory)) @@ -941,12 +1016,21 @@ It is based on `log-edit-mode', and has Git-specific extensions.") (if (eq system-type 'windows-nt) (let ((default-directory (file-name-directory file1))) (make-nearby-temp-file "git-msg"))))) + (when vc-git-patch-string + (unless (zerop (vc-git-command nil t nil "diff" "--cached" "--quiet")) + (user-error "Index not empty")) + (let ((patch-file (make-temp-file "git-patch"))) + (with-temp-file patch-file + (insert vc-git-patch-string)) + (unwind-protect + (vc-git-command nil 0 patch-file "apply" "--cached") + (delete-file patch-file)))) (cl-flet ((boolean-arg-fn (argument) (lambda (value) (when (equal value "yes") (list argument))))) ;; When operating on the whole tree, better pass "-a" than ".", since "." ;; fails when we're committing a merge. - (apply #'vc-git-command nil 0 (if only files) + (apply #'vc-git-command nil 0 (if (and only (not vc-git-patch-string)) files) (nconc (if msg-file (list "commit" "-F" (file-local-name msg-file)) (list "commit" "-m")) @@ -964,7 +1048,8 @@ It is based on `log-edit-mode', and has Git-specific extensions.") (write-region (car args) nil msg-file)) (setq args (cdr args))) args) - (if only (list "--only" "--") '("-a"))))) + (unless vc-git-patch-string + (if only (list "--only" "--") '("-a")))))) (if (and msg-file (file-exists-p msg-file)) (delete-file msg-file)))) (defun vc-git-find-revision (file rev buffer) @@ -1487,13 +1572,25 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"." (expand-file-name fname (vc-git-root default-directory)))) revision))))) -;;; TAG SYSTEM +;;; TAG/BRANCH SYSTEM + +(declare-function vc-read-revision "vc" + (prompt &optional files backend default initial-input)) (defun vc-git-create-tag (dir name branchp) - (let ((default-directory dir)) - (and (vc-git-command nil 0 nil "update-index" "--refresh") + (let ((default-directory dir) + (start-point (when branchp (vc-read-revision + (format-prompt "Start point" + (car (vc-git-branches))) + (list dir) 'Git)))) + (and (or (zerop (vc-git-command nil t nil "update-index" "--refresh")) + (y-or-n-p "Modified files exist. Proceed? ") + (user-error (format "Can't create %s with modified files" + (if branchp "branch" "tag")))) (if branchp - (vc-git-command nil 0 nil "checkout" "-b" name) + (vc-git-command nil 0 nil "checkout" "-b" name + (when (and start-point (not (eq start-point ""))) + start-point)) (vc-git-command nil 0 nil "tag" name))))) (defun vc-git-retrieve-tag (dir name _update) @@ -1597,7 +1694,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 +1777,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 +1790,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 +1822,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 +1963,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..f4a44df3c29 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 @@ -908,7 +907,7 @@ if we don't understand a construct, we signal ;; should cover the common cases. Remember that we fall back ;; to regular hg commands if we see something we don't like. (save-restriction - (narrow-to-region (point) (point-at-eol)) + (narrow-to-region (point) (line-end-position)) (cond ((looking-at "[ \t]*\\(?:#.*\\)?$")) ((looking-at "syntax:[ \t]*re[ \t]*$") (setf default-syntax 'vc-hg--hgignore-add-pcre)) @@ -967,7 +966,7 @@ REPO must be the directory name of an hg repository." (attr (file-attributes (nth 0 fs))) (current-mtime (file-attribute-modification-time attr)) (current-size (file-attribute-size attr))) - (unless (and (equal saved-mtime current-mtime) + (unless (and (time-equal-p saved-mtime current-mtime) (equal saved-size current-size)) (setf valid nil)))) valid)) @@ -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 @@ -1039,11 +1037,12 @@ Avoids the need to repeatedly scan dirstate on repeated calls to ) (if (and cache (equal dirstate (pop cache)) - (equal mtime (pop cache)) + (time-equal-p mtime (pop cache)) (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)))) @@ -1178,10 +1177,9 @@ If toggling on, also insert its message into the buffer." standard-output 1 nil "log" "--limit=1" "--template" "{desc}"))))) -(defvar vc-hg-log-edit-mode-map - (let ((map (make-sparse-keymap "Hg-Log-Edit"))) - (define-key map "\C-c\C-e" #'vc-hg-log-edit-toggle-amend) - map)) +(defvar-keymap vc-hg-log-edit-mode-map + :name "Hg-Log-Edit" + "C-c C-e" #'vc-hg-log-edit-toggle-amend) (define-derived-mode vc-hg-log-edit-mode log-edit-mode "Log-Edit/hg" "Major mode for editing Hg log messages. @@ -1263,9 +1261,7 @@ REV is the revision to check out into WORKFILE." ;;; Hg specific functionality. -(defvar vc-hg-extra-menu-map - (let ((map (make-sparse-keymap))) - map)) +(defvar-keymap vc-hg-extra-menu-map) (defun vc-hg-extra-menu () vc-hg-extra-menu-map) diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index ee295b17c73..7f0d9e4d862 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." @@ -639,9 +631,10 @@ Before doing that, check if there are any old backups and get rid of them." (cond ((null backend)) ((eq (vc-checkout-model backend (list file)) 'implicit) - ;; If the file was saved in the same second in which it was + ;; If the file was saved at the same time that it was ;; checked out, clear the checkout-time to avoid confusion. - (if (equal (vc-file-getprop file 'vc-checkout-time) + (if (time-equal-p + (vc-file-getprop file 'vc-checkout-time) (file-attribute-modification-time (file-attributes file))) (vc-file-setprop file 'vc-checkout-time nil)) (if (vc-state-refresh file backend) @@ -798,9 +791,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 @@ -861,34 +855,34 @@ In the latter case, VC mode is deactivated for this buffer." ;; Autoloading works fine, but it prevents shortcuts from appearing ;; in the menu because they don't exist yet when the menu is built. ;; (autoload 'vc-prefix-map "vc" nil nil 'keymap) -(defvar vc-prefix-map - (let ((map (make-sparse-keymap))) - (define-key map "a" #'vc-update-change-log) - (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) - (define-key map "h" #'vc-region-history) - (define-key map "i" #'vc-register) - (define-key map "l" #'vc-print-log) - (define-key map "L" #'vc-print-root-log) - (define-key map "I" #'vc-log-incoming) - (define-key map "O" #'vc-log-outgoing) - (define-key map "ML" #'vc-log-mergebase) - (define-key map "MD" #'vc-diff-mergebase) - (define-key map "m" #'vc-merge) - (define-key map "r" #'vc-retrieve-tag) - (define-key map "s" #'vc-create-tag) - (define-key map "u" #'vc-revert) - (define-key map "v" #'vc-next-action) - (define-key map "+" #'vc-update) - ;; I'd prefer some kind of symmetry with vc-update: - (define-key map "P" #'vc-push) - (define-key map "=" #'vc-diff) - (define-key map "D" #'vc-root-diff) - (define-key map "~" #'vc-revision-other-window) - (define-key map "x" #'vc-delete-file) - map)) +(defvar-keymap vc-prefix-map + "a" #'vc-update-change-log + "b c" #'vc-create-branch + "b l" #'vc-print-branch-log + "b s" #'vc-switch-branch + "d" #'vc-dir + "g" #'vc-annotate + "G" #'vc-ignore + "h" #'vc-region-history + "i" #'vc-register + "l" #'vc-print-log + "L" #'vc-print-root-log + "I" #'vc-log-incoming + "O" #'vc-log-outgoing + "M L" #'vc-log-mergebase + "M D" #'vc-diff-mergebase + "m" #'vc-merge + "r" #'vc-retrieve-tag + "s" #'vc-create-tag + "u" #'vc-revert + "v" #'vc-next-action + "+" #'vc-update + ;; I'd prefer some kind of symmetry with vc-update: + "P" #'vc-push + "=" #'vc-diff + "D" #'vc-root-diff + "~" #'vc-revision-other-window + "x" #'vc-delete-file) (fset 'vc-prefix-map vc-prefix-map) (define-key ctl-x-map "v" 'vc-prefix-map) @@ -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..08b53a7169f 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? @@ -224,12 +224,10 @@ RESULT is a list of conses (FILE . STATE) for directory DIR." (let (process-file-side-effects) (vc-svn-command "*vc*" 0 nil "info")) (let ((repo - (save-excursion - (and (progn - (set-buffer "*vc*") - (goto-char (point-min)) - (re-search-forward "Repository Root: *\\(.*\\)" nil t)) - (match-string 1))))) + (with-current-buffer "*vc*" + (goto-char (point-min)) + (when (re-search-forward "Repository Root: *\\(.*\\)" nil t) + (match-string 1))))) (concat (cond (repo (concat diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index bebd0946dee..39a5be6654b 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -247,6 +247,11 @@ ;; revision argument is only supported with some older VCSes, like ;; RCS and CVS, and is otherwise silently ignored. ;; +;; - checkin-patch (patch-string comment) +;; +;; Commit a single patch PATCH-STRING to this backend, bypassing +;; the changes in filesets. COMMENT is used as a check-in comment. +;; ;; * find-revision (file rev buffer) ;; ;; Fetch revision REV of file FILE and put it into BUFFER. @@ -419,7 +424,7 @@ ;; AND you'd like the current time considered to be anything besides ;; (vc-annotate-convert-time (current-time)) -- i.e. the current ;; time with hours, minutes, and seconds included. Probably safe to -;; ignore. Return the current-time, in units of fractional days. +;; ignore. Return the current time, in units of fractional days. ;; ;; - annotate-extract-revision-at-line () ;; @@ -444,7 +449,7 @@ ;; ;; Return the common ancestor between REV1 and REV2 revisions. -;; TAG SYSTEM +;; TAG/BRANCH SYSTEM ;; ;; - create-tag (dir name branchp) ;; @@ -459,8 +464,9 @@ ;; - retrieve-tag (dir name update) ;; ;; Retrieve the version tagged by NAME of all registered files at or below DIR. +;; If NAME is a branch name, switch to that branch. ;; If UPDATE is non-nil, then update buffers of any files in the -;; tag that are currently visited. The default implementation +;; tag/branch that are currently visited. The default implementation ;; does a sanity check whether there aren't any uncommitted changes at ;; or below DIR, and then performs a tree walk, using the `checkout' ;; function to retrieve the corresponding revisions. @@ -659,8 +665,6 @@ ;; display the branch name in the mode-line. Replace ;; vc-cvs-sticky-tag with that. ;; -;; - Add a primitives for switching to a branch (creating it if required. -;; ;; - Add the ability to list tags and branches. ;; ;;;; Unify two different versions of the amend capability @@ -739,6 +743,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 +828,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 +942,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 +983,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 +1008,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) @@ -1034,7 +1049,8 @@ Within directories, only files already under version control are noticed." ((derived-mode-p 'log-edit-mode) log-edit-vc-backend) ((derived-mode-p 'diff-mode) diff-vc-backend) ;; Maybe we could even use comint-mode rather than shell-mode? - ((derived-mode-p 'dired-mode 'shell-mode 'compilation-mode) + ((derived-mode-p + 'dired-mode 'shell-mode 'eshell-mode 'compilation-mode) (ignore-errors (vc-responsible-backend default-directory))) (vc-mode (vc-backend buffer-file-name)))) @@ -1091,6 +1107,8 @@ BEWARE: this function may change the current buffer." (vc-dir-deduce-fileset state-model-only-files)) ((derived-mode-p 'dired-mode) (dired-vc-deduce-fileset state-model-only-files not-state-changing)) + ((derived-mode-p 'diff-mode) + (diff-vc-deduce-fileset)) ((setq backend (vc-backend buffer-file-name)) (if state-model-only-files (list backend (list buffer-file-name) @@ -1103,7 +1121,8 @@ BEWARE: this function may change the current buffer." (or (buffer-file-name vc-parent-buffer) (with-current-buffer vc-parent-buffer (or (derived-mode-p 'vc-dir-mode) - (derived-mode-p 'dired-mode))))) + (derived-mode-p 'dired-mode) + (derived-mode-p 'diff-mode))))) (progn ;FIXME: Why not `with-current-buffer'? --Stef. (set-buffer vc-parent-buffer) (vc-deduce-fileset-1 not-state-changing allow-unregistered state-model-only-files))) @@ -1188,7 +1207,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)) @@ -1215,6 +1238,8 @@ For old-style locking-based version control systems, like RCS: (error "Fileset files are missing, so cannot be operated on")) ((eq state 'ignored) (error "Fileset files are ignored by the version-control system")) + ((eq model 'patch) + (vc-checkin files backend nil nil nil (buffer-string))) ((or (null state) (eq state 'unregistered)) (cond (verbose (let ((backend (vc-read-backend "Backend to register to: "))) @@ -1600,13 +1625,14 @@ Type \\[vc-next-action] to check in changes.") ".\n") (message "Please explain why you stole the lock. Type C-c C-c when done."))) -(defun vc-checkin (files backend &optional comment initial-contents rev) +(defun vc-checkin (files backend &optional comment initial-contents rev patch-string) "Check in FILES. COMMENT is a comment string; if omitted, a buffer is popped up to accept a comment. If INITIAL-CONTENTS is non-nil, then COMMENT is used as the initial contents of the log entry buffer. The optional argument REV may be a string specifying the new revision level (only supported for some older VCSes, like RCS and CVS). +The optional argument PATCH-STRING is a string to check in as a patch. Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'." (run-hooks 'vc-before-checkin-hook) @@ -1628,7 +1654,9 @@ Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'." ;; vc-checkin-switches, but 'the' local buffer is ;; not a well-defined concept for filesets. (progn - (vc-call-backend backend 'checkin files comment rev) + (if patch-string + (vc-call-backend backend 'checkin-patch patch-string comment) + (vc-call-backend backend 'checkin files comment rev)) (mapc #'vc-delete-automatic-version-backups files)) `((vc-state . up-to-date) (vc-checkout-time . ,(file-attribute-modification-time @@ -1636,7 +1664,8 @@ Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'." (vc-working-revision . nil))) (message "Checking in %s...done" (vc-delistify files))) 'vc-checkin-hook - backend)) + backend + patch-string)) ;;; Additional entry points for examining version histories @@ -1716,27 +1745,74 @@ 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)))))) (defvar vc-diff-added-files nil "If non-nil, diff added files by comparing them to /dev/null.") +(defvar vc-patch-string nil) + +(defun vc-diff-patch-string (patch-string) + "Report diffs to be committed from the patch. +Like `vc-diff-internal' but uses PATCH-STRING to display +in the output buffer." + (let ((buffer "*vc-diff*")) + (vc-setup-buffer buffer) + (let ((buffer-undo-list t) + (inhibit-read-only t)) + (insert patch-string)) + (setq buffer-read-only t) + (diff-mode) + (setq-local diff-vc-backend (vc-responsible-backend default-directory)) + (setq-local revert-buffer-function + (lambda (_ _) (vc-diff-patch-string patch-string))) + (setq-local vc-patch-string patch-string) + (pop-to-buffer (current-buffer)) + (vc-run-delayed (vc-diff-finish (current-buffer) nil)))) + (defun vc-diff-internal (async vc-fileset rev1 rev2 &optional verbose buffer) "Report diffs between two revisions of a fileset. Output goes to the buffer BUFFER, which defaults to *vc-diff*. @@ -1754,7 +1830,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 +1873,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 +1895,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 +1944,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)) @@ -1924,19 +2002,20 @@ state of each file in the fileset." (when buffer-file-name (vc-buffer-sync not-urgent)))) ;;;###autoload -(defun vc-diff (&optional historic not-urgent) +(defun vc-diff (&optional historic not-urgent fileset) "Display diffs between file revisions. Normally this compares the currently selected fileset with their working revisions. With a prefix argument HISTORIC, it reads two revision designators specifying which revisions to compare. The optional argument NOT-URGENT non-nil means it is ok to say no to -saving the buffer." +saving the buffer. The optional argument FILESET can override the +deduced fileset." (interactive (list current-prefix-arg t)) (if historic (call-interactively 'vc-version-diff) (vc-maybe-buffer-sync not-urgent) - (let ((fileset (vc-deduce-fileset t))) + (let ((fileset (or fileset (vc-deduce-fileset t)))) (vc-buffer-sync-fileset fileset not-urgent) (vc-diff-internal t fileset nil nil (called-interactively-p 'interactive))))) @@ -2082,7 +2161,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) @@ -2250,7 +2329,7 @@ changes from the current branch." ((vc-find-backend-function backend 'merge-branch) (vc-call-backend backend 'merge-branch)) ;; Otherwise, do a per-file merge. - ((vc-find-backend-function backend 'merge) + ((vc-find-backend-function backend 'merge-file) (vc-buffer-sync) (dolist (file files) (let* ((state (vc-state file)) @@ -2353,7 +2432,23 @@ checked out in that new branch." (message "Making %s... done" (if branchp "branch" "tag"))) ;;;###autoload -(defun vc-retrieve-tag (dir name) +(defun vc-create-branch (dir name) + "Descending recursively from DIR, make a branch called NAME. +After a new branch is made, the files are checked out in that new branch. +Uses `vc-create-tag' with the non-nil arg `branchp'." + (interactive + (let ((granularity + (vc-call-backend (vc-responsible-backend default-directory) + 'revision-granularity))) + (list + (if (eq granularity 'repository) + default-directory + (read-directory-name "Directory: " default-directory default-directory t)) + (read-string "New branch name: " nil 'vc-revision-history)))) + (vc-create-tag dir name t)) + +;;;###autoload +(defun vc-retrieve-tag (dir name &optional branchp) "For each file in or below DIR, retrieve their tagged version NAME. NAME can name a branch, in which case this command will switch to the named branch in the directory DIR. @@ -2363,6 +2458,8 @@ If NAME is empty, it refers to the latest revisions of the current branch. If locking is used for the files in DIR, then there must not be any locked files at or below DIR (but if NAME is empty, locked files are allowed and simply skipped). +If the prefix argument BRANCHP is given, switch the branch +and check out the files in that branch. This function runs the hook `vc-retrieve-tag-hook' when finished." (interactive (let* ((granularity @@ -2378,15 +2475,21 @@ 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 + (if current-prefix-arg + "Switch to branch" + "Tag name to retrieve") + "latest revisions") (list dir) - (vc-responsible-backend dir))))) + (vc-responsible-backend dir)) + current-prefix-arg))) (let* ((backend (vc-responsible-backend dir)) (update (when (vc-call-backend backend 'update-on-retrieve-tag) (yes-or-no-p "Update any affected buffers? "))) (msg (if (or (not name) (string= name "")) (format "Updating %s... " (abbreviate-file-name dir)) - (format "Retrieving tag %s into %s... " + (format "Retrieving %s %s into %s... " + (if branchp "branch" "tag") name (abbreviate-file-name dir))))) (message "%s" msg) (vc-call-backend backend 'retrieve-tag dir name update) @@ -2394,6 +2497,25 @@ This function runs the hook `vc-retrieve-tag-hook' when finished." (run-hooks 'vc-retrieve-tag-hook) (message "%s" (concat msg "done")))) +;;;###autoload +(defun vc-switch-branch (dir name) + "Switch to the branch NAME in the directory DIR. +If NAME is empty, it refers to the latest revisions of the current branch. +Uses `vc-retrieve-tag' with the non-nil arg `branchp'." + (interactive + (let* ((granularity + (vc-call-backend (vc-responsible-backend default-directory) + 'revision-granularity)) + (dir + (if (eq granularity 'repository) + (expand-file-name (vc-root-dir)) + (read-directory-name "Directory: " default-directory nil t)))) + (list + dir + (vc-read-revision (format-prompt "Switch to branch" "latest revisions") + (list dir) + (vc-responsible-backend dir))))) + (vc-retrieve-tag dir name t)) ;; Miscellaneous other entry points @@ -2486,6 +2608,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 +2643,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,14 +2732,19 @@ 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) "Show the change log for BRANCH root in a window." (interactive - (list - (vc-read-revision "Branch to log: "))) + (let* ((backend (vc-responsible-backend default-directory)) + (rootdir (vc-call-backend backend 'root default-directory))) + (list + (vc-read-revision "Branch to log: " (list rootdir) backend)))) (when (equal branch "") (error "No branch specified")) (let* ((backend (vc-responsible-backend default-directory)) @@ -2743,7 +2874,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. @@ -3188,8 +3319,6 @@ to provide the `find-revision' operation instead." ;; These things should probably be generally available -(define-obsolete-function-alias 'vc-string-prefix-p 'string-prefix-p "24.3") - (defun vc-file-tree-walk (dirname func &rest args) "Walk recursively through DIRNAME. Invoke FUNC f ARGS on each VC-managed file f underneath it." |