magit-tag.el (9959B)
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 ("-e" "Edit message" ("-e" "--edit")) 43 ("-a" "Annotate" ("-a" "--annotate")) 44 ("-s" "Sign" ("-s" "--sign")) 45 (magit-tag:--local-user)] 46 [["Create" 47 ("t" "tag" magit-tag-create) 48 ("r" "release" magit-tag-release)] 49 ["Do" 50 ("k" "delete" magit-tag-delete) 51 ("p" "prune" magit-tag-prune)]]) 52 53 (defun magit-tag-arguments () 54 (transient-args 'magit-tag)) 55 56 (transient-define-argument magit-tag:--local-user () 57 :description "Sign as" 58 :class 'transient-option 59 :shortarg "-u" 60 :argument "--local-user=" 61 :reader #'magit-read-gpg-signing-key 62 :history-key 'magit:--gpg-sign) 63 64 ;;;###autoload 65 (defun magit-tag-create (name rev &optional args) 66 "Create a new tag with the given NAME at REV. 67 With a prefix argument annotate the tag. 68 \n(git tag [--annotate] NAME REV)" 69 (interactive (list (magit-read-tag "Tag name") 70 (magit-read-branch-or-commit "Place tag on") 71 (let ((args (magit-tag-arguments))) 72 (when current-prefix-arg 73 (cl-pushnew "--annotate" args :test #'equal)) 74 args))) 75 (magit-run-git-with-editor "tag" args name rev)) 76 77 ;;;###autoload 78 (defun magit-tag-delete (tags) 79 "Delete one or more tags. 80 If the region marks multiple tags (and nothing else), then offer 81 to delete those, otherwise prompt for a single tag to be deleted, 82 defaulting to the tag at point. 83 \n(git tag -d TAGS)" 84 (interactive (list (if-let ((tags (magit-region-values 'tag))) 85 (magit-confirm t nil "Delete %d tags" nil tags) 86 (let ((helm-comp-read-use-marked t)) 87 (magit-read-tag "Delete tag" t))))) 88 (magit-run-git "tag" "-d" tags)) 89 90 ;;;###autoload 91 (defun magit-tag-prune (tags remote-tags remote) 92 "Offer to delete tags missing locally from REMOTE, and vice versa." 93 (interactive 94 (let* ((remote (magit-read-remote "Prune tags using remote")) 95 (tags (magit-list-tags)) 96 (rtags (prog2 (message "Determining remote tags...") 97 (magit-remote-list-tags remote) 98 (message "Determining remote tags...done"))) 99 (ltags (cl-set-difference tags rtags :test #'equal)) 100 (rtags (cl-set-difference rtags tags :test #'equal))) 101 (unless (or ltags rtags) 102 (message "Same tags exist locally and remotely")) 103 (unless (magit-confirm t 104 "Delete %s locally" 105 "Delete %d tags locally" 106 'noabort ltags) 107 (setq ltags nil)) 108 (unless (magit-confirm t 109 "Delete %s from remote" 110 "Delete %d tags from remote" 111 'noabort rtags) 112 (setq rtags nil)) 113 (list ltags rtags remote))) 114 (when tags 115 (magit-call-git "tag" "-d" tags)) 116 (when remote-tags 117 (magit-run-git-async "push" remote (--map (concat ":" it) remote-tags)))) 118 119 (defvar magit-tag-version-regexp-alist 120 '(("^[-._+ ]?snapshot\\.?$" . -4) 121 ("^[-._+]$" . -4) 122 ("^[-._+ ]?\\(cvs\\|git\\|bzr\\|svn\\|hg\\|darcs\\)\\.?$" . -4) 123 ("^[-._+ ]?unknown\\.?$" . -4) 124 ("^[-._+ ]?alpha\\.?$" . -3) 125 ("^[-._+ ]?beta\\.?$" . -2) 126 ("^[-._+ ]?\\(pre\\|rc\\)\\.?$" . -1)) 127 "Overrides `version-regexp-alist' for `magit-tag-release'. 128 See also `magit-release-tag-regexp'.") 129 130 (defvar magit-release-tag-regexp "\\`\ 131 \\(?1:\\(?:v\\(?:ersion\\)?\\|r\\(?:elease\\)?\\)[-_]?\\)?\ 132 \\(?2:[0-9]+\\(?:\\.[0-9]+\\)*\ 133 \\(?:-[a-zA-Z0-9-]+\\(?:\\.[a-zA-Z0-9-]+\\)*\\)?\\)\\'" 134 "Regexp used by `magit-tag-release' to parse release tags. 135 136 The first submatch must match the prefix, if any. The second 137 submatch must match the version string. 138 139 If this matches versions that are not dot separated numbers, 140 then `magit-tag-version-regexp-alist' has to contain entries 141 for the separators allowed here.") 142 143 (defvar magit-release-commit-regexp "\\`Release version \\(.+\\)\\'" 144 "Regexp used by `magit-tag-release' to parse release commit messages. 145 The first submatch must match the version string.") 146 147 ;;;###autoload 148 (defun magit-tag-release (tag msg &optional args) 149 "Create a release tag for `HEAD'. 150 151 Assume that release tags match `magit-release-tag-regexp'. 152 153 If `HEAD's message matches `magit-release-commit-regexp', then 154 base the tag on the version string specified by that. Otherwise 155 prompt for the name of the new tag using the highest existing 156 tag as initial input and leaving it to the user to increment the 157 desired part of the version string. 158 159 When creating an annotated tag, prepare a message based on the message 160 of the highest existing tag, provided that contains the corresponding 161 version string, and substituting the new version string for that. If 162 that is not the case, propose a message using a reasonable format." 163 (interactive 164 (save-match-data 165 (pcase-let* 166 ((args (magit-tag-arguments)) 167 (`(,pver ,ptag ,pmsg) (car (magit--list-releases))) 168 (msg (magit-rev-format "%s")) 169 (ver (and (string-match magit-release-commit-regexp msg) 170 (match-string 1 msg))) 171 (_ (and (not ver) 172 (require (quote sisyphus) nil t) 173 (string-match magit-release-commit-regexp 174 (magit-rev-format "%s" ptag)) 175 (user-error "Use `sisyphus-create-release' first"))) 176 (tag (cond 177 ((not ptag) 178 ;; Force the user to review the message used for the 179 ;; initial release tag, in case they do not like the 180 ;; default format. 181 (cl-pushnew "--edit" args :test #'equal) 182 (read-string "Create first release tag: " 183 (if (and ver (string-match-p "\\`[0-9]" ver)) 184 (concat "v" ver) 185 ver))) 186 (ver 187 (concat (and (string-match magit-release-tag-regexp ptag) 188 (match-string 1 ptag)) 189 ver)) 190 (t 191 (read-string 192 (format "Create release tag (previous was %s): " ptag) 193 ptag)))) 194 (ver (and (string-match magit-release-tag-regexp tag) 195 (match-string 2 tag)))) 196 (list tag 197 (and (seq-some (apply-partially 198 #'string-match-p 199 "\\`--\\(annotate\\|local-user\\|sign\\)") 200 args) 201 (cond ((and pver (string-match (regexp-quote pver) pmsg)) 202 (replace-match ver t t pmsg)) 203 ((and ptag (string-match (regexp-quote ptag) pmsg)) 204 (replace-match tag t t pmsg)) 205 ((format "%s %s" 206 (capitalize 207 (file-name-nondirectory 208 (directory-file-name (magit-toplevel)))) 209 ver)))) 210 args)))) 211 (magit-run-git-with-editor "tag" args (and msg (list "-m" msg)) tag) 212 (set-process-sentinel 213 magit-this-process 214 (lambda (process event) 215 (when (memq (process-status process) '(exit signal)) 216 (magit-process-sentinel process event) 217 (magit-refs-setup-buffer "HEAD" (magit-show-refs-arguments)))))) 218 219 (defun magit--list-releases () 220 "Return a list of releases. 221 The list is ordered, beginning with the highest release. 222 Each release element has the form (VERSION TAG MESSAGE). 223 `magit-release-tag-regexp' is used to determine whether 224 a tag qualifies as a release tag." 225 (save-match-data 226 (mapcar 227 #'cdr 228 (nreverse 229 (cl-sort (cl-mapcan 230 (lambda (line) 231 (and (string-match " +" line) 232 (let ((tag (substring line 0 (match-beginning 0))) 233 (msg (substring line (match-end 0)))) 234 (and (string-match magit-release-tag-regexp tag) 235 (let ((ver (match-string 2 tag)) 236 (version-regexp-alist 237 magit-tag-version-regexp-alist)) 238 (list (list (version-to-list ver) 239 ver tag msg))))))) 240 ;; Cannot rely on "--sort=-version:refname" because 241 ;; that gets confused if the version prefix has changed. 242 (magit-git-lines "tag" "-n")) 243 ;; The inverse of this function does not exist. 244 #'version-list-< :key #'car))))) 245 246 ;;; _ 247 (provide 'magit-tag) 248 ;;; magit-tag.el ends here