On Tue, 26 Feb 2008 21:31:28 -0700
Kevin Rodgers <kevin.d.rodgers@gmail.com> wrote:

> gamename wrote:
> > On Feb 25, 8:08 pm, Kevin Rodgers <kevin.d.rodg...@gmail.com> wrote:
> >> gamename wrote:
> >>> I often have to checkout multiple copies of the same source tree
> >>> from cvs.  For example, if I have a source tree 'foo' in cvs, I
> >>> may have 2 copies like ~/foo0/bar and ~/foo1/bar in my home
> >>> directory at the same time.  Each copy of the foo tree will have
> >>> a tags file in 'foo/tags'. Does anyone have code that will enable
> >>> emacs to determine which tags file to use based on the tree i'm
> >>> currently using?  For example, if I'm in foo1/bar, I would be
> >>> using the tags file in foo1/tags, not foo0/ tags.  Is there code
> >>> to dynamically determine that?
>  >>
> >> Is it enough to make tags-file-name a buffer local variable, set
> >> appropriately for each file?  If so:
> >>
> >> (defun set-local-tags-file-name ()
> >>    (when (file-exists-p "tags")
> >>      (set (make-local-variable 'tags-file-name)
> >>          (expand-file-name "tags"))))
> >>
> >> (add-hook 'find-file-hook 'set-local-tags-file-name)
> > 
> > Thanks Kevin, but I don't think that scales very well.  If I have
> > thousands of files, that wouldn't be workable.
> 
> Actually, it scales perfectly well: No matter how many files you have,
> the hook is only run once for each file that you actually visit.
> 
> The question is: Does it actually work?  I see now that
> vist-tags-table explicitly provides a way to do the same thing, so
> perhaps this is better:
> 
> (defun set-local-tags-file-name ()
>    (when (file-exists-p "tags")
>      (visit-tags-table (expand-file-name "tags") t)))
> 

Actually that won't be all that useful as it will scope the tags table to the directory
of the file, instead of the entire source tree. If you use version control alot you
can find a good location for the tags table by ascending the FS tree looking for the
highest directory that is writable and under version control.

The code below will give you a sketch of the algorithm. It's all recursive so it will
hit the stack limit with valid inputs. But it might help you.

If your hook used a global structure that paired the loaded tags tables with their directory
you could cheaply determine a best table from the list to associate with a buffer.

If you know the root of the tree it's pretty easy to make up the commands to generate the table
when it is missing as well.

(defun prefix-strings (prefix list)
  "prefix all the strings of the list concatenating the result."
  (mapcar
    (lambda ( string )
      (concat prefix string))
    list))

(defun strip-list-last ( list )
  "strip the last element from a list"
  (if (consp (cdr list))
    (cons
      (car list)
      (strip-list-last (cdr list)))
    nil))

(defun ascend-to-checkout-root ( dir )
  "The recursive core of find-checkout-root. use that entry point instead."
  (if (and
        (file-accessible-directory-p dir)
        (file-writable-p (concat dir "/_")))

    ;; vc-backend is not robust with inputs. If a directory is given without a trailing
    ;; slash a nil value will be returned incorrectly for directories under version
    ;; control.

    (if (vc-backend dir)
      (lexical-let
        ((traverse (strip-list-last (split-string dir "/" t))))

        (if traverse
          (lexical-let
            ((found (ascend-to-checkout-root (prefix-strings "/" traverse))))
            (if (eq 't found)
              dir
              found))
          t))   ;; halt when list is exhausted
      t)        ;; halt when the directory is no longer under version control.
    t))         ;; halt when we don't have read and write permission for the directory.

(defun find-checkout-root ( dir )
  "Find the ancestor directory that is the root of the checkout containing DIR.

   Recursion halts on these conditions:
   * exhausted path.
   * directory is not: accesible,readable, and writable.
   * directory is not under version control according to vc-backend.
  "
  (lexical-let
    ((found (ascend-to-checkout-root dir)))
    (if (eq 't found)
      dir
      found)))

Cheers,
Mike Mattie