From: Dmitry Gutov <dmitry@gutov.dev>
To: Eli Zaretskii <eliz@gnu.org>
Cc: 67687@debbugs.gnu.org, eskinjp@gmail.com, stefankangas@gmail.com
Subject: bug#67687: Feature request: automatic tags management
Date: Sun, 24 Dec 2023 03:43:25 +0200 [thread overview]
Message-ID: <aeefa0a5-82ba-49eb-8bb7-8c50347a848b@gutov.dev> (raw)
In-Reply-To: <661f4951-cb0a-5257-63b0-efe71a0d217e@gutov.dev>
[-- Attachment #1: Type: text/plain, Size: 358 bytes --]
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.
[-- Attachment #2: etags-regen-v3.diff --]
[-- Type: text/x-patch, Size: 17646 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 6df17aa3f0a..2ff3356d3c9 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1238,6 +1238,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..88b730195c3
--- /dev/null
+++ b/lisp/progmodes/etags-regen.el
@@ -0,0 +1,411 @@
+;;; 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")
+(declare-function dired-glob-regexp "dired")
+
+(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: 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")))
+
+;;;###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)
+ "\\'"))
+ (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))
+ (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
next prev parent reply other threads:[~2023-12-24 1:43 UTC|newest]
Thread overview: 53+ messages / expand[flat|nested] mbox.gz Atom feed top
2023-12-07 11:43 bug#67687: Feature request: automatic tags management Jon Eskin
2023-12-07 15:57 ` Dmitry Gutov
2023-12-07 19:57 ` Jon Eskin
2023-12-10 2:41 ` Dmitry Gutov
2023-12-10 11:38 ` Jon Eskin
2023-12-20 21:11 ` Jon Eskin
2023-12-21 0:24 ` Dmitry Gutov
2023-12-21 7:40 ` Eli Zaretskii
2023-12-21 16:46 ` Dmitry Gutov
2023-12-21 23:37 ` Dmitry Gutov
2023-12-24 1:43 ` Dmitry Gutov [this message]
2023-12-28 9:30 ` Eli Zaretskii
2023-12-30 3:05 ` Dmitry Gutov
2023-12-30 7:33 ` Eli Zaretskii
2023-12-30 23:43 ` Dmitry Gutov
2023-12-31 1:02 ` Stefan Kangas
2023-12-31 23:29 ` Dmitry Gutov
2024-01-02 0:40 ` Stefan Kangas
2024-01-02 1:31 ` Dmitry Gutov
2023-12-31 7:07 ` Eli Zaretskii
2023-12-31 15:21 ` Dmitry Gutov
2023-12-29 22:29 ` Stefan Kangas
2023-12-30 1:50 ` Dmitry Gutov
2023-12-30 20:31 ` Stefan Kangas
2023-12-30 22:50 ` Dmitry Gutov
2023-12-30 23:25 ` Stefan Kangas
2023-12-30 23:58 ` Dmitry Gutov
2023-12-31 7:23 ` Eli Zaretskii
2023-12-31 15:31 ` Dmitry Gutov
2023-12-29 22:17 ` Stefan Kangas
2023-12-30 1:31 ` Dmitry Gutov
2023-12-30 20:56 ` Stefan Kangas
2023-12-30 23:23 ` Dmitry Gutov
2023-12-31 0:03 ` Stefan Kangas
2023-12-31 6:34 ` Eli Zaretskii
2023-12-31 7:22 ` Stefan Kangas
2023-12-31 15:22 ` Dmitry Gutov
2023-12-31 15:25 ` Dmitry Gutov
2023-12-31 16:42 ` Eli Zaretskii
2023-12-31 17:53 ` Dmitry Gutov
2023-12-31 19:27 ` Eli Zaretskii
2024-01-01 1:23 ` Dmitry Gutov
2024-01-01 12:07 ` Eli Zaretskii
2024-01-01 15:47 ` Dmitry Gutov
2024-01-01 16:50 ` Eli Zaretskii
2024-01-01 17:23 ` Dmitry Gutov
2024-01-01 17:39 ` Eli Zaretskii
2024-01-01 18:48 ` Dmitry Gutov
2024-01-01 19:25 ` Eli Zaretskii
2024-01-02 1:40 ` Dmitry Gutov
2024-01-04 1:56 ` Dmitry Gutov
2024-01-02 10:41 ` Francesco Potortì
2024-01-02 13:09 ` Dmitry Gutov
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=aeefa0a5-82ba-49eb-8bb7-8c50347a848b@gutov.dev \
--to=dmitry@gutov.dev \
--cc=67687@debbugs.gnu.org \
--cc=eliz@gnu.org \
--cc=eskinjp@gmail.com \
--cc=stefankangas@gmail.com \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).