Subject: Re: bug#67687: Feature request: automatic tags management

From: Dmitry Gutov <[email-masked]>
Date: Sat, 30 Dec 2023 05:05:01 +0200

On 28/12/2023 11:30, Eli Zaretskii wrote:
>> Date: Sun, 24 Dec 2023 03:43:25 +0200
>> From: Dmitry Gutov <[email-masked]>
>> Cc: [email-masked], [email-masked], [email-masked]
>>
>> On 22/12/2023 01:37, Dmitry Gutov wrote:
>>> 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.
>>
>> Fixed a typo in dir-locals and implemented better support for
>> etags-regen-ignores (though with one omission).
>>
>> To me it looks good to check in now.
> 
> Thanks, I have a few minor comments.

Attaching the next version, which addresses most but not all comments of 
yours and Stefan's.

>> +(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)
> 
> Please add :version tags to all the defcustoms you add.

Done.

>> +(defcustom etags-regen-tags-file "TAGS"
>> +  "Name of the tags file to create inside the project.
> 
> This and the other defcustom's here should say in the first line of
> the doc string that they are for etags-regen-mode.  This will help
> discoverability and also produce a more helpful display with the
> various apropos commands.

I've tried, but it seems hard to fit into most of them while keeping to 
the requisite max number of columns. Only managed to fit that into 
etags-regen-program and etags-regen-file-extensions.

TBH, most of the time it would seem superfluous, given the namespaced 
names. But it's probably good to mention in 'etags-regen-program', on 
balance.

>> +This value should either be a simple file name (no directory
>     ^^^^^^^^^^
> "The value" or just "Value".

Ok.

>> +specified), or a function that accepts a project root directory
>> +and returns a distinct file name for the tags file for it.
> 
> That function should also return only a file name without leading
> directories, right?  If so, the text should be more explicit about
> that.  For example:
> 
>    Value should be either a string specifying a file name without
>    leading directories, or or a function that accepts a project's root
>    directory and returns such a file name, to be used as the tags file
>    for that project.
> 
>>                                                               The
>> +latter option is most useful when you prefer to store the tag
>            ^^^^^^
> Using "option" in a doc string of a user option might be ambiguous.  I
> suggest to use "alternative" or "possibility" instead.

Done.

>> +files somewhere outside -- e.g. in `temporary-file-directory'."
> 
> So the function could return a file name _with_ leading directories?

Indeed. So I added "absolute" to the docstring.

We could allow it to return a nondirectory name too, if somebody finds a 
use case.

>> +;;;###autoload
>> +(put 'etags-regen-file-extensions 'safe-local-variable
>> +     (lambda (value) (and (listp value) (seq-every-p #'stringp value))))
> 
> Why not use list-of-strings-p here?

Again, that "core ELPA" consideration. We could deploy this feature to a 
number of released Emacs versions, if we don't introduce such dependencies.

>> +;;;###autoload
>> +(put 'etags-regen-ignores 'safe-local-variable
>> +     (lambda (value) (and (listp value) (seq-every-p #'stringp value))))
> 
> And here.
> 
>> +      (if (> (+ (length added-files)
>> +                (length changed-files)
>> +                (length removed-files))
>> +             100)
>> +          (progn
>> +            (message "etags-regen: Too many changes, falling back to full rescan")
> 
> Should the magic 100 value be a defvar, not a hard-coded constant?

Moved it to a defvar.

>> +(defun etags-regen--maybe-generate ()
>> +  (let ((proj))
> 
> Would
> 
>       (let (proj)
> 
> do here?  IOW, why the extra pair of parens?

Altered.

>> +     (lambda (f) (or (not (string-match-p match-re f))
>> +                (string-match-p "/\\.#" f)
> 
> Is that '/' there to detect regexps for absolute file names?  If so,
> that won't work for Windows.

It's to detect backup 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.
>> +            (substring re 2 (- (length re) 2))
>> +            (unless (eq ?/ (aref re (- (length re) 3)))
>> +              ;; Either match a full name segment, or eos.
>> +              "\\(?:/\\|\\'\\)"))))
> 
> Same here: what is the purpose of comparisons with a slash?  I think
> we need some more comments there explaining the logic of the code.

We compare with a slash to see whether the glob was matching against a 
directory (in which case it's already anchored to the name of a file 
name segment), otherwise we add such anchoring to either the end of a 
file name segment or eos (thus allowing a glob match both directory 
names and file names).

Added a shorter comment saying the same.

>> +(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))
> 
> Should we indeed use call-process?

Something for later improvement.

Looking at the code, I believe I decided to use 'shell-command' for the 
first version because of how easy it makes to output stderr to a 
separate buffer. call-process only offers writing them to a file.

diff --git a/.dir-locals.el b/.dir-locals.el
index e087aa89cd1..ce7febca851 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-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 f82564946b7..6d6bca187de 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1243,6 +1243,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
 
diff --git a/lisp/progmodes/etags-regen.el b/lisp/progmodes/etags-regen.el
new file mode 100644
index 00000000000..22ae9ce4f0a
--- /dev/null
+++ b/lisp/progmodes/etags-regen.el
@@ -0,0 +1,420 @@
+;;; etags-regen.el --- Auto-(re)regenerating tags  -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021-2023 Free Software Foundation, Inc.
+
+;; Author: Dmitry Gutov <[email-masked]>
+;; 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 (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")
+(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.
+
+The value should either be a simple file name (no directory
+specified), or a function that accepts a 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 outside -- e.g. 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 to pass to the etags program."
+  :type '(repeat string)
+  :version "30.1")
+
+(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"))))
+  :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)
+                (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.
+            (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)
+   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.
+    (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
+  "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