X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/8f1d2ef658f95549eb33fe5265f8f11c5129bece..ee7683ebb70c308e596103e379ef6b91d001eebc:/lisp/vc/vc.el diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index be0f568d30..eea1a99209 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -181,7 +181,7 @@ ;; * working-revision (file) ;; ;; Return the working revision of FILE. This is the revision fetched -;; by the last checkout or upate, not necessarily the same thing as the +;; by the last checkout or update, not necessarily the same thing as the ;; head or tip revision. Should return "0" for a file added but not yet ;; committed. ;; @@ -620,7 +620,7 @@ ;; buffer, if one is present, instead of adding to the ChangeLog. ;; ;; - When vc-next-action calls vc-checkin it could pre-fill the -;; *VC-log* buffer with some obvious items: the list of files that +;; *vc-log* buffer with some obvious items: the list of files that ;; were added, the list of files that were removed. If the diff is ;; available, maybe it could even call something like ;; `diff-add-change-log-entries-other-window' to create a detailed @@ -653,6 +653,7 @@ (require 'vc-hooks) (require 'vc-dispatcher) +(require 'ediff) (eval-when-compile (require 'cl) @@ -674,6 +675,8 @@ :type 'boolean :group 'vc) +(make-obsolete-variable 'vc-initial-comment "it has no effect." "23.2") + (defcustom vc-default-init-revision "1.1" "A string used as the default revision number when a new file is registered. This can be overridden by giving a prefix argument to \\[vc-register]. This @@ -774,6 +777,12 @@ See `run-hooks'." :type 'hook :group 'vc) +(defcustom vc-revert-show-diff t + "If non-nil, `vc-revert' shows a `vc-diff' buffer before querying." + :type 'boolean + :group 'vc + :version "24.1") + ;; Header-insertion hair (defcustom vc-static-header-alist @@ -1111,13 +1120,20 @@ merge in the changes into your working copy." ;; Files have local changes ((vc-compatible-state state 'edited) (let ((ready-for-commit files)) - ;; If files are edited but read-only, give user a chance to correct + ;; If files are edited but read-only, give user a chance to correct. (dolist (file files) - (unless (file-writable-p file) + ;; If committing a mix of removed and edited files, the + ;; fileset has state = 'edited. Rather than checking the + ;; state of each individual file in the fileset, it seems + ;; simplest to just check if the file exists. Bug#9781. + (when (and (file-exists-p file) (not (file-writable-p file))) ;; Make the file+buffer read-write. - (unless (y-or-n-p (format "%s is edited but read-only; make it writable and continue?" file)) + (unless (y-or-n-p (format "%s is edited but read-only; make it writable and continue? " file)) (error "Aborted")) - (set-file-modes file (logior (file-modes file) 128)) + ;; Maybe we somehow lost permissions on the directory. + (condition-case nil + (set-file-modes file (logior (file-modes file) 128)) + (error (error "Unable to make file writable"))) (let ((visited (get-file-buffer file))) (when visited (with-current-buffer visited @@ -1404,7 +1420,7 @@ Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'." (vc-start-logentry files comment initial-contents "Enter a change comment." - "*VC-log*" + "*vc-log*" (lambda () (vc-call-backend backend 'log-edit-mode)) (lexical-let ((rev rev)) @@ -1530,10 +1546,13 @@ to override the value of `vc-diff-switches' and `diff-switches'." (defvar vc-diff-added-files nil "If non-nil, diff added files by comparing them to /dev/null.") -(defun vc-diff-internal (async vc-fileset rev1 rev2 &optional verbose) +(defun vc-diff-internal (async vc-fileset rev1 rev2 &optional verbose buffer) "Report diffs between two revisions of a fileset. -Diff output goes to the *vc-diff* buffer. The function -returns t if the buffer had changes, nil otherwise." +Output goes to the buffer BUFFER, which defaults to *vc-diff*. +BUFFER, if non-nil, should be a buffer or a buffer name. +Return t if the buffer had changes, nil otherwise." + (unless buffer + (setq buffer "*vc-diff*")) (let* ((files (cadr vc-fileset)) (messages (cons (format "Finding changes in %s..." (vc-delistify files)) @@ -1545,7 +1564,7 @@ returns t if the buffer had changes, nil otherwise." ;; be to call the back end separately for each file. (coding-system-for-read (if files (vc-coding-system-for-diff (car files)) 'undecided))) - (vc-setup-buffer "*vc-diff*") + (vc-setup-buffer buffer) (message "%s" (car messages)) ;; Many backends don't handle well the case of a file that has been ;; added but not yet committed to the repo (notably CVS and Subversion). @@ -1570,13 +1589,13 @@ returns t if the buffer had changes, nil otherwise." (error "No revisions of %s exist" file) ;; We regard this as "changed". ;; Diff it against /dev/null. - (apply 'vc-do-command "*vc-diff*" + (apply 'vc-do-command buffer 1 "diff" file (append (vc-switches nil 'diff) '("/dev/null")))))) (setq files (nreverse filtered)))) (let ((vc-disable-async-diff (not async))) - (vc-call-backend (car vc-fileset) 'diff files rev1 rev2 "*vc-diff*")) - (set-buffer "*vc-diff*") + (vc-call-backend (car vc-fileset) 'diff files rev1 rev2 buffer)) + (set-buffer buffer) (if (and (zerop (buffer-size)) (not (get-buffer-process (current-buffer)))) ;; Treat this case specially so as not to pop the buffer. @@ -1592,10 +1611,13 @@ returns t if the buffer had changes, nil otherwise." ;; bindings are nicer for read only buffers. pcl-cvs does the ;; same thing. (setq buffer-read-only t) - (vc-exec-after `(vc-diff-finish ,(current-buffer) ',(when verbose - messages))) ;; Display the buffer, but at the end because it can change point. (pop-to-buffer (current-buffer)) + ;; The diff process may finish early, so call `vc-diff-finish' + ;; after `pop-to-buffer'; the former assumes the diff buffer is + ;; shown in some window. + (vc-exec-after `(vc-diff-finish ,(current-buffer) + ',(when verbose messages))) ;; In the async case, we return t even if there are no differences ;; because we don't know that yet. t))) @@ -1614,45 +1636,48 @@ returns t if the buffer had changes, nil otherwise." nil nil initial-input nil default) (read-string prompt initial-input nil default)))) +(defun vc-diff-build-argument-list-internal () + "Build argument list for calling internal diff functions." + (let* ((vc-fileset (vc-deduce-fileset t)) ;FIXME: why t? --Stef + (files (cadr vc-fileset)) + (backend (car vc-fileset)) + (first (car files)) + (rev1-default nil) + (rev2-default nil)) + (cond + ;; someday we may be able to do revision completion on non-singleton + ;; filesets, but not yet. + ((/= (length files) 1) + nil) + ;; if it's a directory, don't supply any revision default + ((file-directory-p first) + nil) + ;; if the file is not up-to-date, use working revision as older revision + ((not (vc-up-to-date-p first)) + (setq rev1-default (vc-working-revision first))) + ;; if the file is not locked, use last and previous revisions as defaults + (t + (setq rev1-default (vc-call-backend backend 'previous-revision first + (vc-working-revision first))) + (when (string= rev1-default "") (setq rev1-default nil)) + (setq rev2-default (vc-working-revision first)))) + ;; 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") "): ")) + (rev1 (vc-read-revision rev1-prompt files backend rev1-default)) + (rev2 (vc-read-revision rev2-prompt files backend rev2-default))) + (when (string= rev1 "") (setq rev1 nil)) + (when (string= rev2 "") (setq rev2 nil)) + (list files rev1 rev2)))) + ;;;###autoload (defun vc-version-diff (files rev1 rev2) "Report diffs between revisions of the fileset in the repository history." - (interactive - (let* ((vc-fileset (vc-deduce-fileset t)) ;FIXME: why t? --Stef - (files (cadr vc-fileset)) - (backend (car vc-fileset)) - (first (car files)) - (rev1-default nil) - (rev2-default nil)) - (cond - ;; someday we may be able to do revision completion on non-singleton - ;; filesets, but not yet. - ((/= (length files) 1) - nil) - ;; if it's a directory, don't supply any revision default - ((file-directory-p first) - nil) - ;; if the file is not up-to-date, use working revision as older revision - ((not (vc-up-to-date-p first)) - (setq rev1-default (vc-working-revision first))) - ;; if the file is not locked, use last and previous revisions as defaults - (t - (setq rev1-default (vc-call-backend backend 'previous-revision first - (vc-working-revision first))) - (when (string= rev1-default "") (setq rev1-default nil)) - (setq rev2-default (vc-working-revision first)))) - ;; 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") "): ")) - (rev1 (vc-read-revision rev1-prompt files backend rev1-default)) - (rev2 (vc-read-revision rev2-prompt files backend rev2-default))) - (when (string= rev1 "") (setq rev1 nil)) - (when (string= rev2 "") (setq rev2 nil)) - (list files rev1 rev2)))) + (interactive (vc-diff-build-argument-list-internal)) ;; All that was just so we could do argument completion! (when (and (not rev1) rev2) (error "Not a valid revision range")) @@ -1677,6 +1702,48 @@ saving the buffer." (vc-diff-internal t (vc-deduce-fileset t) nil nil (called-interactively-p 'interactive)))) +(declare-function ediff-vc-internal (rev1 rev2 &optional startup-hooks)) + +;;;###autoload +(defun vc-version-ediff (files rev1 rev2) + "Show differences between revisions of the fileset in the +repository history using ediff." + (interactive (vc-diff-build-argument-list-internal)) + ;; All that was just so we could do argument completion! + (when (and (not rev1) rev2) + (error "Not a valid revision range")) + + (message "%s" (format "Finding changes in %s..." (vc-delistify files))) + + ;; Functions ediff-(vc|rcs)-internal use "" instead of nil. + (when (null rev1) (setq rev1 "")) + (when (null rev2) (setq rev2 "")) + + (cond + ;; FIXME We only support running ediff on one file for now. + ;; We could spin off an ediff session per file in the file set. + ((= (length files) 1) + (ediff-load-version-control) + (find-file (car files)) ;FIXME: find-file from Elisp is bad. + (ediff-vc-internal rev1 rev2 nil)) + (t + (error "More than one file is not supported")))) + +;;;###autoload +(defun vc-ediff (historic &optional not-urgent) + "Display diffs between file revisions using ediff. +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." + (interactive (list current-prefix-arg t)) + (if historic + (call-interactively 'vc-version-ediff) + (when buffer-file-name (vc-buffer-sync not-urgent)) + (vc-version-ediff (cadr (vc-deduce-fileset t)) nil nil))) + ;;;###autoload (defun vc-root-diff (historic &optional not-urgent) "Display diffs between VC-controlled whole tree revisions. @@ -1818,7 +1885,7 @@ The headers are reset to their non-expanded form." (vc-start-logentry files oldcomment t "Enter a replacement change comment." - "*VC-log*" + "*vc-log*" (lambda () (vc-call-backend backend 'log-edit-mode)) (lexical-let ((rev rev)) (lambda (files comment) @@ -1954,7 +2021,7 @@ checked out in that new branch." ;; For VC's that do not work at file level, it's pointless ;; to ask for a directory, branches are created at repository level. default-directory - (read-file-name "Directory: " default-directory default-directory t)) + (read-directory-name "Directory: " default-directory default-directory t)) (read-string (if current-prefix-arg "New branch name: " "New tag name: ")) current-prefix-arg))) (message "Making %s... " (if branchp "branch" "tag")) @@ -1980,7 +2047,7 @@ allowed and simply skipped)." ;; For VC's that do not work at file level, it's pointless ;; to ask for a directory, branches are created at repository level. default-directory - (read-file-name "Directory: " default-directory default-directory t)) + (read-directory-name "Directory: " default-directory default-directory t)) (read-string "Tag name to retrieve (default latest revisions): ")))) (let ((update (yes-or-no-p "Update any affected buffers? ")) (msg (if (or (not name) (string= name "")) @@ -2014,22 +2081,20 @@ Not all VC backends support short logs!") (goto-char (point-max)) (lexical-let ((working-revision working-revision) (limit limit)) - (widget-create 'push-button - :notify (lambda (&rest ignore) - (vc-print-log-internal - log-view-vc-backend log-view-vc-fileset - working-revision nil (* 2 limit))) - :help-echo "Show the log again, and double the number of log entries shown" - "Show 2X entries") - (widget-insert " ") - (widget-create 'push-button - :notify (lambda (&rest ignore) - (vc-print-log-internal - log-view-vc-backend log-view-vc-fileset - working-revision nil nil)) - :help-echo "Show the log again, showing all entries" - "Show unlimited entries")) - (widget-setup))) + (insert "\n") + (insert-text-button "Show 2X entries" + 'action (lambda (&rest ignore) + (vc-print-log-internal + log-view-vc-backend log-view-vc-fileset + working-revision nil (* 2 limit))) + 'help-echo "Show the log again, and double the number of log entries shown") + (insert " ") + (insert-text-button "Show unlimited entries" + 'action (lambda (&rest ignore) + (vc-print-log-internal + log-view-vc-backend log-view-vc-fileset + working-revision nil nil)) + 'help-echo "Show the log again, including all entries")))) (defun vc-print-log-internal (backend files working-revision &optional is-start-revision limit) @@ -2209,11 +2274,12 @@ This asks for confirmation if the buffer contents are not identical to the working revision (except for keyword expansion)." (interactive) (let* ((vc-fileset (vc-deduce-fileset)) - (files (cadr vc-fileset))) - ;; If any of the files is visited by the current buffer, make - ;; sure buffer is saved. If the user says `no', abort since - ;; we cannot show the changes and ask for confirmation to - ;; discard them. + (files (cadr vc-fileset)) + (queried nil) + diff-buffer) + ;; If any of the files is visited by the current buffer, make sure + ;; buffer is saved. If the user says `no', abort since we cannot + ;; show the changes and ask for confirmation to discard them. (when (or (not files) (memq (buffer-file-name) files)) (vc-buffer-sync nil)) (dolist (file files) @@ -2221,20 +2287,28 @@ to the working revision (except for keyword expansion)." (when (and buf (buffer-modified-p buf)) (error "Please kill or save all modified buffers before reverting"))) (when (vc-up-to-date-p file) - (unless (yes-or-no-p (format "%s seems up-to-date. Revert anyway? " file)) + (if (yes-or-no-p (format "%s seems up-to-date. Revert anyway? " file)) + (setq queried t) (error "Revert canceled")))) - (when (vc-diff-internal vc-allow-async-revert vc-fileset nil nil) - (unless (yes-or-no-p - (format "Discard changes in %s? " - (let ((str (vc-delistify files)) - (nfiles (length files))) - (if (< (length str) 50) - str - (format "%d file%s" nfiles - (if (= nfiles 1) "" "s")))))) - (error "Revert canceled")) - (delete-windows-on "*vc-diff*") - (kill-buffer "*vc-diff*")) + (unwind-protect + (when (if vc-revert-show-diff + (progn + (setq diff-buffer (generate-new-buffer-name "*vc-diff*")) + (vc-diff-internal vc-allow-async-revert vc-fileset + nil nil nil diff-buffer)) + ;; Avoid querying the user again. + (null queried)) + (unless (yes-or-no-p + (format "Discard changes in %s? " + (let ((str (vc-delistify files)) + (nfiles (length files))) + (if (< (length str) 50) + str + (format "%d file%s" nfiles + (if (= nfiles 1) "" "s")))))) + (error "Revert canceled"))) + (when diff-buffer + (quit-windows-on diff-buffer t))) (dolist (file files) (message "Reverting %s..." (vc-delistify files)) (vc-revert-file file) @@ -2280,8 +2354,7 @@ depending on the underlying version-control system." ;; Display changes (unless (yes-or-no-p "Discard these revisions? ") (error "Rollback canceled")) - (delete-windows-on "*vc-diff*") - (kill-buffer"*vc-diff*") + (quit-windows-on "*vc-diff*" t) ;; Do the actual reversions (message "Rolling back %s..." (vc-delistify files)) (with-vc-properties @@ -2359,7 +2432,7 @@ its name; otherwise return nil." (list file) (let ((backup-file (vc-version-backup-file file))) (when backup-file - (copy-file backup-file file 'ok-if-already-exists 'keep-date) + (copy-file backup-file file 'ok-if-already-exists) (vc-delete-automatic-version-backups file)) (vc-call revert file backup-file)) `((vc-state . up-to-date) @@ -2616,11 +2689,8 @@ log entries should be gathered." (when index (substring rev 0 index)))) -(define-obsolete-function-alias - 'vc-default-previous-version 'vc-default-previous-revision "23.1") - (defun vc-default-responsible-p (backend file) - "Indicate whether BACKEND is reponsible for FILE. + "Indicate whether BACKEND is responsible for FILE. The default is to return nil always." nil)