237 lines
9.1 KiB
EmacsLisp
237 lines
9.1 KiB
EmacsLisp
;;; magit-tag.el --- Tag functionality -*- lexical-binding:t -*-
|
|
|
|
;; Copyright (C) 2008-2022 The Magit Project Contributors
|
|
|
|
;; Author: Jonas Bernoulli <jonas@bernoul.li>
|
|
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
|
|
|
|
;; SPDX-License-Identifier: GPL-3.0-or-later
|
|
|
|
;; Magit 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.
|
|
;;
|
|
;; Magit 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 Magit. If not, see <https://www.gnu.org/licenses/>.
|
|
|
|
;;; Commentary:
|
|
|
|
;; This library implements tag commands.
|
|
|
|
;;; Code:
|
|
|
|
(require 'magit)
|
|
|
|
;; For `magit-tag-delete'.
|
|
(defvar helm-comp-read-use-marked)
|
|
|
|
;;;###autoload (autoload 'magit-tag "magit" nil t)
|
|
(transient-define-prefix magit-tag ()
|
|
"Create or delete a tag."
|
|
:man-page "git-tag"
|
|
["Arguments"
|
|
("-f" "Force" ("-f" "--force"))
|
|
("-a" "Annotate" ("-a" "--annotate"))
|
|
("-s" "Sign" ("-s" "--sign"))
|
|
(magit-tag:--local-user)]
|
|
[["Create"
|
|
("t" "tag" magit-tag-create)
|
|
("r" "release" magit-tag-release)]
|
|
["Do"
|
|
("k" "delete" magit-tag-delete)
|
|
("p" "prune" magit-tag-prune)]])
|
|
|
|
(defun magit-tag-arguments ()
|
|
(transient-args 'magit-tag))
|
|
|
|
(transient-define-argument magit-tag:--local-user ()
|
|
:description "Sign as"
|
|
:class 'transient-option
|
|
:shortarg "-u"
|
|
:argument "--local-user="
|
|
:reader #'magit-read-gpg-signing-key
|
|
:history-key 'magit:--gpg-sign)
|
|
|
|
;;;###autoload
|
|
(defun magit-tag-create (name rev &optional args)
|
|
"Create a new tag with the given NAME at REV.
|
|
With a prefix argument annotate the tag.
|
|
\n(git tag [--annotate] NAME REV)"
|
|
(interactive (list (magit-read-tag "Tag name")
|
|
(magit-read-branch-or-commit "Place tag on")
|
|
(let ((args (magit-tag-arguments)))
|
|
(when current-prefix-arg
|
|
(cl-pushnew "--annotate" args))
|
|
args)))
|
|
(magit-run-git-with-editor "tag" args name rev))
|
|
|
|
;;;###autoload
|
|
(defun magit-tag-delete (tags)
|
|
"Delete one or more tags.
|
|
If the region marks multiple tags (and nothing else), then offer
|
|
to delete those, otherwise prompt for a single tag to be deleted,
|
|
defaulting to the tag at point.
|
|
\n(git tag -d TAGS)"
|
|
(interactive (list (--if-let (magit-region-values 'tag)
|
|
(magit-confirm t nil "Delete %i tags" nil it)
|
|
(let ((helm-comp-read-use-marked t))
|
|
(magit-read-tag "Delete tag" t)))))
|
|
(magit-run-git "tag" "-d" tags))
|
|
|
|
;;;###autoload
|
|
(defun magit-tag-prune (tags remote-tags remote)
|
|
"Offer to delete tags missing locally from REMOTE, and vice versa."
|
|
(interactive
|
|
(let* ((remote (magit-read-remote "Prune tags using remote"))
|
|
(tags (magit-list-tags))
|
|
(rtags (prog2 (message "Determining remote tags...")
|
|
(magit-remote-list-tags remote)
|
|
(message "Determining remote tags...done")))
|
|
(ltags (-difference tags rtags))
|
|
(rtags (-difference rtags tags)))
|
|
(unless (or ltags rtags)
|
|
(message "Same tags exist locally and remotely"))
|
|
(unless (magit-confirm t
|
|
"Delete %s locally"
|
|
"Delete %i tags locally"
|
|
'noabort ltags)
|
|
(setq ltags nil))
|
|
(unless (magit-confirm t
|
|
"Delete %s from remote"
|
|
"Delete %i tags from remote"
|
|
'noabort rtags)
|
|
(setq rtags nil))
|
|
(list ltags rtags remote)))
|
|
(when tags
|
|
(magit-call-git "tag" "-d" tags))
|
|
(when remote-tags
|
|
(magit-run-git-async "push" remote (--map (concat ":" it) remote-tags))))
|
|
|
|
(defvar magit-tag-version-regexp-alist
|
|
'(("^[-._+ ]?snapshot\\.?$" . -4)
|
|
("^[-._+]$" . -4)
|
|
("^[-._+ ]?\\(cvs\\|git\\|bzr\\|svn\\|hg\\|darcs\\)\\.?$" . -4)
|
|
("^[-._+ ]?unknown\\.?$" . -4)
|
|
("^[-._+ ]?alpha\\.?$" . -3)
|
|
("^[-._+ ]?beta\\.?$" . -2)
|
|
("^[-._+ ]?\\(pre\\|rc\\)\\.?$" . -1))
|
|
"Overrides `version-regexp-alist' for `magit-tag-release'.
|
|
See also `magit-release-tag-regexp'.")
|
|
|
|
(defvar magit-release-tag-regexp "\\`\
|
|
\\(?1:\\(?:v\\(?:ersion\\)?\\|r\\(?:elease\\)?\\)?[-_]?\\)?\
|
|
\\(?2:[0-9]+\\(?:\\.[0-9]+\\)*\
|
|
\\(?:-[a-zA-Z0-9-]+\\(?:\\.[a-zA-Z0-9-]+\\)*\\)?\\)\\'"
|
|
"Regexp used by `magit-tag-release' to parse release tags.
|
|
|
|
The first submatch must match the prefix, if any. The second
|
|
submatch must match the version string.
|
|
|
|
If this matches versions that are not dot separated numbers,
|
|
then `magit-tag-version-regexp-alist' has to contain entries
|
|
for the separators allowed here.")
|
|
|
|
(defvar magit-release-commit-regexp "\\`Release version \\(.+\\)\\'"
|
|
"Regexp used by `magit-tag-release' to parse release commit messages.
|
|
The first submatch must match the version string.")
|
|
|
|
;;;###autoload
|
|
(defun magit-tag-release (tag msg &optional args)
|
|
"Create a release tag for `HEAD'.
|
|
|
|
Assume that release tags match `magit-release-tag-regexp'.
|
|
|
|
If `HEAD's message matches `magit-release-commit-regexp', then
|
|
base the tag on the version string specified by that. Otherwise
|
|
prompt for the name of the new tag using the highest existing
|
|
tag as initial input and leaving it to the user to increment the
|
|
desired part of the version string.
|
|
|
|
If `--annotate' is enabled, then prompt for the message of the
|
|
new tag. Base the proposed tag message on the message of the
|
|
highest tag, provided that that contains the corresponding
|
|
version string and substituting the new version string for that.
|
|
Otherwise propose something like \"Foo-Bar 1.2.3\", given, for
|
|
example, a TAG \"v1.2.3\" and a repository located at something
|
|
like \"/path/to/foo-bar\"."
|
|
(interactive
|
|
(save-match-data
|
|
(pcase-let*
|
|
((`(,pver ,ptag ,pmsg) (car (magit--list-releases)))
|
|
(msg (magit-rev-format "%s"))
|
|
(ver (and (string-match magit-release-commit-regexp msg)
|
|
(match-string 1 msg)))
|
|
(_ (and (not ver)
|
|
(require (quote sisyphus) nil t)
|
|
(string-match magit-release-commit-regexp
|
|
(magit-rev-format "%s" ptag))
|
|
(user-error "Use `sisyphus-create-release' first")))
|
|
(tag (if ver
|
|
(concat (and (string-match magit-release-tag-regexp ptag)
|
|
(match-string 1 ptag))
|
|
ver)
|
|
(read-string
|
|
(format "Create release tag (previous was %s): " ptag)
|
|
ptag)))
|
|
(ver (and (string-match magit-release-tag-regexp tag)
|
|
(match-string 2 tag)))
|
|
(args (magit-tag-arguments)))
|
|
(list tag
|
|
(and (member "--annotate" args)
|
|
(read-string
|
|
(format "Message for %S: " tag)
|
|
(cond ((and pver (string-match (regexp-quote pver) pmsg))
|
|
(replace-match ver t t pmsg))
|
|
((and ptag (string-match (regexp-quote ptag) pmsg))
|
|
(replace-match tag t t pmsg))
|
|
(t (format "%s %s"
|
|
(capitalize
|
|
(file-name-nondirectory
|
|
(directory-file-name (magit-toplevel))))
|
|
ver)))))
|
|
args))))
|
|
(magit-run-git-async "tag" args (and msg (list "-m" msg)) tag)
|
|
(set-process-sentinel
|
|
magit-this-process
|
|
(lambda (process event)
|
|
(when (memq (process-status process) '(exit signal))
|
|
(magit-process-sentinel process event)
|
|
(magit-refs-setup-buffer "HEAD" (magit-show-refs-arguments))))))
|
|
|
|
(defun magit--list-releases ()
|
|
"Return a list of releases.
|
|
The list is ordered, beginning with the highest release.
|
|
Each release element has the form (VERSION TAG MESSAGE).
|
|
`magit-release-tag-regexp' is used to determine whether
|
|
a tag qualifies as a release tag."
|
|
(save-match-data
|
|
(mapcar
|
|
#'cdr
|
|
(nreverse
|
|
(cl-sort (cl-mapcan
|
|
(lambda (line)
|
|
(and (string-match " +" line)
|
|
(let ((tag (substring line 0 (match-beginning 0)))
|
|
(msg (substring line (match-end 0))))
|
|
(and (string-match magit-release-tag-regexp tag)
|
|
(let ((ver (match-string 2 tag))
|
|
(version-regexp-alist
|
|
magit-tag-version-regexp-alist))
|
|
(list (list (version-to-list ver)
|
|
ver tag msg)))))))
|
|
;; Cannot rely on "--sort=-version:refname" because
|
|
;; that gets confused if the version prefix has changed.
|
|
(magit-git-lines "tag" "-n"))
|
|
;; The inverse of this function does not exist.
|
|
#'version-list-< :key #'car)))))
|
|
|
|
;;; _
|
|
(provide 'magit-tag)
|
|
;;; magit-tag.el ends here
|