From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Justin Bogner Newsgroups: gmane.emacs.devel Subject: [patch] vc-find-root with invert Date: Fri, 04 Jul 2008 11:47:51 -0600 Message-ID: <486E6247.3040300@justinbogner.com> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="------------030205090300090204030304" X-Trace: ger.gmane.org 1215193825 17292 80.91.229.12 (4 Jul 2008 17:50:25 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Fri, 4 Jul 2008 17:50:25 +0000 (UTC) To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Fri Jul 04 19:51:11 2008 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.50) id 1KEpR7-0001PY-5p for ged-emacs-devel@m.gmane.org; Fri, 04 Jul 2008 19:51:09 +0200 Original-Received: from localhost ([127.0.0.1]:59921 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1KEpQG-00005W-Ai for ged-emacs-devel@m.gmane.org; Fri, 04 Jul 2008 13:50:16 -0400 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1KEpO0-0007Hp-HY for emacs-devel@gnu.org; Fri, 04 Jul 2008 13:47:56 -0400 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1KEpNz-0007HJ-4g for emacs-devel@gnu.org; Fri, 04 Jul 2008 13:47:55 -0400 Original-Received: from [199.232.76.173] (port=48712 helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1KEpNy-0007HG-Td for emacs-devel@gnu.org; Fri, 04 Jul 2008 13:47:54 -0400 Original-Received: from mx1.yottayotta.com ([198.161.246.32]:2522) by monty-python.gnu.org with esmtps (TLS-1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.60) (envelope-from ) id 1KEpNy-0007Mt-2s for emacs-devel@gnu.org; Fri, 04 Jul 2008 13:47:54 -0400 Original-Received: from [192.168.1.2] (helo=edm-exchange.yottayotta.com) by mx1.yottayotta.com with esmtp (Exim 4.63) (envelope-from ) id 1KEpQK-0007A0-3O for emacs-devel@gnu.org; Fri, 04 Jul 2008 11:50:20 -0600 Original-Received: from jbogner.edmonton.yottayotta.com ([10.0.3.192]) by edm-exchange.yottayotta.com with Microsoft SMTPSVC(5.0.2195.6713); Fri, 4 Jul 2008 11:47:51 -0600 User-Agent: Thunderbird 2.0.0.14 (X11/20080505) X-OriginalArrivalTime: 04 Jul 2008 17:47:51.0530 (UTC) FILETIME=[147E1CA0:01C8DDFE] X-detected-kernel: by monty-python.gnu.org: Genre and OS details not recognized. X-Mailman-Approved-At: Fri, 04 Jul 2008 13:49:25 -0400 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:100348 Archived-At: This is a multi-part message in MIME format. --------------030205090300090204030304 Content-Type: text/plain; charset=ISO-8859-1; format=flowed Content-Transfer-Encoding: 7bit Here's a patch that fixes a bug I've noticed in vc-find-root. When called with `invert' equal to `t', the current implementation is returning `file' verbatim if a file name is given, and also if `witness' doesn't exist at all. In the former case we should return the directory where witness resides, and in the latter, `nil'. This patch implements such behaviour. --------------030205090300090204030304 Content-Type: text/x-diff; name="findroot.diff" Content-Transfer-Encoding: 7bit Content-Disposition: inline; filename="findroot.diff" diff --git a/lisp/ChangeLog b/lisp/ChangeLog index ee073bc..5473538 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2008-07-04 Justin Bogner + + * vc-hooks.el (vc-find-root): + Find the directory when using invert, not the file itself. + 2008-07-04 Dan Nicolaescu * vc-dir.el (vc-dir-query-replace-regexp): New function. diff --git a/lisp/vc-hooks.el b/lisp/vc-hooks.el index 2ccbdcc..0662961 100644 --- a/lisp/vc-hooks.el +++ b/lisp/vc-hooks.el @@ -327,39 +327,46 @@ The function walks up the directory tree from FILE looking for WITNESS. If WITNESS if not found, return nil, otherwise return the root. Optional arg INVERT non-nil reverses the sense of the check; the root is the last directory for which WITNESS *is* found." - ;; Represent /home/luser/foo as ~/foo so that we don't try to look for - ;; witnesses in /home or in /. - (setq file (abbreviate-file-name file)) - (let ((root nil) - (prev-file file) - ;; `user' is not initialized outside the loop because - ;; `file' may not exist, so we may have to walk up part of the - ;; hierarchy before we find the "initial UID". - (user nil) - try) - (while (not (or root - (null file) - ;; As a heuristic, we stop looking up the hierarchy of - ;; directories as soon as we find a directory belonging - ;; to another user. This should save us from looking in - ;; things like /net and /afs. This assumes that all the - ;; files inside a project belong to the same user. - (let ((prev-user user)) - (setq user (nth 2 (file-attributes file))) - (and prev-user (not (equal user prev-user)))) - (string-match vc-ignore-dir-regexp file))) - (setq try (file-exists-p (expand-file-name witness file))) - (cond ((and invert (not try)) (setq root prev-file)) - ((and (not invert) try) (setq root file)) - ((equal file (setq prev-file file - file (file-name-directory - (directory-file-name file)))) - (setq file nil)))) - ;; Handle the case where ~/WITNESS exists and the original FILE is "~". - ;; (This occurs, for example, when placing dotfiles under RCS.) - (when (and (not root) invert prev-file) - (setq root prev-file)) - root)) + (when (not (file-directory-p file)) + (setq file (file-name-directory file))) + ;; In the invert case, we should return nil if WITNESS doesn't exist + ;; in the first place. + (if (and invert + (not (file-exists-p (expand-file-name witness file)))) + nil + ;; Represent /home/luser/foo as ~/foo so that we don't try to look for + ;; witnesses in /home or in /. + (setq file (abbreviate-file-name file)) + (let ((root nil) + (prev-file file) + ;; `user' is not initialized outside the loop because + ;; `file' may not exist, so we may have to walk up part of the + ;; hierarchy before we find the "initial UID". + (user nil) + try) + (while (not (or root + (null file) + ;; As a heuristic, we stop looking up the hierarchy of + ;; directories as soon as we find a directory belonging + ;; to another user. This should save us from looking in + ;; things like /net and /afs. This assumes that all the + ;; files inside a project belong to the same user. + (let ((prev-user user)) + (setq user (nth 2 (file-attributes file))) + (and prev-user (not (equal user prev-user)))) + (string-match vc-ignore-dir-regexp file))) + (setq try (file-exists-p (expand-file-name witness file))) + (cond ((and invert (not try)) (setq root prev-file)) + ((and (not invert) try) (setq root file)) + ((equal file (setq prev-file file + file (file-name-directory + (directory-file-name file)))) + (setq file nil)))) + ;; Handle the case where ~/WITNESS exists and the original FILE is "~". + ;; (This occurs, for example, when placing dotfiles under RCS.) + (when (and (not root) invert prev-file) + (setq root prev-file)) + root))) ;; Access functions to file properties ;; (Properties should be _set_ using vc-file-setprop, but --------------030205090300090204030304--