config

Personal configuration.
git clone git://code.dwrz.net/config
Log | Files | Refs

magit-tag.el (9737B)


      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                          ((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