From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.ciao.gmane.io!not-for-mail From: Juri Linkov Newsgroups: gmane.emacs.bugs Subject: bug#34949: 27.0.50; Docstring of `vc-deduce-fileset' incomplete Date: Fri, 13 Mar 2020 00:43:18 +0200 Organization: LINKOV.NET Message-ID: <87k13pkxdl.fsf@mail.linkov.net> References: <87imk35uy6.fsf@mail.linkov.net> <87v9o0kg1f.fsf@mail.linkov.net> <32b1f22f-1ac9-7fd2-0377-4c2d7ae43afd@yandex.ru> <87sgj2np8k.fsf@mail.linkov.net> <8736b06f60.fsf@mail.linkov.net> <87sgizy16y.fsf@mail.linkov.net> <1f31a329-eaee-f704-9a58-1b048a6ee636@yandex.ru> <87fteyl64x.fsf@mail.linkov.net> <47fcc86a-a884-0658-d1cb-8666704924e8@yandex.ru> <87o8tkgbe2.fsf@mail.linkov.net> <8736avy640.fsf@mail.linkov.net> <76e52ade-bb44-427a-0910-3fe3cf65bf6d@yandex.ru> <87a751uonw.fsf@mail.linkov.net> <9bab3a53-ec31-3300-132f-dc1e17ee0c53@yandex.ru> <875zfd9lzm.fsf@mail.linkov.net> <87mu8mieve.fsf@mail.linkov.net> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="ciao.gmane.io:159.69.161.202"; logging-data="11888"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/28.0.50 (x86_64-pc-linux-gnu) Cc: Lars Ingebrigtsen , 34949@debbugs.gnu.org To: Dmitry Gutov Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Thu Mar 12 23:46:43 2020 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1jCWbC-0002sQ-4v for geb-bug-gnu-emacs@m.gmane-mx.org; Thu, 12 Mar 2020 23:46:42 +0100 Original-Received: from localhost ([::1]:51430 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jCWbB-0005Pa-5o for geb-bug-gnu-emacs@m.gmane-mx.org; Thu, 12 Mar 2020 18:46:41 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:53004) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jCWab-0005Ow-N3 for bug-gnu-emacs@gnu.org; Thu, 12 Mar 2020 18:46:09 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1jCWaZ-0005vT-09 for bug-gnu-emacs@gnu.org; Thu, 12 Mar 2020 18:46:05 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:51950) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1jCWaY-0005v6-Ip for bug-gnu-emacs@gnu.org; Thu, 12 Mar 2020 18:46:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1jCWaY-0005DM-G7 for bug-gnu-emacs@gnu.org; Thu, 12 Mar 2020 18:46:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Juri Linkov Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Thu, 12 Mar 2020 22:46:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 34949 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: confirmed Original-Received: via spool by 34949-submit@debbugs.gnu.org id=B34949.158405312619987 (code B ref 34949); Thu, 12 Mar 2020 22:46:02 +0000 Original-Received: (at 34949) by debbugs.gnu.org; 12 Mar 2020 22:45:26 +0000 Original-Received: from localhost ([127.0.0.1]:57923 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jCWZx-0005CI-1v for submit@debbugs.gnu.org; Thu, 12 Mar 2020 18:45:26 -0400 Original-Received: from bird.elm.relay.mailchannels.net ([23.83.212.17]:10536) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jCWZu-0005C7-2d for 34949@debbugs.gnu.org; Thu, 12 Mar 2020 18:45:23 -0400 X-Sender-Id: dreamhost|x-authsender|jurta@jurta.org Original-Received: from relay.mailchannels.net (localhost [127.0.0.1]) by relay.mailchannels.net (Postfix) with ESMTP id 9FD35501C7E; Thu, 12 Mar 2020 22:45:20 +0000 (UTC) Original-Received: from pdx1-sub0-mail-a79.g.dreamhost.com (100-96-38-113.trex.outbound.svc.cluster.local [100.96.38.113]) (Authenticated sender: dreamhost) by relay.mailchannels.net (Postfix) with ESMTPA id 04C6150181D; Thu, 12 Mar 2020 22:45:20 +0000 (UTC) X-Sender-Id: dreamhost|x-authsender|jurta@jurta.org Original-Received: from pdx1-sub0-mail-a79.g.dreamhost.com ([TEMPUNAVAIL]. [64.90.62.162]) (using TLSv1.2 with cipher DHE-RSA-AES256-GCM-SHA384) by 0.0.0.0:2500 (trex/5.18.5); Thu, 12 Mar 2020 22:45:20 +0000 X-MC-Relay: Neutral X-MailChannels-SenderId: dreamhost|x-authsender|jurta@jurta.org X-MailChannels-Auth-Id: dreamhost X-Power-Reaction: 79a9a1c1103451f1_1584053120261_350448826 X-MC-Loop-Signature: 1584053120261:1454608894 X-MC-Ingress-Time: 1584053120260 Original-Received: from pdx1-sub0-mail-a79.g.dreamhost.com (localhost [127.0.0.1]) by pdx1-sub0-mail-a79.g.dreamhost.com (Postfix) with ESMTP id ACC7683ED0; Thu, 12 Mar 2020 15:45:18 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=linkov.net; h=from:to:cc :subject:references:date:in-reply-to:message-id:mime-version :content-type; s=linkov.net; bh=5zImJhiniWN08UuuB+iLhHHx+eE=; b= xFrodjBuE3Vwhq1wT6kNUuSQ4EXvTVnVMPhMmi2brAnS+n8KtC0yehAbMJRfRTuh XF4CawiH3i6CERawt9lDQOJFQvX0vT9vXC3wQNZyZH+HxqS1KswZ9VRcZVSOLhgX LDZkcc0jMGTdsqhsfE2k9/HpzyjOBddG9rN6ETt4KU4= Original-Received: from mail.jurta.org (m91-129-107-65.cust.tele2.ee [91.129.107.65]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) (Authenticated sender: jurta@jurta.org) by pdx1-sub0-mail-a79.g.dreamhost.com (Postfix) with ESMTPSA id 95C1083ED6; Thu, 12 Mar 2020 15:45:15 -0700 (PDT) X-DH-BACKEND: pdx1-sub0-mail-a79 In-Reply-To: <87mu8mieve.fsf@mail.linkov.net> (Juri Linkov's message of "Thu, 12 Mar 2020 02:41:25 +0200") X-VR-OUT-STATUS: OK X-VR-OUT-SCORE: -100 X-VR-OUT-SPAMCAUSE: gggruggvucftvghtrhhoucdtuddrgedugedruddvhedgudeiiecutefuodetggdotefrodftvfcurfhrohhfihhlvgemucggtfgfnhhsuhgsshgtrhhisggvpdfftffgtefojffquffvnecuuegrihhlohhuthemuceftddtnecusecvtfgvtghiphhivghnthhsucdlqddutddtmdenucfjughrpefhvffuohhfffgjkfgfgggtsehmtderredtredtnecuhfhrohhmpefluhhrihcunfhinhhkohhvuceojhhurhhisehlihhnkhhovhdrnhgvtheqnecukfhppeeluddruddvledruddtjedrieehnecuvehluhhsthgvrhfuihiivgeptdenucfrrghrrghmpehmohguvgepshhmthhppdhhvghlohepmhgrihhlrdhjuhhrthgrrdhorhhgpdhinhgvthepledurdduvdelrddutdejrdeihedprhgvthhurhhnqdhprghthheplfhurhhiucfnihhnkhhovhcuoehjuhhriheslhhinhhkohhvrdhnvghtqedpmhgrihhlfhhrohhmpehjuhhriheslhhinhhkohhvrdhnvghtpdhnrhgtphhtthhopegughhuthhovheshigrnhguvgigrdhruh X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.io gmane.emacs.bugs:177236 Archived-At: --=-=-= Content-Type: text/plain > I don't say it's a bad thing, just will make the patch 10 times longer. Ok, here's the patch that is 10 times longer. It creates a new function vc-use-vc-dir-on-files called from vc-next-action that checks whether the buffer is Dired with marked directories, and for optimization returns a list of files to give to vc-dir via a new arg MARK-FILES. Then vc-dir let-binds the global variable use-mark-files exactly the same way as already let-binds use-vc-backend since there is no other way. Then vc-dir-refresh puts all marks on files. Also the patch adds a new useful global keybinding 'C-x v V' bound to vc-next-action-on-root to open *vc-dir* buffer where all registered files are marked. --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=vc-use-vc-dir-on-files.patch diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index 38b4937e85..a2bf7c2a5a 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -1024,6 +1024,7 @@ vc-dir-resynch-file (dolist (b drop) (setq vc-dir-buffers (delq b vc-dir-buffers))))) (defvar use-vc-backend) ;; dynamically bound +(defvar use-mark-files) ;; dynamically bound (define-derived-mode vc-dir-mode special-mode "VC dir" "Major mode for VC directory buffers. @@ -1079,7 +1080,7 @@ vc-dir-mode ;; process running in the background is also killed. (add-hook 'kill-buffer-query-functions 'vc-dir-kill-query nil t) (hack-dir-local-variables-non-file-buffer) - (vc-dir-refresh))) + (vc-dir-refresh use-mark-files))) (defun vc-dir-headers (backend dir) "Display the headers in the *VC dir* buffer. @@ -1143,7 +1144,7 @@ vc-dir-refresh-files (defun vc-dir-revert-buffer-function (&optional _ignore-auto _noconfirm) (vc-dir-refresh)) -(defun vc-dir-refresh () +(defun vc-dir-refresh (&optional mark-files) "Refresh the contents of the *VC-dir* buffer. Throw an error if another update process is in progress." (interactive) @@ -1193,7 +1194,28 @@ vc-dir-refresh (if remaining (vc-dir-refresh-files (mapcar 'vc-dir-fileinfo->name remaining)) - (setq mode-line-process nil)))))))))))) + (setq mode-line-process nil) + (when mark-files + (let* ((backend (vc-responsible-backend default-directory)) + (rootdir (vc-call-backend backend 'root default-directory))) + (when (listp mark-files) + (setq mark-files (mapcar (lambda (file) + (file-relative-name + (if (file-directory-p file) + (file-name-as-directory file) + file) + rootdir)) + mark-files))) + (vc-dir-unmark-all-files t) + (ewoc-map + (lambda (filearg) + (when (cond ((consp mark-files) + (member (vc-dir-fileinfo->name filearg) mark-files)) + ((eq mark-files 'registered) + (memq (vc-dir-fileinfo->state filearg) '(edited added removed)))) + (setf (vc-dir-fileinfo->marked filearg) t) + t)) + vc-ewoc)))))))))))))) (defun vc-dir-show-fileentry (file) "Insert an entry for a specific file into the current *VC-dir* listing. @@ -1287,7 +1309,7 @@ vc-dir-deduce-fileset (list vc-dir-backend files only-files-list state model))) ;;;###autoload -(defun vc-dir (dir &optional backend) +(defun vc-dir (dir &optional backend mark-files) "Show the VC status for \"interesting\" files in and below DIR. This allows you to mark files and perform VC operations on them. The list omits files which are up to date, with no changes in your copy @@ -1326,9 +1348,10 @@ vc-dir (let (pop-up-windows) ; based on cvs-examine; bug#6204 (pop-to-buffer (vc-dir-prepare-status-buffer "*vc-dir*" dir backend))) (if (derived-mode-p 'vc-dir-mode) - (vc-dir-refresh) + (vc-dir-refresh mark-files) ;; FIXME: find a better way to pass the backend to `vc-dir-mode'. - (let ((use-vc-backend backend)) + (let ((use-vc-backend backend) + (use-mark-files mark-files)) (vc-dir-mode)))) (defun vc-default-dir-extra-headers (_backend _dir) diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index 345a28d3f1..80c580e5ec 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -897,6 +897,7 @@ vc-prefix-map (define-key map "s" 'vc-create-tag) (define-key map "u" 'vc-revert) (define-key map "v" 'vc-next-action) + (define-key map "V" 'vc-next-action-on-root) (define-key map "+" 'vc-update) ;; I'd prefer some kind of symmetry with vc-update: (define-key map "P" 'vc-push) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 607fb37807..3b20a917f5 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1132,8 +1132,18 @@ vc-read-backend (completing-read prompt (mapcar #'symbol-name vc-handled-backends) nil 'require-match))) +(defun vc-next-action-on-root () + (interactive) + (vc-dir (vc-root-dir) nil 'registered)) + ;; Here's the major entry point. +(defun vc-use-vc-dir-on-files () + (when (derived-mode-p 'dired-mode) + (let ((files (dired-get-marked-files nil nil nil nil t))) + (when (cl-some #'file-directory-p files) + files)))) + ;;;###autoload (defun vc-next-action (verbose) "Do the next logical version control operation on the current fileset. @@ -1158,184 +1168,187 @@ vc-next-action If every file is locked by you and unchanged, unlock them. If every file is locked by someone else, offer to steal the lock." (interactive "P") - (let* ((vc-fileset (vc-deduce-fileset nil t 'state-model-only-files)) - (backend (car vc-fileset)) - (files (nth 1 vc-fileset)) - ;; (fileset-only-files (nth 2 vc-fileset)) - ;; FIXME: We used to call `vc-recompute-state' here. - (state (nth 3 vc-fileset)) - ;; The backend should check that the checkout-model is consistent - ;; among all the `files'. - (model (nth 4 vc-fileset))) + (let ((mark-files (vc-use-vc-dir-on-files))) + (if mark-files + (vc-dir (vc-root-dir) nil mark-files) + (let* ((vc-fileset (vc-deduce-fileset nil t 'state-model-only-files)) + (backend (car vc-fileset)) + (files (nth 1 vc-fileset)) + ;; (fileset-only-files (nth 2 vc-fileset)) + ;; FIXME: We used to call `vc-recompute-state' here. + (state (nth 3 vc-fileset)) + ;; The backend should check that the checkout-model is consistent + ;; among all the `files'. + (model (nth 4 vc-fileset))) - ;; If a buffer has unsaved changes, a checkout would discard those - ;; changes, so treat the buffer as having unlocked changes. - (when (and (not (eq model 'implicit)) (eq state 'up-to-date)) - (dolist (file files) - (let ((buffer (get-file-buffer file))) - (and buffer - (buffer-modified-p buffer) - (setq state 'unlocked-changes))))) - - ;; Do the right thing. - (cond - ((eq state 'missing) - (error "Fileset files are missing, so cannot be operated on")) - ((eq state 'ignored) - (error "Fileset files are ignored by the version-control system")) - ((or (null state) (eq state 'unregistered)) - (vc-register vc-fileset)) - ;; Files are up-to-date, or need a merge and user specified a revision - ((or (eq state 'up-to-date) (and verbose (eq state 'needs-update))) - (cond - (verbose - ;; Go to a different revision. - (let* ((revision - ;; FIXME: Provide completion. - (read-string "Branch, revision, or backend to move to: ")) - (revision-downcase (downcase revision))) - (if (member - revision-downcase - (mapcar (lambda (arg) (downcase (symbol-name arg))) - vc-handled-backends)) - (let ((vsym (intern-soft revision-downcase))) - (dolist (file files) (vc-transfer-file file vsym))) - (dolist (file files) - (vc-checkout file revision))))) - ((not (eq model 'implicit)) - ;; check the files out - (dolist (file files) (vc-checkout file))) - (t - ;; do nothing - (message "Fileset is up-to-date")))) - ;; Files have local changes - ((vc-compatible-state state 'edited) - (let ((ready-for-commit files)) - ;; CVS, SVN and bzr don't care about read-only (bug#9781). - ;; RCS does, SCCS might (someone should check...). - (when (memq backend '(RCS SCCS)) - ;; If files are edited but read-only, give user a chance to correct. - (dolist (file files) - ;; 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)) - (error "Aborted")) - ;; 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 - (read-only-mode -1))))))) - ;; Allow user to revert files with no changes - (save-excursion + ;; If a buffer has unsaved changes, a checkout would discard those + ;; changes, so treat the buffer as having unlocked changes. + (when (and (not (eq model 'implicit)) (eq state 'up-to-date)) (dolist (file files) - (let ((visited (get-file-buffer file))) - ;; For files with locking, if the file does not contain - ;; any changes, just let go of the lock, i.e. revert. - (when (and (not (eq model 'implicit)) - (eq state 'up-to-date) - ;; If buffer is modified, that means the user just - ;; said no to saving it; in that case, don't revert, - ;; because the user might intend to save after - ;; finishing the log entry and committing. - (not (and visited (buffer-modified-p)))) - (vc-revert-file file) - (setq ready-for-commit (delete file ready-for-commit)))))) - ;; Remaining files need to be committed - (if (not ready-for-commit) - (message "No files remain to be committed") - (if (not verbose) - (vc-checkin ready-for-commit backend) - (let* ((revision (read-string "New revision or backend: ")) + (let ((buffer (get-file-buffer file))) + (and buffer + (buffer-modified-p buffer) + (setq state 'unlocked-changes))))) + + ;; Do the right thing. + (cond + ((eq state 'missing) + (error "Fileset files are missing, so cannot be operated on")) + ((eq state 'ignored) + (error "Fileset files are ignored by the version-control system")) + ((or (null state) (eq state 'unregistered)) + (vc-register vc-fileset)) + ;; Files are up-to-date, or need a merge and user specified a revision + ((or (eq state 'up-to-date) (and verbose (eq state 'needs-update))) + (cond + (verbose + ;; Go to a different revision. + (let* ((revision + ;; FIXME: Provide completion. + (read-string "Branch, revision, or backend to move to: ")) (revision-downcase (downcase revision))) - (if (member - revision-downcase - (mapcar (lambda (arg) (downcase (symbol-name arg))) - vc-handled-backends)) - (let ((vsym (intern revision-downcase))) - (dolist (file files) (vc-transfer-file file vsym))) - (vc-checkin ready-for-commit backend nil nil revision))))))) - ;; locked by somebody else (locking VCSes only) - ((stringp state) - ;; In the old days, we computed the revision once and used it on - ;; the single file. Then, for the 2007-2008 fileset rewrite, we - ;; computed the revision once (incorrectly, using a free var) and - ;; used it on all files. To fix the free var bug, we can either - ;; use `(car files)' or do what we do here: distribute the - ;; revision computation among `files'. Although this may be - ;; tedious for those backends where a "revision" is a trans-file - ;; concept, it is nonetheless correct for both those and (more - ;; importantly) for those where "revision" is a per-file concept. - ;; If the intersection of the former group and "locking VCSes" is - ;; non-empty [I vaguely doubt it --ttn], we can reinstate the - ;; pre-computation approach of yore. - (dolist (file files) - (vc-steal-lock - file (if verbose - (read-string (format "%s revision to steal: " file)) - (vc-working-revision file)) - state))) - ;; conflict - ((eq state 'conflict) - ;; FIXME: Is it really the UI we want to provide? - ;; In my experience, the conflicted files should be marked as resolved - ;; one-by-one when saving the file after resolving the conflicts. - ;; I.e. stating explicitly that the conflicts are resolved is done - ;; very rarely. - (vc-mark-resolved backend files)) - ;; needs-update - ((eq state 'needs-update) - (dolist (file files) - (if (yes-or-no-p (format - "%s is not up-to-date. Get latest revision? " - (file-name-nondirectory file))) - (vc-checkout file t) - (when (and (not (eq model 'implicit)) - (yes-or-no-p "Lock this revision? ")) - (vc-checkout file))))) - ;; needs-merge - ((eq state 'needs-merge) - (dolist (file files) - (when (yes-or-no-p (format - "%s is not up-to-date. Merge in changes now? " - (file-name-nondirectory file))) - (vc-maybe-resolve-conflicts - file (vc-call-backend backend 'merge-news file))))) + (if (member + revision-downcase + (mapcar (lambda (arg) (downcase (symbol-name arg))) + vc-handled-backends)) + (let ((vsym (intern-soft revision-downcase))) + (dolist (file files) (vc-transfer-file file vsym))) + (dolist (file files) + (vc-checkout file revision))))) + ((not (eq model 'implicit)) + ;; check the files out + (dolist (file files) (vc-checkout file))) + (t + ;; do nothing + (message "Fileset is up-to-date")))) + ;; Files have local changes + ((vc-compatible-state state 'edited) + (let ((ready-for-commit files)) + ;; CVS, SVN and bzr don't care about read-only (bug#9781). + ;; RCS does, SCCS might (someone should check...). + (when (memq backend '(RCS SCCS)) + ;; If files are edited but read-only, give user a chance to correct. + (dolist (file files) + ;; 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)) + (error "Aborted")) + ;; 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 + (read-only-mode -1))))))) + ;; Allow user to revert files with no changes + (save-excursion + (dolist (file files) + (let ((visited (get-file-buffer file))) + ;; For files with locking, if the file does not contain + ;; any changes, just let go of the lock, i.e. revert. + (when (and (not (eq model 'implicit)) + (eq state 'up-to-date) + ;; If buffer is modified, that means the user just + ;; said no to saving it; in that case, don't revert, + ;; because the user might intend to save after + ;; finishing the log entry and committing. + (not (and visited (buffer-modified-p)))) + (vc-revert-file file) + (setq ready-for-commit (delete file ready-for-commit)))))) + ;; Remaining files need to be committed + (if (not ready-for-commit) + (message "No files remain to be committed") + (if (not verbose) + (vc-checkin ready-for-commit backend) + (let* ((revision (read-string "New revision or backend: ")) + (revision-downcase (downcase revision))) + (if (member + revision-downcase + (mapcar (lambda (arg) (downcase (symbol-name arg))) + vc-handled-backends)) + (let ((vsym (intern revision-downcase))) + (dolist (file files) (vc-transfer-file file vsym))) + (vc-checkin ready-for-commit backend nil nil revision))))))) + ;; locked by somebody else (locking VCSes only) + ((stringp state) + ;; In the old days, we computed the revision once and used it on + ;; the single file. Then, for the 2007-2008 fileset rewrite, we + ;; computed the revision once (incorrectly, using a free var) and + ;; used it on all files. To fix the free var bug, we can either + ;; use `(car files)' or do what we do here: distribute the + ;; revision computation among `files'. Although this may be + ;; tedious for those backends where a "revision" is a trans-file + ;; concept, it is nonetheless correct for both those and (more + ;; importantly) for those where "revision" is a per-file concept. + ;; If the intersection of the former group and "locking VCSes" is + ;; non-empty [I vaguely doubt it --ttn], we can reinstate the + ;; pre-computation approach of yore. + (dolist (file files) + (vc-steal-lock + file (if verbose + (read-string (format "%s revision to steal: " file)) + (vc-working-revision file)) + state))) + ;; conflict + ((eq state 'conflict) + ;; FIXME: Is it really the UI we want to provide? + ;; In my experience, the conflicted files should be marked as resolved + ;; one-by-one when saving the file after resolving the conflicts. + ;; I.e. stating explicitly that the conflicts are resolved is done + ;; very rarely. + (vc-mark-resolved backend files)) + ;; needs-update + ((eq state 'needs-update) + (dolist (file files) + (if (yes-or-no-p (format + "%s is not up-to-date. Get latest revision? " + (file-name-nondirectory file))) + (vc-checkout file t) + (when (and (not (eq model 'implicit)) + (yes-or-no-p "Lock this revision? ")) + (vc-checkout file))))) + ;; needs-merge + ((eq state 'needs-merge) + (dolist (file files) + (when (yes-or-no-p (format + "%s is not up-to-date. Merge in changes now? " + (file-name-nondirectory file))) + (vc-maybe-resolve-conflicts + file (vc-call-backend backend 'merge-news file))))) - ;; unlocked-changes - ((eq state 'unlocked-changes) - (dolist (file files) - (when (not (equal buffer-file-name file)) - (find-file-other-window file)) - (if (save-window-excursion - (vc-diff-internal nil - (cons (car vc-fileset) (cons (cadr vc-fileset) (list file))) - (vc-working-revision file) nil) - (goto-char (point-min)) - (let ((inhibit-read-only t)) - (insert - (format "Changes to %s since last lock:\n\n" file))) - (not (beep)) - (yes-or-no-p (concat "File has unlocked changes. " - "Claim lock retaining changes? "))) - (progn (vc-call-backend backend 'steal-lock file) - (clear-visited-file-modtime) - (write-file buffer-file-name) - (vc-mode-line file backend)) - (if (not (yes-or-no-p - "Revert to checked-in revision, instead? ")) - (error "Checkout aborted") - (vc-revert-buffer-internal t t) - (vc-checkout file))))) - ;; Unknown fileset state - (t - (error "Fileset is in an unknown state %s" state))))) + ;; unlocked-changes + ((eq state 'unlocked-changes) + (dolist (file files) + (when (not (equal buffer-file-name file)) + (find-file-other-window file)) + (if (save-window-excursion + (vc-diff-internal nil + (cons (car vc-fileset) (cons (cadr vc-fileset) (list file))) + (vc-working-revision file) nil) + (goto-char (point-min)) + (let ((inhibit-read-only t)) + (insert + (format "Changes to %s since last lock:\n\n" file))) + (not (beep)) + (yes-or-no-p (concat "File has unlocked changes. " + "Claim lock retaining changes? "))) + (progn (vc-call-backend backend 'steal-lock file) + (clear-visited-file-modtime) + (write-file buffer-file-name) + (vc-mode-line file backend)) + (if (not (yes-or-no-p + "Revert to checked-in revision, instead? ")) + (error "Checkout aborted") + (vc-revert-buffer-internal t t) + (vc-checkout file))))) + ;; Unknown fileset state + (t + (error "Fileset is in an unknown state %s" state))))))) (defun vc-create-repo (backend) "Create an empty repository in the current directory." --=-=-=--