etags-table.el v1.0

[Scott Frazer]

This extension sets the tags table(s) based on the current file (inspired
by XEmacs’ etags handling).  ‘etags-table-alist’ is a list of lists, where
the car of each sublist is compared to the current filename.  If it matches,
all the rest of the list elements are put on ‘tags-table-list’.  If
‘etags-table-search-up-depth’ is an integer, the file path will be searched
upwards for a tags file.  If one is found, it will be added to the tags table
list; this is actually done first so the local TAGS file is at the head of
the list.

When you switch files and do something tag-related, the tags table list is
automatically recomputed.


;;; etags-table.el --- Set tags table(s) based on current file

;; Copyright (C) 2008  Scott Frazer

;; Author: Scott Frazer <address@hidden>
;; Maintainer: Scott Frazer <address@hidden>
;; Created: 28 Oct 2008
;; Version: 1.0
;; Keywords: etags tags tag

;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;; This extension sets the tags table(s) based on the current file.
;; `etags-table-alist' is a list of lists, where the car of each sublist is
;; compared to the current filename.  If it matches, all the rest of the list
;; elements are put on `tags-table-list'.  If `etags-table-search-up-depth' is
;; an integer, the file path will be searched upwards for a tags file.  If one
;; is found, it will be added to the tags table list; this is actually done
;; first so the local TAGS file is at the head of the list.
;;
;; When you switch files and do something tag-related, the tags table list is
;; automatically recomputed.

;;; Change log:
;;
;; 28 Oct 2008 -- v1.0
;;                Initial release

;;; Code:

(require 'custom)
(require 'etags)

;;;###autoload
(defgroup etags-table nil
  "*etags table"
  :group 'etags)

;;;###autoload
(defcustom etags-table-alist nil
  "*Map filename to tag file(s)

Example:

(setq etags-table-alist
      (list
       \'(\"/home/me/Projects/foo/.*\\\\.[ch]$\" \"/home/me/Projects/lib1/TAGS\" 
\"/home/me/Projects/lib2/TAGS\")
       \'(\"/home/me/Projects/bar/.*\\\\.py$\" 
\"/home/me/Projects/python/common/TAGS\")
       \'(\".*\\\\.[ch]$\" \"/usr/local/include/TAGS\")
       ))

A file named, for example, \"/home/me/Projects/foo/main.c\" would set the
`tags-table-list' to a list of:

\"/home/me/Projects/lib1/TAGS\"
\"/home/me/Projects/lib2/TAGS\"
\"/usr/local/include/TAGS\"

and possibly a local tags file at the head of the list if 
`etags-table-search-up-depth'
is non-nil.
"
  :group 'etags-table
  :type 'alist)

;;;###autoload
(defcustom etags-table-search-up-depth nil
  "*Max depth to search up for a tags file.  nil means don't search."
  :group 'etags-table
  :type 'integer)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun etags-table-build-table-list (filename)
  "Build tags table list based on a filename"
  (let (tables)

    ;; Search up
    (when etags-table-search-up-depth
      (let ((depth etags-table-search-up-depth)
            (dir (file-name-directory filename)))
        (while (and (>= depth 0) dir)
          (when (file-exists-p (concat dir "TAGS"))
            (setq tables (list (concat dir "TAGS")))
            (setq depth 0))
          (setq dir (directory-file-name dir))
          (setq depth (1- depth)))))

    ;; Go through mapping alist
    (mapc (lambda (mapping)
            (when (posix-string-match (car mapping) filename)
              (mapc (lambda (tag-file)
                      (add-to-list 'tables tag-file t))
                    (cdr mapping))))
          etags-table-alist)

    ;; Return result or the original list
    (or tables tags-table-list)))

(defun etags-table-recompute ()
  (when (and (or etags-table-alist etags-table-search-up-depth) 
(buffer-file-name))
    (setq tags-table-list (etags-table-build-table-list (buffer-file-name)))))

(defadvice visit-tags-table-buffer (before etags-table-recompute activate)
  "Recompute `tags-table-list'"
  (etags-table-recompute))

(defadvice tags-completion-table (before etags-table-clear-completion-table 
activate)
  "Clear the completion table (maybe)"
  (etags-table-recompute)
  (unless (equal tags-table-computed-list-for (mapcar 'tags-expand-table-name 
tags-table-list))
    (setq tags-completion-table nil)))

(eval-after-load "etags-select"
  '(progn
     (defadvice etags-select-get-tag-files (before etags-table-recompute 
activate)
       "Recompute `tags-table-list'"
       (etags-table-recompute))
     (defadvice etags-select-find-tag (before 
etags-table-clear-completion-table activate)
       "Clear the completion table (maybe)"
       (etags-table-recompute)
       (unless (equal tags-table-computed-list-for (mapcar 
'tags-expand-table-name tags-table-list))
         (setq tags-completion-table nil)))))

(provide 'etags-table)
;;; etags-table.el ends here