bug#67687: Feature request: automatic tags management

[Dmitry Gutov <dmitry@gutov.dev>]

[-- Attachment #1: Type: text/plain, Size: 160 bytes --]

On 21/12/2023 18:46, Dmitry Gutov wrote:
> See instead the patch attached to this bug report.

Here's an update, incorporating the feedback from here and there.

[-- Attachment #2: etags-regen-v2.diff --]
[-- Type: text/x-patch, Size: 16507 bytes --]

diff --git a/.dir-locals.el b/.dir-locals.el
index e087aa89cd1..d308591c475 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -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-lang-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"
diff --git a/etc/NEWS b/etc/NEWS
index 90ff23b7937..3726655239e 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1208,6 +1208,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.
+
 \f
 * Incompatible Lisp Changes in Emacs 30.1
 
diff --git a/lisp/progmodes/etags-regen.el b/lisp/progmodes/etags-regen.el
new file mode 100644
index 00000000000..66c4178ae86
--- /dev/null
+++ b/lisp/progmodes/etags-regen.el
@@ -0,0 +1,384 @@
+;;; 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.
+;;
+;; The goal of this mode is to provide a feature that should be
+;; familiar to the users of certain lightweight programmer's editors,
+;; such as Sublime Text.  Which is "go to definition" with automatic
+;; indexing, added in ST3 (released in 2017).
+;;
+;; At the moment reindexing works off before/after-save-hook, but to
+;; handle more complex changes (e.g. 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")
+
+(defcustom etags-regen-program (executable-find "etags")
+  "Name of the etags program.
+
+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)
+
+(defcustom etags-regen-tags-file "TAGS"
+  "Name of the tags file to create inside the project.
+
+This value should either be a simple file name (no directory
+specified), or a function that accepts a project root directory
+and returns a distinct file name for the tags file for it.  The
+latter option is most useful when you prefer to store the tag
+files somewhere outside -- e.g. in `temporary-file-directory'."
+  :type '(choice (string :tag "File name")
+                 (function :tag "Function that returns file name")))
+
+(defcustom etags-regen-program-options nil
+  "List of additional options to pass to the etags program."
+  :type '(repeat string))
+
+(defcustom etags-regen-regexp-alist nil
+  "Mapping of languages to additional regexps for tags.
+
+The value must be a list of conses (LANGUAGES . TAG-REGEXPS)
+where both car and cdr 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
+as documented for the `--regex' arguments.
+
+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")))))
+
+;;;###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.
+
+File extensions to generate the tags for."
+  :type '(repeat (string :tag "File extension")))
+
+;;;###autoload
+(put 'etags-regen-file-extensions 'safe-local-variable
+     (lambda (value) (and (listp value) (seq-every-p #'stringp value))))
+
+;; FIXME: Only plain substrings supported currently.
+(defcustom etags-regen-ignores nil
+  "Additional ignore rules, in the format of `project-ignores'."
+  :type '(repeat
+          (string :tag "Glob to ignore")))
+
+;;;###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*")
+
+(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))
+             100)
+          (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)
+                    "\\'")))
+    (cl-delete-if
+     (lambda (f) (or (not (string-match-p match-re f))
+                ;; FIXME: Handle etags-regen-ignores properly.
+                (string-match-p "/\\.#" f)
+                (cl-some (lambda (ignore) (string-search ignore f))
+                         etags-regen-ignores)))
+     files)))
+
+(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)
+   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)))
+        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 should-scan
+        (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.
+    (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)))
+    (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
+  "Generate and update the tags automatically.
+
+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."
+  :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