magit-tag.el (9747B)
1 ;;; magit-tag.el --- Tag functionality -*- lexical-binding:t -*- 2 3 ;; Copyright (C) 2008-2024 The Magit Project Contributors 4 5 ;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> 6 ;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> 7 8 ;; SPDX-License-Identifier: GPL-3.0-or-later 9 10 ;; Magit is free software: you can redistribute it and/or modify it 11 ;; under the terms of the GNU General Public License as published by 12 ;; the Free Software Foundation, either version 3 of the License, or 13 ;; (at your option) any later version. 14 ;; 15 ;; Magit is distributed in the hope that it will be useful, but WITHOUT 16 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY 17 ;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public 18 ;; License for more details. 19 ;; 20 ;; You should have received a copy of the GNU General Public License 21 ;; along with Magit. If not, see <https://www.gnu.org/licenses/>. 22 23 ;;; Commentary: 24 25 ;; This library implements tag commands. 26 27 ;;; Code: 28 29 (require 'magit) 30 31 ;; For `magit-tag-delete'. 32 (defvar helm-comp-read-use-marked) 33 34 ;;; Commands 35 36 ;;;###autoload (autoload 'magit-tag "magit" nil t) 37 (transient-define-prefix magit-tag () 38 "Create or delete a tag." 39 :man-page "git-tag" 40 ["Arguments" 41 ("-f" "Force" ("-f" "--force")) 42 ("-a" "Annotate" ("-a" "--annotate")) 43 ("-s" "Sign" ("-s" "--sign")) 44 (magit-tag:--local-user)] 45 [["Create" 46 ("t" "tag" magit-tag-create) 47 ("r" "release" magit-tag-release)] 48 ["Do" 49 ("k" "delete" magit-tag-delete) 50 ("p" "prune" magit-tag-prune)]]) 51 52 (defun magit-tag-arguments () 53 (transient-args 'magit-tag)) 54 55 (transient-define-argument magit-tag:--local-user () 56 :description "Sign as" 57 :class 'transient-option 58 :shortarg "-u" 59 :argument "--local-user=" 60 :reader #'magit-read-gpg-signing-key 61 :history-key 'magit:--gpg-sign) 62 63 ;;;###autoload 64 (defun magit-tag-create (name rev &optional args) 65 "Create a new tag with the given NAME at REV. 66 With a prefix argument annotate the tag. 67 \n(git tag [--annotate] NAME REV)" 68 (interactive (list (magit-read-tag "Tag name") 69 (magit-read-branch-or-commit "Place tag on") 70 (let ((args (magit-tag-arguments))) 71 (when current-prefix-arg 72 (cl-pushnew "--annotate" args :test #'equal)) 73 args))) 74 (magit-run-git-with-editor "tag" args name rev)) 75 76 ;;;###autoload 77 (defun magit-tag-delete (tags) 78 "Delete one or more tags. 79 If the region marks multiple tags (and nothing else), then offer 80 to delete those, otherwise prompt for a single tag to be deleted, 81 defaulting to the tag at point. 82 \n(git tag -d TAGS)" 83 (interactive (list (if-let ((tags (magit-region-values 'tag))) 84 (magit-confirm t nil "Delete %d tags" nil tags) 85 (let ((helm-comp-read-use-marked t)) 86 (magit-read-tag "Delete tag" t))))) 87 (magit-run-git "tag" "-d" tags)) 88 89 ;;;###autoload 90 (defun magit-tag-prune (tags remote-tags remote) 91 "Offer to delete tags missing locally from REMOTE, and vice versa." 92 (interactive 93 (let* ((remote (magit-read-remote "Prune tags using remote")) 94 (tags (magit-list-tags)) 95 (rtags (prog2 (message "Determining remote tags...") 96 (magit-remote-list-tags remote) 97 (message "Determining remote tags...done"))) 98 (ltags (cl-set-difference tags rtags :test #'equal)) 99 (rtags (cl-set-difference rtags tags :test #'equal))) 100 (unless (or ltags rtags) 101 (message "Same tags exist locally and remotely")) 102 (unless (magit-confirm t 103 "Delete %s locally" 104 "Delete %d tags locally" 105 'noabort ltags) 106 (setq ltags nil)) 107 (unless (magit-confirm t 108 "Delete %s from remote" 109 "Delete %d tags from remote" 110 'noabort rtags) 111 (setq rtags nil)) 112 (list ltags rtags remote))) 113 (when tags 114 (magit-call-git "tag" "-d" tags)) 115 (when remote-tags 116 (magit-run-git-async "push" remote (--map (concat ":" it) remote-tags)))) 117 118 (defvar magit-tag-version-regexp-alist 119 '(("^[-._+ ]?snapshot\\.?$" . -4) 120 ("^[-._+]$" . -4) 121 ("^[-._+ ]?\\(cvs\\|git\\|bzr\\|svn\\|hg\\|darcs\\)\\.?$" . -4) 122 ("^[-._+ ]?unknown\\.?$" . -4) 123 ("^[-._+ ]?alpha\\.?$" . -3) 124 ("^[-._+ ]?beta\\.?$" . -2) 125 ("^[-._+ ]?\\(pre\\|rc\\)\\.?$" . -1)) 126 "Overrides `version-regexp-alist' for `magit-tag-release'. 127 See also `magit-release-tag-regexp'.") 128 129 (defvar magit-release-tag-regexp "\\`\ 130 \\(?1:\\(?:v\\(?:ersion\\)?\\|r\\(?:elease\\)?\\)[-_]?\\)?\ 131 \\(?2:[0-9]+\\(?:\\.[0-9]+\\)*\ 132 \\(?:-[a-zA-Z0-9-]+\\(?:\\.[a-zA-Z0-9-]+\\)*\\)?\\)\\'" 133 "Regexp used by `magit-tag-release' to parse release tags. 134 135 The first submatch must match the prefix, if any. The second 136 submatch must match the version string. 137 138 If this matches versions that are not dot separated numbers, 139 then `magit-tag-version-regexp-alist' has to contain entries 140 for the separators allowed here.") 141 142 (defvar magit-release-commit-regexp "\\`Release version \\(.+\\)\\'" 143 "Regexp used by `magit-tag-release' to parse release commit messages. 144 The first submatch must match the version string.") 145 146 ;;;###autoload 147 (defun magit-tag-release (tag msg &optional args) 148 "Create a release tag for `HEAD'. 149 150 Assume that release tags match `magit-release-tag-regexp'. 151 152 If `HEAD's message matches `magit-release-commit-regexp', then 153 base the tag on the version string specified by that. Otherwise 154 prompt for the name of the new tag using the highest existing 155 tag as initial input and leaving it to the user to increment the 156 desired part of the version string. 157 158 If `--annotate' is enabled, then prompt for the message of the 159 new tag. Base the proposed tag message on the message of the 160 highest tag, provided that that contains the corresponding 161 version string and substituting the new version string for that. 162 Otherwise propose something like \"Foo-Bar 1.2.3\", given, for 163 example, a TAG \"v1.2.3\" and a repository located at something 164 like \"/path/to/foo-bar\"." 165 (interactive 166 (save-match-data 167 (pcase-let* 168 ((`(,pver ,ptag ,pmsg) (car (magit--list-releases))) 169 (msg (magit-rev-format "%s")) 170 (ver (and (string-match magit-release-commit-regexp msg) 171 (match-string 1 msg))) 172 (_ (and (not ver) 173 (require (quote sisyphus) nil t) 174 (string-match magit-release-commit-regexp 175 (magit-rev-format "%s" ptag)) 176 (user-error "Use `sisyphus-create-release' first"))) 177 (tag (cond 178 ((not ptag) 179 (read-string "Create first release tag: " 180 (if (and ver (string-match-p "\\`[0-9]" ver)) 181 (concat "v" ver) 182 ver))) 183 (ver 184 (concat (and (string-match magit-release-tag-regexp ptag) 185 (match-string 1 ptag)) 186 ver)) 187 (t 188 (read-string 189 (format "Create release tag (previous was %s): " ptag) 190 ptag)))) 191 (ver (and (string-match magit-release-tag-regexp tag) 192 (match-string 2 tag))) 193 (args (magit-tag-arguments))) 194 (list tag 195 (and (member "--annotate" args) 196 (read-string 197 (format "Message for %S: " tag) 198 (cond ((and pver (string-match (regexp-quote pver) pmsg)) 199 (replace-match ver t t pmsg)) 200 ((and ptag (string-match (regexp-quote ptag) pmsg)) 201 (replace-match tag t t pmsg)) 202 (t (format "%s %s" 203 (capitalize 204 (file-name-nondirectory 205 (directory-file-name (magit-toplevel)))) 206 ver))))) 207 args)))) 208 (magit-run-git-with-editor "tag" args (and msg (list "-m" msg)) tag) 209 (set-process-sentinel 210 magit-this-process 211 (lambda (process event) 212 (when (memq (process-status process) '(exit signal)) 213 (magit-process-sentinel process event) 214 (magit-refs-setup-buffer "HEAD" (magit-show-refs-arguments)))))) 215 216 (defun magit--list-releases () 217 "Return a list of releases. 218 The list is ordered, beginning with the highest release. 219 Each release element has the form (VERSION TAG MESSAGE). 220 `magit-release-tag-regexp' is used to determine whether 221 a tag qualifies as a release tag." 222 (save-match-data 223 (mapcar 224 #'cdr 225 (nreverse 226 (cl-sort (cl-mapcan 227 (lambda (line) 228 (and (string-match " +" line) 229 (let ((tag (substring line 0 (match-beginning 0))) 230 (msg (substring line (match-end 0)))) 231 (and (string-match magit-release-tag-regexp tag) 232 (let ((ver (match-string 2 tag)) 233 (version-regexp-alist 234 magit-tag-version-regexp-alist)) 235 (list (list (version-to-list ver) 236 ver tag msg))))))) 237 ;; Cannot rely on "--sort=-version:refname" because 238 ;; that gets confused if the version prefix has changed. 239 (magit-git-lines "tag" "-n")) 240 ;; The inverse of this function does not exist. 241 #'version-list-< :key #'car))))) 242 243 ;;; _ 244 (provide 'magit-tag) 245 ;;; magit-tag.el ends here