eldev-plugins.el

;;; eldev-plugins.el --- Elisp development tool  -*- lexical-binding: t -*-

;;; Copyright (C) 2020-2024 Paul Pogonyshev

;; This program 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.

;; This program 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 this program.  If not, see https://www.gnu.org/licenses.

;;; Code:

(require 'eldev)
(require 'eldev-vc)
(require 'lisp-mnt)


;; To silence byte-compilation warnings on Emacs 24-25 and also make code in
;; `eldev-output-reroute-messages' work.
(defvar inhibit-message)

(defvar eldev--active-plugin-documentation nil)


(defun eldev-active-plugins ()
  "Return a list of all activated plugin names.
Since 0.3."
  (mapcar #'car eldev--active-plugin-documentation))

(defun eldev-use-plugin (plugin &rest configuration)
  "Use given PLUGIN in the build.
Currently, only a fixed number of built-in plugins is supported.
In the future, this might become a way to extend Eldev by reusing
third-party code automatically downloaded from a package archive.

CONFIGURATION is specific to each plugin.  Usually it is expected
to be a property list, i.e. keywords interleaved with values.

It is not an error to activate a plugin more than once (e.g. once
from `~/.config/eldev/config' and once from `Eldev').  However,
CONFIGURATION for all activations but the first will be ignored.

Since 0.3."
  (unless (assq plugin eldev--active-plugin-documentation)
    (push `(,plugin . ,(pcase plugin
                         (`autoloads  (eldev--autoloads-plugin  configuration))
                         (`maintainer (eldev--maintainer-plugin configuration))
                         (`undercover (eldev--undercover-plugin configuration))
                         (_ (error "Unknown plugin `%s'" plugin))))
          eldev--active-plugin-documentation)))



;; Autoloads.

(defun eldev--autoloads-source-dir ()
  (if eldev-project-source-dirs (file-name-as-directory (car (eldev-listify eldev-project-source-dirs))) ""))

(defvar eldev--collect-autoloads-from
  ;; FIXME: Here we explicitly use only one (the first) source directory.  Should that be
  ;;        changed?
  (let ((source-dir (eldev--autoloads-source-dir)))
    `(:and eldev-main-fileset
           ;; Have to duplicate `autoload' logic here (moved to `loaddefs-gen' in later
           ;; Emacs versions).  I have no idea why it discards files with `=' at the front,
           ;; but we need to do the same to remain compatible with installed packages.
           (,(format "./%s*.el" source-dir) ,(format "./%s*.el.gz" source-dir) ,(format "!./%s.*" source-dir) ,(format "!./%s=*" source-dir)))))

(defvar elisp-lint--autoloads-filename)

(defun eldev--autoloads-plugin (_configuration)
  "Plugin that enables processing of autoload cookies, generating
and updating file `PROJECT-autoloads.el' automatically.  Eldev
uses this file if present, so that commands like `test', `eval'
etc. can use function autoloading regardless of loading mode — it
works like in a real package.

If this plugin is active, a new virtual target `:autoloads' is
added to the tree.  It is built by default.  It collects forms
with preceding `;;;###autoload' cookie from all `.el' files in
the project's root.  This is exactly what is performed when a
package is installed by Emacs packaging system.  Before commands
`test', `eval' and the like are executed, Eldev makes sure that
the file is up-to-date.

It is recommended to instruct your VCS to ignore file
`PROJECT-autoloads.el', as it will be autogenerated.

When using a project with this plugin as a local dependency,
specify loading mode `built' (or `built-and-compiled',
`built-source'):

    (eldev-use-local-dependency \"...\" 'built)

Otherwise, autoloads file for the dependency may become
out-of-date."
  (eldev-defbuilder eldev-builder-autoloads (sources target)
    :type           many-to-one
    :short-name     "AUTOLOADS"
    :message        target
    :source-files   eldev--collect-autoloads-from
    :targets        (lambda (_sources)
                      (format "%s%s-autoloads.el" (eldev--autoloads-source-dir) (package-desc-name (eldev-package-descriptor))))
    :define-cleaner (eldev-cleaner-autoloads
                     "Delete the generated package autoloads files."
                     :default t)
    :collect        (":default" ":autoloads")
    ;; To make sure that `update-directory-autoloads' doesn't grab files it shouldn't,
    ;; override `directory-files' temporarily.
    (let ((effective-dir (expand-file-name (eldev--autoloads-source-dir) eldev-project-dir)))
      (eldev-advised (#'directory-files :around (lambda (original directory &rest arguments)
                                                  (let ((files (apply original directory arguments)))
                                                    (if (file-equal-p directory effective-dir)
                                                        (let (filtered)
                                                          (dolist (file files)
                                                            (when (eldev-any-p (file-equal-p file it) sources)
                                                              (push file filtered)))
                                                          (nreverse filtered))
                                                      files))))
        (let ((inhibit-message   t)
              (make-backup-files nil)
              (autoloads-file    (expand-file-name target eldev-project-dir)))
          (package-generate-autoloads (package-desc-name (eldev-package-descriptor)) effective-dir)
          ;; Make sure we don't decide to unnecessarily rebuild it again: if the file
          ;; hasn't changed, `package-generate-autoloads' won't overwrite it, potentially
          ;; making it appear outdated compared to source files.
          (set-file-times autoloads-file)
          ;; Always load the generated file.  Maybe there are cases when we don't need that,
          ;; but most of the time we do.
          (eldev--load-autoloads-file autoloads-file)))))
  (add-hook 'eldev-before-loading-dependencies-hook
            (lambda (type _additional-sets)
              (when (and type (not (eq type 'load-only)))
                (eldev-with-verbosity-level-except 'quiet (#'eldev-load-project-dependencies #'eldev-load-extra-dependencies)
                  (eldev-build ":autoloads")))))
  (let* ((autoloads-el    (format "%s%s-autoloads.el" (eldev--autoloads-source-dir) (package-desc-name (eldev-package-descriptor))))
         (as-dependencies `((depends-on ,autoloads-el))))
    (setf eldev-standard-excludes `(:or ,eldev-standard-excludes ,(format "./%s" autoloads-el)))
    ;; FIXME: Or maybe make this optional?  However, if autoloads file is already present,
    ;;        Eldev will use it, probably making this too confusing.
    (eldev-with-target-dependencies
      (dolist (el-file (eldev-find-files `(:and ,eldev--collect-autoloads-from "*.el")))
        (eldev-set-target-dependencies (concat el-file "c") 'eldev--autoloads-plugin as-dependencies)))
    ;; `elisp-lint' can generate autoloads itself.  Replace that with what we do.  As
    ;; always, there seems to be no other way than diving into internals.
    (with-eval-after-load 'elisp-lint
      (advice-add 'elisp-lint--generate-autoloads :override
                  (lambda (&rest _etc)
                    (eldev-with-verbosity-level-except 'quiet (#'eldev-load-project-dependencies #'eldev-load-extra-dependencies)
                      (eldev-build ":autoloads"))
                    (setf elisp-lint--autoloads-filename autoloads-el)))))
  (eldev-documentation 'eldev--autoloads-plugin))

(defun eldev--autoloads-used-p ()
  (eldev-any-p (with-temp-buffer
                 (insert-file-contents it)
                 (let ((case-fold-search nil))
                   (re-search-forward (rx bol (0+ space) ";;;###autoload" (0+ space) eol) nil t)))
               (eldev-find-files eldev--collect-autoloads-from)))



;; Maintainer.

;; Various variables are defined in `eldev.el'.

(defun eldev--maintainer-plugin (_configuration)
  "Plugin adding commands for project maintainer use.  Currently,
actually, only one command: `release' that helps you automate
creation of project releases.

It is recommended to modify various plugin-specific variables
(`eldev-release-*') in file `Eldev', but let specific developers
activate the plugin in their `Eldev-local'."
  (eldev-defcommand eldev-release (&rest parameters)
    "Prepare and create a release of the project.  When running
interactively (the default), you can also type in VERSION at
runtime.

This will create one or two commits (depending on project
configuration) and possibly a tag.  Additional project-specific
operations that e.g. automatically update some documentation
parts are possible too.  However, the commits will not be pushed.
Instead, this is left for you to do once you have verified that
the commits look like you want.

This command has many variables (`eldev-release-*') that control
its behavior and are not settable from the command line.
Instead, they should be customized in file `Eldev', on a
per-project basis."
    :parameters   "VERSION"
    :category     building
    (eldev--maintainer-release parameters))
  (eldev-defbooloptions eldev-release-ignore-untracked eldev-release-notice-untracked eldev-release-ignore-untracked
    ("Ignore untracked files"
     :options       (-u --ignore-untracked))
    ("Don't release if there are any untracked files"
     :options       (-U --notice-untracked))
    :for-command    release)
  (eldev-defbooloptions eldev-release-skip-file-checks eldev-release-perform-file-checks eldev-release-skip-file-checks
    ("Skip file contents checks"
     :options       --no-file-checks)
    ("Perform file contents checks as configured"
     :options       (-F --perform-file-checks)
     :hidden-if     :default)
    :for-command    release)
  (eldev-defbooloptions eldev-release-skip-testing eldev-release-perform-testing eldev-release-skip-testing
    ("Skip any configured project testing"
     :options       --no-testing)
    ("Perform project testing as configured"
     :options       (-T --perform-testing)
     :hidden-if     :default)
    :for-command    release)
  (eldev-defoption eldev-release-set-commit-message (message)
    "Set the message for release commit"
    :options        (-m --message)
    :for-command    release
    :value          MESSAGE
    :default-value  "see `eldev-release-commit-message'"
    (setf eldev-release-commit-message message))
  (eldev-defoption eldev-release-set-post-release-commit-message (message)
    "Set the message for release commit"
    :options        (-M --post-release-commit-message)
    :for-command    release
    :value          MESSAGE
    :default-value  "see `eldev-release-post-release-commit-message'"
    (setf eldev-release-commit-message message))
  (eldev-defoption eldev-release-set-commit-message (message)
    "Set the message for release commit"
    :options        (-m --message)
    :for-command    release
    :value          MESSAGE
    :default-value  "see variable `eldev-release-commit-message'"
    (setf eldev-release-commit-message message))
  (eldev-defbooloptions eldev-release-interactive-mode eldev-release-non-interactive-mode eldev-release-interactive
    ("Ask before all non-trivial release steps"
     :options       (-i --interactive))
    ("Release without user interaction if configured validations pass"
     :options       (-N --non-interactive --go))
    :for-command    release)
  (eldev-defbooloptions eldev-release-dry-run-mode eldev-release-do-release-mode eldev-release-dry-run-mode
    ("Don't actually modify anything, just validate"
     :options       (-n --dry-run))
    ("Do release as requested"
     :options       --do-release
     :hidden-if     :default)
    :for-command    release)
  (eldev-defcommand eldev-update-copyright (&rest parameters)
    "Update copyright notices in all project files.  The year to
include in the notices can be specified on the command line, or
else defaults to the current year.  Unlike command `release',
this one doesn't commit the changes.  After the command is
finished, you should validate and commit them yourself."
    :parameters   "[YEAR]"
    :aliases      copyright
    (eldev--maintainer-update-copyright parameters))
  (eldev-documentation 'eldev--maintainer-plugin))


(defun eldev--maintainer-release (parameters)
  (let ((current-version (package-desc-version (eldev-package-descriptor))))
    (when (cdr parameters)
      (signal 'eldev-wrong-command-usage `(t "Unexpected parameters to the command")))
    (unless parameters
      (when eldev-release-interactive
        (eldev-output "Enter a version or one of %s" (eldev-message-enumerate "string" eldev-release-version-incrementors 'car nil t))
        (setf parameters `(,(eldev-read-string (eldev-format-message "Version to release (current is %s): " (eldev-message-version current-version t)))))))
    (unless (and parameters (> (length (car parameters)) 0))
      (signal 'eldev-wrong-command-usage `(t "Missing version to release")))
    (let ((version (eldev--release-compute-new-version (car parameters) current-version)))
      (eldev-print "Preparing to release %s %s..." (eldev-colorize (eldev-formatted-project-name) 'name) (eldev-message-version version t))
      (eldev-named-step "releasing" "validating the release"
        (eldev-verbose "%s..." (eldev-current-step-name t))
        (dolist (validator (eldev-listify eldev-release-validators))
          (funcall validator version)))
      (eldev-print :color 'section "\nReleasing %s %s..." (eldev-formatted-project-name) (eldev-message-version version))
      (eldev-named-step "releasing" "preparing the release commit"
        (eldev-verbose "%s..." (eldev-current-step-name t))
        ;; We call these functions even in dry-run mode, thus letting them produce
        ;; essential output etc.  The functions themselves are supposed to refrain from
        ;; modifying anything when in dry-run mode.
        (dolist (preparator (eldev-listify eldev-release-preparators))
          (funcall preparator version))
        (eldev--release-write-new-version version current-version))
      (eldev--release-commit "committing release changes"
                             (eldev--release-format-message "Release commit message: " eldev-release-commit-message version))
      (eldev-named-step "releasing" "tagging the release commit"
        (eldev-verbose "%s..." (eldev-current-step-name t))
        (let ((tag-name (when eldev-release-tag-function (funcall eldev-release-tag-function version))))
          (if tag-name
              (progn (unless eldev-release-dry-run-mode
                       (eldev-with-errors-as 'eldev-error (eldev-vc-create-tag tag-name)))
                     (eldev-print "\nTagged the release commit as `%s'" (eldev-colorize tag-name 'name)))
            (eldev-verbose "Should not be tagged according to `eldev-release-tag-function'"))))
      (let ((post-release-version (when eldev-release-post-release-commit version)))
        (when (functionp eldev-release-post-release-commit)
          (eldev-named-step "releasing" "computing post-release version"
            (setf post-release-version (eldev--release-do-increment-version eldev-release-post-release-commit version))))
        (when post-release-version
          (when (version-list-< post-release-version version)
            (signal 'eldev-error `("Post-release version %s is older than the released version %s"
                                   (eldev-message-version post-release-version) (eldev-message-version version))))
          (eldev-named-step "releasing" "preparing the post-release commit"
            (eldev-verbose "%s..." (eldev-current-step-name t))
            ;; Intentionally also called in dry-run mode, see above.
            (dolist (post-release-preparator (eldev-listify eldev-release-post-release-preparators))
              (funcall post-release-preparator version post-release-version))
            (unless (equal post-release-version version)
              (eldev--release-write-new-version post-release-version version)
              (eldev-print "\nPost-release version: %s" (eldev-message-version post-release-version))))
          (eldev--release-commit "committing post-release changes"
                                 (eldev--release-format-message "Post-release commit message: " eldev-release-post-release-commit-message version))))
      (eldev-print :color 'section "\nReleased %s %s" (eldev-formatted-project-name) (eldev-message-version version))
      (eldev-print "Don't forget to push after verifying the created commits"))))

(defun eldev--release-compute-new-version (as-string current-version)
  (let* ((incrementor (cdr (assoc as-string eldev-release-version-incrementors)))
         (min-length  (min (or eldev-release-min-version-size 1) 4))
         (version     (eldev-named-step "releasing" (if incrementor
                                                        (eldev-format-message "applying incrementor `%s' to version `%s'" as-string (eldev-message-version current-version))
                                                      (eldev-format-message "parsing version `%s'" as-string))
                        (condition-case error
                            (if incrementor
                                (let ((version (eldev--release-do-increment-version incrementor current-version)))
                                  (when eldev-release-interactive
                                    (unless (eldev-y-or-n-p (eldev-format-message "\nNew version number would be %s; proceed? " (eldev-message-version version t)))
                                      (signal 'eldev-quit 1))
                                    (eldev-print ""))
                                  version)
                              (version-to-list as-string))
                          (eldev-quit (signal 'eldev-quit (cdr error)))
                          (error (signal 'eldev-error `(,(error-message-string error))))))))
    (when (< (length version) min-length)
      (error (signal 'eldev-error `(:hint ,(eldev-format-message "Minimal number of components is %d according to `eldev-release-min-version-size'" min-length)
                                          "Version `%s' has too few components (%d)" ,(eldev-message-version version) ,(length version)))))
    version))

(defun eldev--release-do-increment-version (incrementor version)
  (setf version (funcall incrementor version))
  (when (stringp version)
    (setf version (version-to-list version)))
  (while (and (consp version) (< (length version) (min (or eldev-release-min-version-size 1) 4)))
    (setf version (append version '(0))))
  version)

(defun eldev--release-write-new-version (new-version current-version)
  (let ((file (eldev-project-main-file)))
    (eldev-trace "Replacing package version %s with %s in file `%s'..." (eldev-message-version current-version) (eldev-message-version new-version) file)
    (unless eldev-release-dry-run-mode
      (eldev-with-file-buffer file
        (if (file-equal-p file (eldev-package-descriptor-file-name))
            (let ((description-form (save-excursion (read (current-buffer)))))
              (unless (and (eq (car-safe description-form) 'define-package)
                           (let ((version (car-safe (cdr-safe (cdr description-form)))))
                             (and (stringp version) (equal (version-to-list version) current-version))))
                (error "Cannot detect package descriptor form in file `%s'" (file-relative-name file eldev-project-dir)))
              (down-list)
              (forward-sexp 3)
              (let ((to (point)))
                (forward-sexp -1)
                (delete-region (point) to)
                ;; FIXME: Escape the string?  Likely not needed for a version.
                (insert (prin1-to-string (eldev-message-version new-version)))))
          (let ((version (or (lm-header "package-version") (lm-header "version"))))
            (unless (and version (equal (version-to-list version) current-version))
              (error "Cannot detect package version header in file `%s'" (file-relative-name file eldev-project-dir)))
            (delete-region (point) (save-excursion (end-of-line) (point)))
            (insert (eldev-message-version new-version))))))))

(defun eldev--release-format-message (prompt message version-list)
  (setf message (if message
                    (with-temp-buffer
                      (insert message)
                      (goto-char 1)
                      (eldev-substitute-in-buffer nil nil `((formatted-name . ,(eldev-formatted-project-name))
                                                            (version-string . ,(eldev-message-version version-list))))
                      (buffer-string))
                  ""))
  ;; Tried to use `eldev-read-string', but non-interactive Emacs' editing facilities are
  ;; awful; let user use the command line option to replace instead.
  (ignore prompt)
  message)

(defun eldev--release-commit (step-name commit-message)
  (unless eldev-release-dry-run-mode
    (eldev-named-step "releasing" step-name
      (eldev-verbose "%s..." (eldev-current-step-name t))
      (eldev-with-vc-buffer nil
        ;; Ignore VCS-untracked files: pre-existing could be ignored using command line
        ;; option `-u'; if a commit preparator creates a file, then it needs to register it
        ;; explicitly.
        (let ((files (mapcar #'car (eldev-filter (memq (cdr it) '(edited added removed)) (vc-dir-child-files-and-states)))))
          ;; Would "helpfully" issue a message about ending the commit message, even
          ;; though we already provide it.
          (let ((inhibit-message t))
            (vc-checkin files backend commit-message)))
        (eldev-print "\nCreated commit %s:" (eldev-colorize (eldev-vc-commit-id t) 'name))
        (eldev-print "%s" commit-message)))))

(defun eldev-release-next-major-version (version)
  (eldev-release-next-pos-version version 0))

(defun eldev-release-next-minor-version (version)
  (eldev-release-next-pos-version version 1))

(defun eldev-release-next-patch-version (version)
  (eldev-release-next-pos-version version 2))

(defun eldev-release-next-snapshot-version (version)
  (setf version (copy-sequence version))
  (let ((tail (memq eldev--snapshot version)))
    (if tail
        (append (butlast version (length tail)) `(,eldev--snapshot) (eldev-release-next-pos-version (or (cdr tail) '(1)) 0))
      `(,@(eldev-release-next-pos-version version (1- (max eldev-release-min-version-size (length version)))) ,eldev--snapshot))))

(defun eldev-release-next-snapshot-version-unless-already-snapshot (version)
  (if (eldev-version-snapshot-p version)
      version
    (eldev-release-next-snapshot-version version)))

(defun eldev-release-next-pos-version (version pos)
  (let* ((length (length version))
         (extra  (- length 1 pos)))
    (catch 'done
      (dotimes (n (min (+ pos 2) length))
        (when (< (nth n version) 0)
          (throw 'done (butlast version (- length n)))))
      (setf version (if (> extra 0) (butlast version extra) (append version (make-list (- extra) 0))))
      (append (butlast version) (list (1+ (or (nth pos version) -1)))))))

(defun eldev-release-default-tag (version)
  (unless (eldev-version-snapshot-p version)
    (package-version-join version)))


(defun eldev-release-validate-version (version)
  "Validate project VERSION before releasing it.
This function requires that the VERSION is larger than the
current version.  Additionally, for packages that support
pre-24.4 Emacsen, this forbids `snapshot' and similar components
in the VERSION as unknown back then."
  (eldev-named-step "releasing" "validating the new version number"
    (eldev-verbose "%s..." (eldev-current-step-name t))
    (let* ((package         (eldev-package-descriptor))
           (current-version (package-desc-version package))
           (required-emacs  (cadr (assq 'emacs (package-desc-reqs (eldev-package-descriptor))))))
      (eldev-trace "The current project version is %s" (eldev-message-version current-version))
      (unless (version-list-< current-version version)
        (signal 'eldev-error `("Cannot release version %s: must be newer than the current project's version (%s)"
                               ,(eldev-message-version version) ,(eldev-message-version current-version))))
      ;; Even if Eldev doesn't support such old versions, maybe they are used by projects
      ;; that do.
      (when (and (version-list-< required-emacs '(24 4)) (eldev-any-p (< it -3) version))
        (signal 'eldev-error `(:hint "Older Emacs versions don't understand words `snapshot', `git', `svn' etc. in version strings"
                                     "Refusing to release version %s: it will not be understood by pre-24.4 Emacsen" ,(eldev-message-version version)))))))


(defun eldev-release-validate-vcs (version)
  "Validate project VCS before releasing given VERSION."
  (eldev-named-step "releasing" "validating VCS working directory of the project"
    (eldev-verbose "%s..." (eldev-current-step-name t))
    (let ((backend (eldev-vc-detect)))
      ;; Here we further restrict the list of supported backends (Subversion support is
      ;; unfinished).
      (unless (memq backend '(Git Hg))
        (signal 'eldev-error `(:hint "Currently supported: Git and Mercurial"
                                     "Can only create releases in projects maintained by a supported VCS")))
      (eldev-verbose "Detected VCS backend `%s'" (eldev-vc-full-name backend))
      (eldev-call-process (eldev-vc-executable backend)
          (eldev-pcase-exhaustive backend
            (`Git `("status" "--porcelain=v1" ,(format "--untracked=%s" (if eldev-release-ignore-untracked "no" "normal"))))
            (`Hg  `("--color=never" "--pager=never" "status" "--modified" "--added" "--removed" "--deleted" ,@(unless eldev-release-ignore-untracked '("--unknown"))))
            (`SVN `("status")))
        :destination  '(t nil)
        :die-on-error t
        ;; I don't see an option for this, so let's just delete unwanted output.
        (when (and eldev-release-ignore-untracked (eq backend 'SVN))
          (while (re-search-forward (rx bol "?") nil t)
            (beginning-of-line)
            (kill-line 1)))
        (unless (= (point-min) (point-max))
          (signal 'eldev-error `(:hint ,(eldev-format-message "Status as reported by %s:\n%s" (eldev-vc-full-name backend) (buffer-string))
                                       "Refusing to release: working directory is not clean"))))
      (when eldev-release-allowed-branch
        (let* ((current-branch   (eldev-vc-branch-name))
               (allowed-branches (if (functionp eldev-release-allowed-branch)
                                     (funcall eldev-release-allowed-branch version current-branch backend)
                                   eldev-release-allowed-branch)))
          (eldev-trace "VCS branch is found to be `%s'" current-branch)
          (unless (eq allowed-branches t)
            (setf allowed-branches (eldev-listify allowed-branches))
            (unless (member current-branch allowed-branches)
              (signal 'eldev-error `(:hint ,(if allowed-branches
                                                (eldev-message-enumerate '("Allowed branch:" "Allowed branches:") allowed-branches nil nil t)
                                              "See variable `eldev-release-allowed-branch'")
                                           "Refusing to release version `%s' from branch `%s'" ,(eldev-message-version version) ,current-branch)))))))))

(defun eldev-release-only-from-main-branch (_version branch vc-backend)
  (let ((main-branch (eldev-pcase-exhaustive vc-backend
                       (`Git "master")
                       (`Hg  "default")
                       (`SVN "trunk"))))
    (if (string= branch main-branch)
        t
      (signal 'eldev-error `(:hint "See variable `eldev-release-allowed-branch'"
                             "Refusing to release from non-main (i.e. not `%s') branch `%s'" ,main-branch ,branch)))))


(defun eldev-release-validate-files (_version)
  "Validate project files before creating a release."
  (if eldev-release-skip-file-checks
      (eldev-verbose "Skipping file contents checks as requested")
    (eldev-named-step "releasing" "checking project's files as configured"
      (eldev-verbose "%s..." (eldev-current-step-name t))
      ;; Not checking generated files here.
      (dolist (file (eldev-find-and-trace-files `(:and ,(eldev-standard-fileset 'all nil t) (:not ,eldev-release-file-check-ignored-files))
                                                "file%s to check"))
        (eldev-trace "Checking file `%s'..." file)
        (with-temp-buffer
          (insert-file-contents file)
          (let ((case-fold-search nil))
            (while (re-search-forward eldev-release-file-check-forbidden-regexp nil t)
              (save-excursion
                (let ((string (match-string    0))
                      (from   (match-beginning 0))
                      (to     (match-end       0))
                      from-extended
                      from-line
                      to-extended
                      to-line)
                  (goto-char from)
                  (ignore-errors (forward-line -2))
                  (setf from-extended (point)
                        from-line     (line-number-at-pos))
                  (goto-char to)
                  (ignore-errors (forward-line 3)
                                 (when (bolp)
                                   (end-of-line 0)))
                  (setf to-extended (point)
                        to-line     (line-number-at-pos))
                  (eldev-output "\n%s:%d-%d" file from-line to-line)
                  (eldev-output "%s%s%s" (buffer-substring from-extended from) (eldev-colorize (buffer-substring from to) 'warn) (buffer-substring to to-extended))
                  (eldev-release-maybe-fail (eldev-format-message "file `%s' contains text `%s' at line %d" file string (line-number-at-pos from))))))))))))


(defun eldev-release-test-project (_version)
  "Optionally test the project before creating a release.
Exact behavior depends on many configuration variables: this
function can test with various Emacs executables, in Docker
images or check status on continous integration servers."
  (if eldev-release-skip-testing
      (eldev-verbose "Skipping project testing step as requested")
    (let ((any-tests (or eldev-release-test-local eldev-release-test-other-emacses eldev-release-test-docker-images)))
      (if (or any-tests eldev-release-interactive)
          (eldev-named-step "releasing" "testing the project as configured"
            (eldev-verbose "%s..." (eldev-current-step-name t))
            (when (or eldev-release-test-local
                      (and eldev-release-interactive (not any-tests)
                           (eldev-y-or-n-p "
No pre-release testing configured.  If you have used a continuous integration
server for testing the latest commit or have otherwise tested it, this is not
a problem.

Run the standard regression tests locally at least? ")))
              (eldev--release-do-test-locally nil nil))
            (dolist (extra-emacs (eldev-listify eldev-release-test-other-emacses))
              (eldev--release-do-test-locally extra-emacs nil))
            (dolist (docker-image (eldev-listify eldev-release-test-docker-images))
              (eldev--release-do-test-locally nil docker-image)))
        (eldev-verbose "No project testing operations are configured")))))

(defun eldev--release-do-test-locally (other-emacs docker-image)
  (let* ((process-environment  `(,@(when other-emacs `(,(format "ELDEV_EMACS=%s" other-emacs))) ,@process-environment))
         (test-command-line    (append (eldev-global-setting-options) eldev-release-test-global-options '("test") eldev-release-test-command-options))
         (clean-command-line   '("--quiet" "clean" ".elc"))
         (compile-command-line (append (eldev-global-setting-options) eldev-release-test-global-options '("compile") eldev-release-test-compile-command-options))
         docker-description)
    (when docker-image
      (setf test-command-line    `("docker" ,docker-image ,@test-command-line)
            clean-command-line   `("docker" ,docker-image ,@clean-command-line)
            compile-command-line `("docker" ,docker-image ,@compile-command-line)
            docker-description   (if (string-match-p "/" docker-image)
                                     (eldev-format-message "Docker image `%s'" docker-image)
                                   (eldev-format-message "Docker-provided Emacs version %s" docker-image))))
    ;; Since this might take a really long in some projects (and also produce a lot of
    ;; output), do print some header.
    (eldev-print :color 'section "\n%s"
                 (cond (docker-description (eldev-format-message "Running the project's tests using %s..." docker-description))
                       (other-emacs        (eldev-format-message "Running the project's tests using executable `%s'..." other-emacs))
                       (t                  (eldev-format-message "Running the project's tests..."))))
    (eldev-call-process (eldev-shell-command) test-command-line
      :forward-output t
      (when (/= exit-code 0)
        (eldev-release-maybe-fail (cond (docker-description (eldev-format-message "tests do not pass in %s" docker-description))
                                        (other-emacs        (eldev-format-message "tests do not pass on `%s'" other-emacs))
                                        (t                  "tests do not pass")))))
    (when eldev-release-test-also-compile
      (eldev-print :color 'section "\n%s"
                   (cond (docker-description (eldev-format-message "Testing project byte-compilation using %s..." docker-description))
                         (other-emacs        (eldev-format-message "Testing project byte-compilation using executable `%s'..." other-emacs))
                         (t                  (eldev-format-message "Testing project byte-compilation..."))))
      ;; Clean both before and after compilation, to avoid any cross-Emacs-version
      ;; interference problems.  We don't expect this to fail, so don't write any special
      ;; error messages.
      (eldev-call-process (eldev-shell-command) clean-command-line
        :die-on-error t)
      (eldev-call-process (eldev-shell-command) compile-command-line
        :forward-output t
        (when (/= exit-code 0)
          (eldev-release-maybe-fail (cond (docker-description (eldev-format-message "byte-compilation in %s failed" docker-description))
                                          (other-emacs        (eldev-format-message "byte-compilation on `%s' failed" other-emacs))
                                          (t                  "byte-compilation failed")))))
      (eldev-call-process (eldev-shell-command) clean-command-line
        :die-on-error t))))


(defun eldev-release-maybe-fail (failure-message)
  "Maybe abort release process with given FAILURE-MESSAGE.
If running interactively, let the user decide."
  (unless (when eldev-release-interactive
            (eldev-error "%s" (eldev-message-upcase-first failure-message))
            ;; Since this is supposed to be important, use `yes-or-no-p', not `y-or-n-p'.
            (eldev-yes-or-no-p (eldev-format-message "\nContinue release process %s? " (eldev-colorize "anyway" 'warn))))
    (signal 'eldev-error `("Refusing to release: %s" ,failure-message))))


(defun eldev--maintainer-update-copyright (parameters)
  (when (cddr parameters)
    (signal 'eldev-wrong-command-usage `(t "More than one parameter to the command")))
  (eval-and-compile (require 'copyright))
  (let ((year        (condition-case error
                         (eldev-parse-number (if parameters (car parameters) (format-time-string "%Y")) :min 2000 :max 2999)
                       (error (signal 'eldev-wrong-command-usage `(t ,(eldev-message-upcase-first (eldev-extract-error-message error)))))))
        (num-updated 0)
        anything-found)
    (dolist (file (eldev-find-and-trace-files `(:and (eldev-standard-fileset 'all) ,eldev-update-copyright-fileset) "file%s to check for copyright notice in"))
      (eldev-trace "Checking file `%s' for a copyright notice..." file)
      (with-temp-buffer
        (insert-file-contents file)
        (set-buffer-modified-p nil)
        (if (save-excursion (save-restriction (copyright-find-copyright)))
            (progn
              ;; The standard feature has a really dumb interface: non-local variable
              ;; `copyright-current-year', exists, but you cannot set it, because the
              ;; value you provide just gets overwriten.  Emacs...  With native
              ;; compilation it seems to impossible to advice it to behave sanely, so we
              ;; have to roll our own now.
              (eldev--maintainer-do-update-copyright (format "%d" year))
              (if (buffer-modified-p)
                  (progn (eldev-write-to-file file)
                         (eldev-verbose "Updated the copyright notice in file `%s'" file)
                         (setf num-updated (1+ num-updated)))
                (eldev-trace "Copyright notice in the file is up-to-date with year %d" year))
              (setf anything-found t))
          (eldev-trace "No such notice found, skipping this file"))))
    (if anything-found
        (if (> num-updated 0)
            (eldev-print "Updated %s" (eldev-message-plural num-updated "copyright notice"))
          (eldev-print "All found copyright notices are up-to-date"))
      (eldev-print "No copyright notices found in the project files"))))

(defun eldev--maintainer-do-update-copyright (year-string)
  ;; Based on `copyright-update' + `copyright-update-year', see the caller for reasons to
  ;; have this function here.  I dropped a lot of things not used in Eldev.
  (save-excursion
    (save-restriction
      (when (copyright-find-copyright)
        (goto-char (match-end 1))
        (copyright-find-end)
        (unless (string= (buffer-substring (- (match-end 3) 2) (match-end 3)) (substring year-string -2))
	  (let ((size (save-excursion (skip-chars-backward "0-9"))))
	    (if (and (eq (% (- (string-to-number year-string) (string-to-number (buffer-substring (+ (point) size) (point)))) 100) 1)
		     (or (memq (char-after (+ (point) size -1)) '(?- ?–))
			 (memq (char-after (+ (point) size -2)) '(?- ?–))))
		;; This is a range so just replace the end part.
		(delete-char size)
	      ;; Insert a comma with the preferred number of spaces.
	      (insert
	       (save-excursion
		 (if (re-search-backward "[0-9]\\( *, *\\)[0-9]" (line-beginning-position) t)
		     (match-string 1)
		   ", ")))
	      ;; If people use the '91 '92 '93 scheme, do that as well.
	      (if (eq (char-after (+ (point) size -3)) ?')
		  (insert ?')))
	    ;; Finally insert the new year.
	    (insert (substring year-string size))))))))



;; Undercover.

(defvar eldev-undercover-config nil
  "Configuration for `undercover' plugin as a list.
Each element should be a symbol matching one of the recognized
flags.  See function `eldev-undercover-config'.")

(defvar eldev-undercover-report-file nil
  "Filename used for `undercover' report.
If this is nil, value of `undercover--report-file-path' is
effectively not modified.")

(defvar eldev-undercover-fileset "*.el")

(defconst eldev--undercover-flags '(auto on off always never coveralls simplecov codecov text merge restart send dontsend safe force))


(defvar undercover-force-coverage)
(defvar undercover--report-file-path)
(defvar undercover--report-format)


(defun eldev--undercover-config (&optional plugin-configuration)
  (let (file
        mode
        format
        merge
        dontsend
        force)
    (dolist (flag (append plugin-configuration (eldev-listify eldev-undercover-config)))
      (eldev-pcase-exhaustive flag
        ((or `auto `on `off)                       (setf mode     flag))
        ((or `always `never)                       (setf mode     (if (eq flag 'always) 'on 'off)))
        ((or `coveralls `simplecov `codecov `text) (setf format   flag))
        ((or `merge `restart)                      (setf merge    (eq flag 'merge)))
        ((or `send `dontsend)                      (setf dontsend (eq flag 'dontsend)))
        ((or `safe `force)                         (setf force    (eq flag 'force)))
        ;; This is mostly for plugin configuration.
        ((pred stringp)                            (setf file flag))))
    (unless file
      (setf file eldev-undercover-report-file))
    (when eldev-dwim
      (when (and file (null format))
        (setf format (cond ((string-suffix-p ".json" file)                                    'simplecov)
                           ((or (string-suffix-p ".txt" file) (string-suffix-p ".text" file)) 'text))))
      (unless (or mode (memq format '(nil coveralls)))
        (setf mode 'on)))
    ;; Return value is a cons of two lists: a plist for internal use and for use as
    ;; `undercover' library's configuration.
    `((:mode ,(or mode 'auto) :merge ,merge :force ,force)
      . (,@(when file `((:report-file ,file))) (:report-format ',format) (:send-report ,(not dontsend))))))

(defun eldev--undercover-plugin (configuration)
  "Plugin that provides integration with `undercover' library,
generating test coverage reports for your project.  Even if the
plugin is active, it will not necessarily generate the report,
see below.

This plugin only activates if project's loading mode is `as-is',
`source' or `built-source', since the library cannot handle
byte-compiled files.  If the plugin decides to collect coverage
statistics in mode `as-is', Emacs will load source files even if
byte-compiled versions are available.

By default, it is up to `undercover' library to decide whether
and which report to generate.  Normally, it does so only on
supported continuous integration services.  However, you can use
option `--undercover' (`-u') of command `test' to easily change
this.  Value of the option must be a comma and/or space-separated
list of any of the following flags:

  - `auto' (default), `on' (or `always'), `off' (or `never'):
    whether to collect coverage statistics and generate a report;

  - `coveralls' (default), `simplecov', `codecov', `text': format
    of the generated report;

  - `merge' or `restart' (default): whether to merge with
    existing report file or delete it and create new report from
    scratch; simple text reports are never merged;

  - `send' (default), `dontsend': whether to upload the report to
    coveralls.io (only for `coveralls' format);

  - `safe' (default) or `force': whether to run `undercover' even
    if the plugin detects it likely won't work on this Emacs version
    (currently these options do nothing; they had been used
    before `undercover' 0.7 got released and are kept for
    compatibility and in case they get needed again in the
    future).

Most flags have their default value provided by `undercover'
library itself.  As of version 0.8 those are `coveralls' and
`send'.  However, defaults can also be changed in project's file
`Eldev'.

Additionally, option `--undercover-report' (`-U') lets you change
the report's filename.  Default value is controlled by the
library.

When `eldev-dwim' is non-nil (default), certain flags can affect
each other:

  - if report format is not set explicitly it is derived from
    extension of report filename if possible: `.json' for
    `simplecov' format, `.txt' or `.text' for a text report;

  - when requested format is not `coveralls', report is always
    generated unless `auto' or `off' (`never') is specified
    explicitly.

This special handling is aimed at reports created for local use,
i.e. usually in `simplecov' format.  Default values are normally
for coveralls.io and the report only gets generated on supported
continuous integration services."
  (add-hook 'eldev-test-hook (lambda () (eldev--set-up-undercover configuration)))
  (eldev-add-documentation-preprocessor 'eldev-test (lambda (documentation)
                                                      (concat documentation "\n\n"
                                                              (eldev-colorize "Plugin `undercover'" 'section) "\n\n"
                                                              (documentation 'eldev--undercover-test-doc t))))
  (eldev-defoption eldev-set-undercover-config (config)
    "Whether and how to use `undercover'"
    :options        (-u --undercover)
    :value          CONFIG
    :for-command    test
    (let (new-flags)
      (dolist (flag (split-string config "[, \t]" t "[ \t]+"))
        (unless (memq (setf flag (intern flag)) eldev--undercover-flags)
          (signal 'eldev-wrong-option-usage `("unknown flag `%s'" flag)))
        (push flag new-flags))
        (setf eldev-undercover-config (append (eldev-listify eldev-undercover-config) (nreverse new-flags)))))
  (eldev-defoption eldev-set-undercover-report-file (file)
    "Set `undercover's report filename"
    :options        (-U --undercover-report)
    :value          FILE
    :for-command    test
    (setf eldev-undercover-report-file file))
  (eldev-documentation 'eldev--undercover-plugin))

(defun eldev--undercover-test-doc ()
  "This plugin adds a runtime dependency on `undercover' package
and tells it which files to instrument.  By default, those are
all Elisp files in your `main' target set; change value of
variable `eldev-undercover-fileset' if needed.  See detailed
plugin documentation for more information."
  nil)

(defun eldev--set-up-undercover (configuration)
  (let* ((configuration (eldev--undercover-config configuration))
         (mode          (plist-get (car configuration) :mode)))
    (cond ((eq mode 'off)
           (eldev-trace "Disabled `undercover' coverage report generation"))
          ((not (memq eldev-project-loading-mode '(nil as-is source built-source)))
           ;; It looks like Emacs loads source files when they have load handlers, even if
           ;; there is `.elc' available.  However, let's still disable `undercover' when
           ;; any of the byte-compiling loading modes are requested: plugin is secondary
           ;; and shouldn't change the mode.  On the bright side, we don't need to care if
           ;; files are byte-compiled when using `as-is' mode with `undercover'.
           (if (eq mode 'on)
               (eldev-warn "Cannot collect coverage information from byte-compiled files; plugin `undercover' will not be enabled")
             (eldev-trace "Not activating plugin `undercover' since the project is in a byte-compiled loading mode")))
          (t
           (let ((files (eldev-find-and-trace-files '(:and (eldev-standard-filesets 'main) eldev-undercover-fileset) "file%s for `undercover' to instrument" 'dont-trace)))
             (when files
               (eldev-add-extra-dependencies 'runtime '(:tool undercover))
               (eldev-load-extra-dependencies 'runtime)
               (eldev--require-external-feature 'undercover)
               (setf undercover-force-coverage (not (eq mode 'auto)))
               (eldev-trace (if undercover-force-coverage
                                "Forcing `undercover' to generate coverage report..."
                              "Leaving it up to `undercover' to decide whether to generate coverage report..."))
               ;; We already have a list of files, disable wildcard processing.
               (eldev-advised ('undercover--wildcards-to-files :override #'identity)
                 (eldev-advised ('undercover--edebug-files :before (lambda (files &rest _ignored)
                                                                     (eldev-verbose "Instrumenting %s for collecting coverage information with `undercover'"
                                                                                    (eldev-message-plural (length files) "file"))))
                   ;; Because `undercover-report' runs from `kill-emacs-hook', using
                   ;; `eldev-advised' here would not be enough.
                   (advice-add 'undercover-report :around (lambda (original &rest etc)
                                                            ;; Ugly, ugly, ugly: going deep into internals.
                                                            (let* ((report-format (when (boundp 'undercover--report-format) undercover--report-format))
                                                                   effective-report-name)
                                                              (when (boundp 'undercover--report-file-path)
                                                                (setf effective-report-name (or undercover--report-file-path
                                                                                                (pcase report-format
                                                                                                  (`coveralls "/tmp/undercover_coveralls_report")
                                                                                                  (`simplecov "coverage/.resultset.json")
                                                                                                  (`codecov   "coverage-final.json")))))
                                                              (when effective-report-name
                                                                (eldev-verbose "Saving `undercover' report to file `%s'..." effective-report-name)
                                                                ;; `undercover' will fail if file is in a non-existing directory.
                                                                (let ((dir (file-name-directory effective-report-name)))
                                                                  (when dir
                                                                    (make-directory dir t))))
                                                              (if (plist-get (car configuration) :merge)
                                                                  (eldev-trace "Code coverage report will be merged with existing")
                                                                (if effective-report-name
                                                                    (when (file-exists-p effective-report-name)
                                                                      (delete-file effective-report-name)
                                                                      (eldev-trace "Deleted previous code coverage report; new one will be restarted from scratch"))
                                                                  (unless (eq report-format 'text)
                                                                    (eldev-warn "Cannot determine where coverage report is generated; unable to honor `restart' flag"))))
                                                              (eldev-output-reroute-messages
                                                                (let ((eldev-message-rerouting-wrapper (unless (and (eq report-format 'text) (null effective-report-name))
                                                                                                         #'eldev-verbose)))
                                                                  (apply original etc))))))
                   ;; Since `undercover' is a macro, we have to do it like this.
                   (eval `(undercover ,@files ,@(cdr configuration)) t)))))))))


(provide 'eldev-plugins)

;;; eldev-plugins.el ends here