bug#67687: Feature request: automatic tags management

[Dmitry Gutov <dmitry@gutov.dev>]

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

On 30/12/2023 09:33, Eli Zaretskii wrote:
>> Date: Sat, 30 Dec 2023 05:05:01 +0200
>> Cc: 67687@debbugs.gnu.org, eskinjp@gmail.com, stefankangas@gmail.com
>> From: Dmitry Gutov <dmitry@gutov.dev>
>>
>>>> +(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.
> 
> I suggest some minor improvements in this area below.

All right.

>>>> +;;;###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.
> 
> Isn't this covered by the compat package on ELPA?  If not, I think it
> should be.

These forms go into generated autoloads file for each installed package 
(*-autoloads.el). I think compat doesn't make list-of-string-p 
autoloaded, and autoloads files don't usually have (require ...) forms.

So while I haven't really tested this and could be missing something, it 
seems brittle to rely on 'compat' for this function (if at all possible).

>>>> +     (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.
> 
> Can you add a comment there to that effect?

Added.

>>>> +(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.
> 
> Thanks, but I miss in that comment explanations of the "magic"
> constants 2 and 3.  Could we add that, please?

2 is the length of both anchors, 3 is the index of the character right 
after the anchor. There is already a comment about cutting off the 
anchors, I've expanded it a bit.

>>>> +(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.
> 
> How about mentioning this issue in that comment?

Added.

>> +(defcustom etags-regen-tags-file "TAGS"
>> +  "Name of the tags file to create inside the project.
> 
> I suggest
> 
>    Name of the tags file to create inside the project by `etags-regen-mode'.
> 
>> +(defcustom etags-regen-program-options nil
>> +  "List of additional options to pass to the etags program."
> 
> I suggest
> 
>    List of additional options for etags program invoked by `etags-regen-mode'.
> 
>> +(defcustom etags-regen-regexp-alist nil
>> +  "Mapping of languages to additional regexps for tags.
> 
> I suggest
> 
>    Mapping of languages to etags regexps for `etags-regen-mode'.
> 
>> +(define-minor-mode etags-regen-mode
>> +  "Generate and update the tags automatically.
> 
> I suggest
> 
>    Minor mode to automatically generate and update tags tables.

Replaced, thanks.

Latest revision attached. Any further comments?

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

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.
+
 \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..e1fca1c4e44
--- /dev/null
+++ b/lisp/progmodes/etags-regen.el
@@ -0,0 +1,424 @@
+;;; 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 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 (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)
+   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."
+  :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