New feature: etags-regen-mode
* lisp/progmodes/etags-regen.el: New file (bug#67687). * etc/NEWS: Mention the addition. * .dir-locals.el: Add this project's settings for etags-regen-regexp-alist and etags-regen-ignores.
This commit is contained in:
Dmitry Gutov
parent
0c5cfd0a23
commit
bdfa49502a
3 changed files with 442 additions and 0 deletions
|
|
@ -8,6 +8,12 @@
|
|||
(vc-git-annotate-switches . "-w")
|
||||
(bug-reference-url-format . "https://debbugs.gnu.org/%s")
|
||||
(diff-add-log-use-relative-names . t)
|
||||
(etags-regen-regexp-alist
|
||||
.
|
||||
((("c" "objc") .
|
||||
("/[ \t]*DEFVAR_[A-Z_ \t(]+\"\\([^\"]+\\)\"/\\1/"
|
||||
"/[ \t]*DEFVAR_[A-Z_ \t(]+\"[^\"]+\",[ \t]\\([A-Za-z0-9_]+\\)/\\1/"))))
|
||||
(etags-regen-ignores . ("test/manual/etags/"))
|
||||
(vc-prepare-patches-separately . nil)))
|
||||
(c-mode . ((c-file-style . "GNU")
|
||||
(c-noise-macro-names . ("INLINE" "NO_INLINE" "ATTRIBUTE_NO_SANITIZE_UNDEFINED"
|
||||
|
|
|
|||
5
etc/NEWS
5
etc/NEWS
|
|
@ -1265,6 +1265,11 @@ the needs of users with red-green or blue-yellow color deficiency.
|
|||
The Info manual "(modus-themes) Top" describes the details and
|
||||
showcases all their customization options.
|
||||
|
||||
** New global minor mode 'etags-regen-mode'.
|
||||
This minor mode generates the tags table automatically based on the
|
||||
current project configuration, and later updates it as you edit the
|
||||
files and save the changes.
|
||||
|
||||
|
||||
* Incompatible Lisp Changes in Emacs 30.1
|
||||
|
||||
|
|
|
|||
431
lisp/progmodes/etags-regen.el
Normal file
431
lisp/progmodes/etags-regen.el
Normal file
|
|
@ -0,0 +1,431 @@
|
|||
;;; etags-regen.el --- Auto-(re)regenerating tags -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2021-2023 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Dmitry Gutov <dmitry@gutov.dev>
|
||||
;; Keywords: tools
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs 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 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs 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. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Simple automatic tags generation with updates on save.
|
||||
;;
|
||||
;; This mode provides automatic indexing for Emacs "go to definition"
|
||||
;; feature, the `xref-go-forward' command (bound to `M-.' by default).
|
||||
;;
|
||||
;; At the moment reindexing works off before/after-save-hook, but to
|
||||
;; handle more complex changes (for example, the user switching to
|
||||
;; another branch from the terminal) we can look into plugging into
|
||||
;; something like `filenotify'.
|
||||
;;
|
||||
;; Note that this feature disables itself if the user has some tags
|
||||
;; table already visited (with `M-x visit-tags-table', or through an
|
||||
;; explicit prompt triggered by some feature that requires tags).
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
|
||||
(defgroup etags-regen nil
|
||||
"Auto-(re)generating tags."
|
||||
:group 'tools)
|
||||
|
||||
(defvar etags-regen--tags-file nil)
|
||||
(defvar etags-regen--tags-root nil)
|
||||
(defvar etags-regen--new-file nil)
|
||||
|
||||
(declare-function project-root "project")
|
||||
(declare-function project-files "project")
|
||||
(declare-function dired-glob-regexp "dired")
|
||||
|
||||
(defcustom etags-regen-program (executable-find "etags")
|
||||
"Name of the etags program used by `etags-regen-mode'.
|
||||
|
||||
If you only have `ctags' installed, you can also set this to
|
||||
\"ctags -e\". Some features might not be supported this way."
|
||||
;; Always having our 'etags' here would be easier, but we can't
|
||||
;; always rely on it being installed. So it might be ctags's etags.
|
||||
:type 'file
|
||||
:version "30.1")
|
||||
|
||||
(defcustom etags-regen-tags-file "TAGS"
|
||||
"Name of the tags file to create inside the project by `etags-regen-mode'.
|
||||
|
||||
The value should either be a simple file name (no directory
|
||||
specified), or a function that accepts the project root directory
|
||||
and returns a distinct absolute file name for its tags file. The
|
||||
latter possibility is useful when you prefer to store the tag
|
||||
files somewhere else, for example in `temporary-file-directory'."
|
||||
:type '(choice (string :tag "File name")
|
||||
(function :tag "Function that returns file name"))
|
||||
:version "30.1")
|
||||
|
||||
(defcustom etags-regen-program-options nil
|
||||
"List of additional options for etags program invoked by `etags-regen-mode'."
|
||||
:type '(repeat string)
|
||||
:version "30.1")
|
||||
|
||||
(defcustom etags-regen-regexp-alist nil
|
||||
"Mapping of languages to etags regexps for `etags-regen-mode'.
|
||||
|
||||
These regexps are used in addition to the tags made with the
|
||||
standard parsing based on the language.
|
||||
|
||||
The value must be a list where each element has the
|
||||
form (LANGUAGES . TAG-REGEXPS) where both LANGUAGES and
|
||||
TAG-REGEXPS are lists of strings.
|
||||
|
||||
Each language should be one of the recognized by etags, see
|
||||
`etags --help'. Each tag regexp should be a string in the format
|
||||
documented for the `--regex' arguments (without `{language}').
|
||||
|
||||
We currently support only Emacs's etags program with this option."
|
||||
:type '(repeat
|
||||
(cons
|
||||
:tag "Languages group"
|
||||
(repeat (string :tag "Language name"))
|
||||
(repeat (string :tag "Tag Regexp"))))
|
||||
:version "30.1")
|
||||
|
||||
;;;###autoload
|
||||
(put 'etags-regen-regexp-alist 'safe-local-variable
|
||||
(lambda (value)
|
||||
(and (listp value)
|
||||
(seq-every-p
|
||||
(lambda (group)
|
||||
(and (consp group)
|
||||
(listp (car group))
|
||||
(listp (cdr group))
|
||||
(seq-every-p #'stringp (car group))
|
||||
(seq-every-p #'stringp (cdr group))))
|
||||
value))))
|
||||
|
||||
;; We have to list all extensions: etags falls back to Fortran
|
||||
;; when it cannot determine the type of the file.
|
||||
;; http://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00323.html
|
||||
(defcustom etags-regen-file-extensions
|
||||
'("rb" "js" "py" "pl" "el" "c" "cpp" "cc" "h" "hh" "hpp"
|
||||
"java" "go" "cl" "lisp" "prolog" "php" "erl" "hrl"
|
||||
"F" "f" "f90" "for" "cs" "a" "asm" "ads" "adb" "ada")
|
||||
"Code file extensions for `etags-regen-mode'.
|
||||
|
||||
File extensions to generate the tags for."
|
||||
:type '(repeat (string :tag "File extension"))
|
||||
:version "30.1")
|
||||
|
||||
;;;###autoload
|
||||
(put 'etags-regen-file-extensions 'safe-local-variable
|
||||
(lambda (value) (and (listp value) (seq-every-p #'stringp value))))
|
||||
|
||||
;; FIXME: We don't support root anchoring yet.
|
||||
(defcustom etags-regen-ignores nil
|
||||
"Additional ignore rules, in the format of `project-ignores'."
|
||||
:type '(repeat
|
||||
(string :tag "Glob to ignore"))
|
||||
:version "30.1")
|
||||
|
||||
;;;###autoload
|
||||
(put 'etags-regen-ignores 'safe-local-variable
|
||||
(lambda (value) (and (listp value) (seq-every-p #'stringp value))))
|
||||
|
||||
(defvar etags-regen--errors-buffer-name "*etags-regen-tags-errors*")
|
||||
|
||||
(defvar etags-regen--rescan-files-limit 100)
|
||||
|
||||
(defun etags-regen--all-mtimes (proj)
|
||||
(let ((files (etags-regen--all-files proj))
|
||||
(mtimes (make-hash-table :test 'equal))
|
||||
file-name-handler-alist)
|
||||
(dolist (f files)
|
||||
(condition-case nil
|
||||
(puthash f
|
||||
(file-attribute-modification-time
|
||||
(file-attributes f))
|
||||
mtimes)
|
||||
(file-missing nil)))
|
||||
mtimes))
|
||||
|
||||
(defun etags-regen--choose-tags-file (proj)
|
||||
(if (functionp etags-regen-tags-file)
|
||||
(funcall etags-regen-tags-file (project-root proj))
|
||||
(expand-file-name etags-regen-tags-file (project-root proj))))
|
||||
|
||||
(defun etags-regen--refresh (proj)
|
||||
(save-excursion
|
||||
(let* ((tags-file (etags-regen--choose-tags-file proj))
|
||||
(tags-mtime (file-attribute-modification-time
|
||||
(file-attributes tags-file)))
|
||||
(all-mtimes (etags-regen--all-mtimes proj))
|
||||
added-files
|
||||
changed-files
|
||||
removed-files)
|
||||
(etags-regen--visit-table tags-file (project-root proj))
|
||||
(set-buffer (get-file-buffer tags-file))
|
||||
(dolist (file (tags-table-files))
|
||||
(let ((mtime (gethash file all-mtimes)))
|
||||
(cond
|
||||
((null mtime)
|
||||
(push file removed-files))
|
||||
((time-less-p tags-mtime mtime)
|
||||
(push file changed-files)
|
||||
(remhash file all-mtimes))
|
||||
(t
|
||||
(remhash file all-mtimes)))))
|
||||
(maphash
|
||||
(lambda (key _value)
|
||||
(push key added-files))
|
||||
all-mtimes)
|
||||
(if (> (+ (length added-files)
|
||||
(length changed-files)
|
||||
(length removed-files))
|
||||
etags-regen--rescan-files-limit)
|
||||
(progn
|
||||
(message "etags-regen: Too many changes, falling back to full rescan")
|
||||
(etags-regen--tags-cleanup))
|
||||
(dolist (file (nconc removed-files changed-files))
|
||||
(etags-regen--remove-tag file))
|
||||
(when (or changed-files added-files)
|
||||
(apply #'etags-regen--append-tags
|
||||
(nconc changed-files added-files)))
|
||||
(when (or changed-files added-files removed-files)
|
||||
(let ((save-silently t)
|
||||
(message-log-max nil))
|
||||
(save-buffer 0)))))))
|
||||
|
||||
(defun etags-regen--maybe-generate ()
|
||||
(let (proj)
|
||||
(when (and etags-regen--tags-root
|
||||
(not (file-in-directory-p default-directory
|
||||
etags-regen--tags-root)))
|
||||
(etags-regen--tags-cleanup))
|
||||
(when (and (not etags-regen--tags-root)
|
||||
;; If existing table is visited that's not generated by
|
||||
;; this mode, skip all functionality.
|
||||
(not (or tags-file-name
|
||||
tags-table-list))
|
||||
(file-exists-p (etags-regen--choose-tags-file
|
||||
(setq proj (project-current)))))
|
||||
(message "Found existing tags table, refreshing...")
|
||||
(etags-regen--refresh proj))
|
||||
(when (and (not (or tags-file-name
|
||||
tags-table-list))
|
||||
(setq proj (or proj (project-current))))
|
||||
(message "Generating new tags table...")
|
||||
(let ((start (time-to-seconds)))
|
||||
(etags-regen--tags-generate proj)
|
||||
(message "...done (%.2f s)" (- (time-to-seconds) start))))))
|
||||
|
||||
(defun etags-regen--all-files (proj)
|
||||
(let* ((root (project-root proj))
|
||||
(default-directory root)
|
||||
;; TODO: Make the scanning more efficient, e.g. move the
|
||||
;; filtering by glob to project (project-files-filtered...).
|
||||
(files (project-files proj))
|
||||
(match-re (concat
|
||||
"\\."
|
||||
(regexp-opt etags-regen-file-extensions)
|
||||
"\\'"))
|
||||
(ir-start (1- (length root)))
|
||||
(ignores-regexps
|
||||
(mapcar #'etags-regen--ignore-regexp
|
||||
etags-regen-ignores)))
|
||||
(cl-delete-if
|
||||
(lambda (f) (or (not (string-match-p match-re f))
|
||||
(string-match-p "/\\.#" f) ;Backup files.
|
||||
(cl-some (lambda (ignore) (string-match ignore f ir-start))
|
||||
ignores-regexps)))
|
||||
files)))
|
||||
|
||||
(defun etags-regen--ignore-regexp (ignore)
|
||||
(require 'dired)
|
||||
;; It's somewhat brittle to rely on Dired.
|
||||
(let ((re (dired-glob-regexp ignore)))
|
||||
;; We could implement root anchoring here, but \\= doesn't work in
|
||||
;; string-match :-(.
|
||||
(concat (unless (eq ?/ (aref re 3)) "/")
|
||||
;; Cutting off the anchors added by `dired-glob-regexp'.
|
||||
(substring re 2 (- (length re) 2))
|
||||
;; This way we allow a glob to match against a directory
|
||||
;; name, or a file name. And when it ends with / already,
|
||||
;; no need to add the anchoring.
|
||||
(unless (eq ?/ (aref re (- (length re) 3)))
|
||||
;; Either match a full name segment, or eos.
|
||||
"\\(?:/\\|\\'\\)"))))
|
||||
|
||||
(defun etags-regen--tags-generate (proj)
|
||||
(let* ((root (project-root proj))
|
||||
(default-directory root)
|
||||
(files (etags-regen--all-files proj))
|
||||
(tags-file (etags-regen--choose-tags-file proj))
|
||||
(ctags-p (etags-regen--ctags-p))
|
||||
(command (format "%s %s %s - -o %s"
|
||||
etags-regen-program
|
||||
(mapconcat #'identity
|
||||
(etags-regen--build-program-options ctags-p)
|
||||
" ")
|
||||
;; ctags's etags requires '-L' for stdin input.
|
||||
(if ctags-p "-L" "")
|
||||
tags-file)))
|
||||
(with-temp-buffer
|
||||
(mapc (lambda (f)
|
||||
(insert f "\n"))
|
||||
files)
|
||||
(shell-command-on-region (point-min) (point-max) command
|
||||
nil nil etags-regen--errors-buffer-name t))
|
||||
(etags-regen--visit-table tags-file root)))
|
||||
|
||||
(defun etags-regen--visit-table (tags-file root)
|
||||
;; Invalidate the scanned tags after any change is written to disk.
|
||||
(add-hook 'after-save-hook #'etags-regen--update-file)
|
||||
(add-hook 'before-save-hook #'etags-regen--mark-as-new)
|
||||
(setq etags-regen--tags-file tags-file
|
||||
etags-regen--tags-root root)
|
||||
(visit-tags-table etags-regen--tags-file))
|
||||
|
||||
(defun etags-regen--ctags-p ()
|
||||
(string-search "Ctags"
|
||||
(shell-command-to-string
|
||||
(format "%s --version" etags-regen-program))))
|
||||
|
||||
(defun etags-regen--build-program-options (ctags-p)
|
||||
(when (and etags-regen-regexp-alist ctags-p)
|
||||
(user-error "etags-regen-regexp-alist is not supported with Ctags"))
|
||||
(nconc
|
||||
(mapcan
|
||||
(lambda (group)
|
||||
(mapcan
|
||||
(lambda (lang)
|
||||
(mapcar (lambda (regexp)
|
||||
(concat "--regex="
|
||||
(shell-quote-argument
|
||||
(format "{%s}%s" lang regexp))))
|
||||
(cdr group)))
|
||||
(car group)))
|
||||
etags-regen-regexp-alist)
|
||||
(mapcar #'shell-quote-argument
|
||||
etags-regen-program-options)))
|
||||
|
||||
(defun etags-regen--update-file ()
|
||||
;; TODO: Maybe only do this when Emacs is idle for a bit. Or defer
|
||||
;; the updates and do them later in bursts when the table is used.
|
||||
(let* ((file-name buffer-file-name)
|
||||
(tags-file-buf (and etags-regen--tags-root
|
||||
(get-file-buffer etags-regen--tags-file)))
|
||||
(relname (concat "/" (file-relative-name file-name
|
||||
etags-regen--tags-root)))
|
||||
(ignores etags-regen-ignores)
|
||||
pr should-scan)
|
||||
(save-excursion
|
||||
(when tags-file-buf
|
||||
(cond
|
||||
((and etags-regen--new-file
|
||||
(kill-local-variable 'etags-regen--new-file)
|
||||
(setq pr (project-current))
|
||||
(equal (project-root pr) etags-regen--tags-root)
|
||||
(member file-name (project-files pr)))
|
||||
(set-buffer tags-file-buf)
|
||||
(setq should-scan t))
|
||||
((progn (set-buffer tags-file-buf)
|
||||
(etags-regen--remove-tag file-name))
|
||||
(setq should-scan t))))
|
||||
(when (and should-scan
|
||||
(not (cl-some
|
||||
(lambda (ignore)
|
||||
(string-match-p
|
||||
(etags-regen--ignore-regexp ignore)
|
||||
relname))
|
||||
ignores)))
|
||||
(etags-regen--append-tags file-name)
|
||||
(let ((save-silently t)
|
||||
(message-log-max nil))
|
||||
(save-buffer 0))))))
|
||||
|
||||
(defun etags-regen--remove-tag (file-name)
|
||||
(goto-char (point-min))
|
||||
(when (search-forward (format "\f\n%s," file-name) nil t)
|
||||
(let ((start (match-beginning 0)))
|
||||
(search-forward "\f\n" nil 'move)
|
||||
(let ((inhibit-read-only t))
|
||||
(delete-region start
|
||||
(if (eobp)
|
||||
(point)
|
||||
(- (point) 2)))))
|
||||
t))
|
||||
|
||||
(defun etags-regen--append-tags (&rest file-names)
|
||||
(goto-char (point-max))
|
||||
(let ((options (etags-regen--build-program-options (etags-regen--ctags-p)))
|
||||
(inhibit-read-only t))
|
||||
;; XXX: call-process is significantly faster, though.
|
||||
;; Like 10ms vs 20ms here. But `shell-command' makes it easy to
|
||||
;; direct stderr to a separate buffer.
|
||||
(shell-command
|
||||
(format "%s %s %s -o -"
|
||||
etags-regen-program (mapconcat #'identity options " ")
|
||||
(mapconcat #'identity file-names " "))
|
||||
t etags-regen--errors-buffer-name))
|
||||
;; FIXME: Is there a better way to do this?
|
||||
;; Completion table is the only remaining place where the
|
||||
;; update is not incremental.
|
||||
(setq-default tags-completion-table nil))
|
||||
|
||||
(defun etags-regen--mark-as-new ()
|
||||
(when (and etags-regen--tags-root
|
||||
(not buffer-file-number))
|
||||
(setq-local etags-regen--new-file t)))
|
||||
|
||||
(defun etags-regen--tags-cleanup ()
|
||||
(when etags-regen--tags-file
|
||||
(let ((buffer (get-file-buffer etags-regen--tags-file)))
|
||||
(and buffer
|
||||
(kill-buffer buffer)))
|
||||
(tags-reset-tags-tables)
|
||||
(setq tags-file-name nil
|
||||
tags-table-list nil
|
||||
etags-regen--tags-file nil
|
||||
etags-regen--tags-root nil))
|
||||
(remove-hook 'after-save-hook #'etags-regen--update-file)
|
||||
(remove-hook 'before-save-hook #'etags-regen--mark-as-new))
|
||||
|
||||
(defvar etags-regen-mode-map (make-sparse-keymap))
|
||||
|
||||
;;;###autoload
|
||||
(define-minor-mode etags-regen-mode
|
||||
"Minor mode to automatically generate and update tags tables.
|
||||
|
||||
This minor mode generates the tags table automatically based on
|
||||
the current project configuration, and later updates it as you
|
||||
edit the files and save the changes.
|
||||
|
||||
If you select a tags table manually (for example, using
|
||||
\\[visit-tags-table]), then this mode will be effectively
|
||||
disabled for the entire session. Use \\[tags-reset-tags-tables]
|
||||
to countermand the effect of a previous \\[visit-tags-table]."
|
||||
:global t
|
||||
(if etags-regen-mode
|
||||
(progn
|
||||
(advice-add 'etags--xref-backend :before
|
||||
#'etags-regen--maybe-generate)
|
||||
(advice-add 'tags-completion-at-point-function :before
|
||||
#'etags-regen--maybe-generate))
|
||||
(advice-remove 'etags--xref-backend #'etags-regen--maybe-generate)
|
||||
(advice-remove 'tags-completion-at-point-function #'etags-regen--maybe-generate)
|
||||
(etags-regen--tags-cleanup)))
|
||||
|
||||
(provide 'etags-regen)
|
||||
|
||||
;;; etags-regen.el ends here
|
||||
Loading…
Add table
Reference in a new issue