From: Justin Bogner <mail@justinbogner.com>
To: emacs-devel@gnu.org
Subject: [patch] vc-find-root with invert
Date: Fri, 04 Jul 2008 11:24:48 -0600 [thread overview]
Message-ID: <486E5CE0.5090004@justinbogner.com> (raw)
[-- Attachment #1: Type: text/plain, Size: 369 bytes --]
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.
[-- Attachment #2: findroot.diff --]
[-- Type: text/x-diff, Size: 4699 bytes --]
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 <mail@justinbogner.com>
+
+ * vc-hooks.el (vc-find-root):
+ Find the directory when using invert, not the file itself.
+
2008-07-04 Dan Nicolaescu <dann@ics.uci.edu>
* 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
next reply other threads:[~2008-07-04 17:24 UTC|newest]
Thread overview: 15+ messages / expand[flat|nested] mbox.gz Atom feed top
2008-07-04 17:24 Justin Bogner [this message]
2008-07-04 18:02 ` [patch] vc-find-root with invert Stefan Monnier
2008-07-04 18:06 ` Justin Bogner
2008-07-04 19:52 ` Stefan Monnier
2008-07-05 7:21 ` tomas
2008-07-21 16:27 ` Justin Bogner
2008-07-21 18:32 ` Stefan Monnier
2008-07-21 21:33 ` Justin Bogner
2008-07-21 22:00 ` David Kastrup
2008-07-21 22:23 ` Justin Bogner
2008-07-21 23:02 ` David Kastrup
2008-07-23 4:35 ` Justin Bogner
2008-07-23 19:35 ` Stefan Monnier
2008-07-22 2:56 ` Stefan Monnier
-- strict thread matches above, loose matches on Subject: below --
2008-07-04 17:47 Justin Bogner
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=486E5CE0.5090004@justinbogner.com \
--to=mail@justinbogner.com \
--cc=emacs-devel@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).