dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

magit-wip.el (18231B)


      1 ;;; magit-wip.el --- commit snapshots to work-in-progress refs  -*- lexical-binding: t -*-
      2 
      3 ;; Copyright (C) 2010-2021  The Magit Project Contributors
      4 ;;
      5 ;; You should have received a copy of the AUTHORS.md file which
      6 ;; lists all contributors.  If not, see http://magit.vc/authors.
      7 
      8 ;; Author: Jonas Bernoulli <jonas@bernoul.li>
      9 ;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
     10 
     11 ;; SPDX-License-Identifier: GPL-3.0-or-later
     12 
     13 ;; Magit is free software; you can redistribute it and/or modify it
     14 ;; under the terms of the GNU General Public License as published by
     15 ;; the Free Software Foundation; either version 3, or (at your option)
     16 ;; any later version.
     17 ;;
     18 ;; Magit is distributed in the hope that it will be useful, but WITHOUT
     19 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
     20 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
     21 ;; License for more details.
     22 ;;
     23 ;; You should have received a copy of the GNU General Public License
     24 ;; along with Magit.  If not, see http://www.gnu.org/licenses.
     25 
     26 ;;; Commentary:
     27 
     28 ;; This library defines tree global modes which automatically commit
     29 ;; snapshots to branch-specific work-in-progress refs before and after
     30 ;; making changes, and two commands which can be used to do so on
     31 ;; demand.
     32 
     33 ;;; Code:
     34 
     35 (require 'magit-core)
     36 (require 'magit-log)
     37 
     38 ;;; Options
     39 
     40 (defgroup magit-wip nil
     41   "Automatically commit to work-in-progress refs."
     42   :link '(info-link "(magit)Wip Modes")
     43   :group 'magit-modes
     44   :group 'magit-essentials)
     45 
     46 (defgroup magit-wip-legacy nil
     47   "It is better to not use these modes individually."
     48   :link '(info-link "(magit)Legacy Wip Modes")
     49   :group 'magit-wip)
     50 
     51 (defcustom magit-wip-mode-lighter " Wip"
     52   "Lighter for Magit-Wip mode."
     53   :package-version '(magit . "2.90.0")
     54   :group 'magit-wip
     55   :type 'string)
     56 
     57 (defcustom magit-wip-after-save-local-mode-lighter ""
     58   "Lighter for Magit-Wip-After-Save-Local mode."
     59   :package-version '(magit . "2.1.0")
     60   :group 'magit-wip-legacy
     61   :type 'string)
     62 
     63 (defcustom magit-wip-after-apply-mode-lighter ""
     64   "Lighter for Magit-Wip-After-Apply mode."
     65   :package-version '(magit . "2.1.0")
     66   :group 'magit-wip-legacy
     67   :type 'string)
     68 
     69 (defcustom magit-wip-before-change-mode-lighter ""
     70   "Lighter for Magit-Wip-Before-Change mode."
     71   :package-version '(magit . "2.1.0")
     72   :group 'magit-wip-legacy
     73   :type 'string)
     74 
     75 (defcustom magit-wip-initial-backup-mode-lighter ""
     76   "Lighter for Magit-Wip-Initial Backup mode."
     77   :package-version '(magit . "2.1.0")
     78   :group 'magit-wip-legacy
     79   :type 'string)
     80 
     81 (defcustom magit-wip-merge-branch nil
     82   "Whether to merge the current branch into its wip ref.
     83 
     84 If non-nil and the current branch has new commits, then it is
     85 merged into the wip ref before creating a new wip commit.  This
     86 makes it easier to inspect wip history and the wip commits are
     87 never garbage collected.
     88 
     89 If nil and the current branch has new commits, then the wip ref
     90 is reset to the tip of the branch before creating a new wip
     91 commit.  With this setting wip commits are eventually garbage
     92 collected.  This is currently the default."
     93   :package-version '(magit . "2.90.0")
     94   :group 'magit-wip
     95   :type 'boolean)
     96 
     97 (defcustom magit-wip-namespace "refs/wip/"
     98   "Namespace used for work-in-progress refs.
     99 The wip refs are named \"<namespace/>index/<branchref>\"
    100 and \"<namespace/>wtree/<branchref>\".  When snapshots
    101 are created while the `HEAD' is detached then \"HEAD\"
    102 is used as `branch-ref'."
    103   :package-version '(magit . "2.1.0")
    104   :group 'magit-wip
    105   :type 'string)
    106 
    107 ;;; Modes
    108 
    109 ;;;###autoload
    110 (define-minor-mode magit-wip-mode
    111   "Save uncommitted changes to work-in-progress refs.
    112 
    113 Whenever appropriate (i.e. when dataloss would be a possibility
    114 otherwise) this mode causes uncommitted changes to be committed
    115 to dedicated work-in-progress refs.
    116 
    117 For historic reasons this mode is implemented on top of four
    118 other `magit-wip-*' modes, which can also be used individually,
    119 if you want finer control over when the wip refs are updated;
    120 but that is discouraged."
    121   :package-version '(magit . "2.90.0")
    122   :lighter magit-wip-mode-lighter
    123   :global t
    124   (let ((arg (if magit-wip-mode 1 -1)))
    125     (magit-wip-after-save-mode arg)
    126     (magit-wip-after-apply-mode arg)
    127     (magit-wip-before-change-mode arg)
    128     (magit-wip-initial-backup-mode arg)))
    129 
    130 (define-minor-mode magit-wip-after-save-local-mode
    131   "After saving, also commit to a worktree work-in-progress ref.
    132 
    133 After saving the current file-visiting buffer this mode also
    134 commits the changes to the worktree work-in-progress ref for
    135 the current branch.
    136 
    137 This mode should be enabled globally by turning on the globalized
    138 variant `magit-wip-after-save-mode'."
    139   :package-version '(magit . "2.1.0")
    140   :lighter magit-wip-after-save-local-mode-lighter
    141   (if magit-wip-after-save-local-mode
    142       (if (and buffer-file-name (magit-inside-worktree-p t))
    143           (add-hook 'after-save-hook 'magit-wip-commit-buffer-file t t)
    144         (setq magit-wip-after-save-local-mode nil)
    145         (user-error "Need a worktree and a file"))
    146     (remove-hook 'after-save-hook 'magit-wip-commit-buffer-file t)))
    147 
    148 (defun magit-wip-after-save-local-mode-turn-on ()
    149   (and buffer-file-name
    150        (magit-inside-worktree-p t)
    151        (magit-file-tracked-p buffer-file-name)
    152        (magit-wip-after-save-local-mode)))
    153 
    154 ;;;###autoload
    155 (define-globalized-minor-mode magit-wip-after-save-mode
    156   magit-wip-after-save-local-mode magit-wip-after-save-local-mode-turn-on
    157   :package-version '(magit . "2.1.0")
    158   :group 'magit-wip)
    159 
    160 (defun magit-wip-commit-buffer-file (&optional msg)
    161   "Commit visited file to a worktree work-in-progress ref.
    162 
    163 Also see `magit-wip-after-save-mode' which calls this function
    164 automatically whenever a buffer visiting a tracked file is saved."
    165   (interactive)
    166   (--when-let (magit-wip-get-ref)
    167     (magit-with-toplevel
    168       (let ((file (file-relative-name buffer-file-name)))
    169         (magit-wip-commit-worktree
    170          it (list file)
    171          (format (cond (msg)
    172                        ((called-interactively-p 'any)
    173                         "wip-save %s after save")
    174                        (t
    175                         "autosave %s after save"))
    176                  file))))))
    177 
    178 ;;;###autoload
    179 (define-minor-mode magit-wip-after-apply-mode
    180   "Commit to work-in-progress refs.
    181 
    182 After applying a change using any \"apply variant\"
    183 command (apply, stage, unstage, discard, and reverse) commit the
    184 affected files to the current wip refs.  For each branch there
    185 may be two wip refs; one contains snapshots of the files as found
    186 in the worktree and the other contains snapshots of the entries
    187 in the index."
    188   :package-version '(magit . "2.1.0")
    189   :group 'magit-wip
    190   :lighter magit-wip-after-apply-mode-lighter
    191   :global t)
    192 
    193 (defun magit-wip-commit-after-apply (&optional files msg)
    194   (when magit-wip-after-apply-mode
    195     (magit-wip-commit files msg)))
    196 
    197 ;;;###autoload
    198 (define-minor-mode magit-wip-before-change-mode
    199   "Commit to work-in-progress refs before certain destructive changes.
    200 
    201 Before invoking a revert command or an \"apply variant\"
    202 command (apply, stage, unstage, discard, and reverse) commit the
    203 affected tracked files to the current wip refs.  For each branch
    204 there may be two wip refs; one contains snapshots of the files
    205 as found in the worktree and the other contains snapshots of the
    206 entries in the index.
    207 
    208 Only changes to files which could potentially be affected by the
    209 command which is about to be called are committed."
    210   :package-version '(magit . "2.1.0")
    211   :group 'magit-wip
    212   :lighter magit-wip-before-change-mode-lighter
    213   :global t)
    214 
    215 (defun magit-wip-commit-before-change (&optional files msg)
    216   (when magit-wip-before-change-mode
    217     (magit-with-toplevel
    218       (magit-wip-commit files msg))))
    219 
    220 (define-minor-mode magit-wip-initial-backup-mode
    221   "Before saving a buffer for the first time, commit to a wip ref."
    222   :package-version '(magit . "2.90.0")
    223   :group 'magit-wip
    224   :lighter magit-wip-initial-backup-mode-lighter
    225   :global t
    226   (if magit-wip-initial-backup-mode
    227       (add-hook  'before-save-hook 'magit-wip-commit-initial-backup)
    228     (remove-hook 'before-save-hook 'magit-wip-commit-initial-backup)))
    229 
    230 (defun magit--any-wip-mode-enabled-p ()
    231   "Return non-nil if any global wip mode is enabled."
    232   (or magit-wip-mode
    233       magit-wip-after-save-mode
    234       magit-wip-after-apply-mode
    235       magit-wip-before-change-mode
    236       magit-wip-initial-backup-mode))
    237 
    238 (defvar-local magit-wip-buffer-backed-up nil)
    239 (put 'magit-wip-buffer-backed-up 'permanent-local t)
    240 
    241 ;;;###autoload
    242 (defun magit-wip-commit-initial-backup ()
    243   "Before saving, commit current file to a worktree wip ref.
    244 
    245 The user has to add this function to `before-save-hook'.
    246 
    247 Commit the current state of the visited file before saving the
    248 current buffer to that file.  This backs up the same version of
    249 the file as `backup-buffer' would, but stores the backup in the
    250 worktree wip ref, which is also used by the various Magit Wip
    251 modes, instead of in a backup file as `backup-buffer' would.
    252 
    253 This function ignores the variables that affect `backup-buffer'
    254 and can be used along-side that function, which is recommended
    255 because this function only backs up files that are tracked in
    256 a Git repository."
    257   (when (and (not magit-wip-buffer-backed-up)
    258              buffer-file-name
    259              (magit-inside-worktree-p t)
    260              (magit-file-tracked-p buffer-file-name))
    261     (let ((magit-save-repository-buffers nil))
    262       (magit-wip-commit-buffer-file "autosave %s before save"))
    263     (setq magit-wip-buffer-backed-up t)))
    264 
    265 ;;; Core
    266 
    267 (defun magit-wip-commit (&optional files msg)
    268   "Commit all tracked files to the work-in-progress refs.
    269 
    270 Interactively, commit all changes to all tracked files using
    271 a generic commit message.  With a prefix-argument the commit
    272 message is read in the minibuffer.
    273 
    274 Non-interactively, only commit changes to FILES using MSG as
    275 commit message."
    276   (interactive (list nil (if current-prefix-arg
    277                              (magit-read-string "Wip commit message")
    278                            "wip-save tracked files")))
    279   (--when-let (magit-wip-get-ref)
    280     (magit-wip-commit-index it files msg)
    281     (magit-wip-commit-worktree it files msg)))
    282 
    283 (defun magit-wip-commit-index (ref files msg)
    284   (let* ((wipref (magit--wip-index-ref ref))
    285          (parent (magit-wip-get-parent ref wipref))
    286          (tree   (magit-git-string "write-tree")))
    287     (magit-wip-update-wipref ref wipref tree parent files msg "index")))
    288 
    289 (defun magit-wip-commit-worktree (ref files msg)
    290   (when (or (not files)
    291             ;; `update-index' will either ignore (before Git v2.32.0)
    292             ;; or fail when passed directories (relevant for the
    293             ;; untracked files code paths).
    294             (setq files (seq-remove #'file-directory-p files)))
    295     (let* ((wipref (magit--wip-wtree-ref ref))
    296            (parent (magit-wip-get-parent ref wipref))
    297            (tree (magit-with-temp-index parent (list "--reset" "-i")
    298                    (if files
    299                        ;; Note: `update-index' is used instead of `add'
    300                        ;; because `add' will fail if a file is already
    301                        ;; deleted in the temporary index.
    302                        (magit-call-git
    303                         "update-index" "--add" "--remove"
    304                         (and (pcase (magit-repository-local-get
    305                                      'update-index-has-ignore-sw-p 'unset)
    306                                (`unset
    307                                 (let ((val (version<= "2.25.0"
    308                                                       (magit-git-version))))
    309                                   (magit-repository-local-set
    310                                    'update-index-has-ignore-sw-p val)
    311                                   val))
    312                                (val val))
    313                              "--ignore-skip-worktree-entries")
    314                         "--" files)
    315                      (magit-with-toplevel
    316                        (magit-call-git "add" "-u" ".")))
    317                    (magit-git-string "write-tree"))))
    318       (magit-wip-update-wipref ref wipref tree parent files msg "worktree"))))
    319 
    320 (defun magit-wip-update-wipref (ref wipref tree parent files msg start-msg)
    321   (cond
    322    ((and (not (equal parent wipref))
    323          (or (not magit-wip-merge-branch)
    324              (not (magit-rev-verify wipref))))
    325     (setq start-msg (concat "start autosaving " start-msg))
    326     (magit-update-ref wipref start-msg
    327                       (magit-git-string "commit-tree" "--no-gpg-sign"
    328                                         "-p" parent "-m" start-msg
    329                                         (concat parent "^{tree}")))
    330     (setq parent wipref))
    331    ((and magit-wip-merge-branch
    332          (or (not (magit-rev-ancestor-p ref wipref))
    333              (not (magit-rev-ancestor-p
    334                    (concat (magit-git-string "log" "--format=%H"
    335                                              "-1" "--merges" wipref)
    336                            "^2")
    337                    ref))))
    338     (setq start-msg (format "merge %s into %s" ref start-msg))
    339     (magit-update-ref wipref start-msg
    340                       (magit-git-string "commit-tree" "--no-gpg-sign"
    341                                         "-p" wipref "-p" ref
    342                                         "-m" start-msg
    343                                         (concat ref "^{tree}")))
    344     (setq parent wipref)))
    345   (when (magit-git-failure "diff-tree" "--quiet" parent tree "--" files)
    346     (unless (and msg (not (= (aref msg 0) ?\s)))
    347       (let ((len (length files)))
    348         (setq msg (concat
    349                    (cond ((= len 0) "autosave tracked files")
    350                          ((> len 1) (format "autosave %s files" len))
    351                          (t (concat "autosave "
    352                                     (file-relative-name (car files)
    353                                                         (magit-toplevel)))))
    354                    msg))))
    355     (magit-update-ref wipref msg
    356                       (magit-git-string "commit-tree" "--no-gpg-sign"
    357                                         "-p" parent "-m" msg tree))))
    358 
    359 (defun magit-wip-get-ref ()
    360   (let ((ref (or (magit-git-string "symbolic-ref" "HEAD") "HEAD")))
    361     (and (magit-rev-verify ref)
    362          ref)))
    363 
    364 (defun magit-wip-get-parent (ref wipref)
    365   (if (and (magit-rev-verify wipref)
    366            (equal (magit-git-string "merge-base" wipref ref)
    367                   (magit-rev-verify ref)))
    368       wipref
    369     ref))
    370 
    371 (defun magit--wip-index-ref (&optional ref)
    372   (magit--wip-ref "index/" ref))
    373 
    374 (defun magit--wip-wtree-ref (&optional ref)
    375   (magit--wip-ref "wtree/" ref))
    376 
    377 (defun magit--wip-ref (namespace &optional ref)
    378   (concat magit-wip-namespace namespace
    379           (or (and ref (string-prefix-p "refs/" ref) ref)
    380               (when-let ((branch (and (not (equal ref "HEAD"))
    381                                       (or ref (magit-get-current-branch)))))
    382                 (concat "refs/heads/" branch))
    383               "HEAD")))
    384 
    385 (defun magit-wip-maybe-add-commit-hook ()
    386   (when (and magit-wip-merge-branch
    387              (magit-wip-any-enabled-p))
    388     (add-hook 'git-commit-post-finish-hook 'magit-wip-commit nil t)))
    389 
    390 (defun magit-wip-any-enabled-p ()
    391   (or magit-wip-mode
    392       magit-wip-after-save-local-mode
    393       magit-wip-after-save-mode
    394       magit-wip-after-apply-mode
    395       magit-wip-before-change-mode
    396       magit-wip-initial-backup-mode))
    397 
    398 ;;; Log
    399 
    400 (defun magit-wip-log-index (args files)
    401   "Show log for the index wip ref of the current branch."
    402   (interactive (magit-log-arguments))
    403   (magit-log-setup-buffer (list (magit--wip-index-ref)) args files))
    404 
    405 (defun magit-wip-log-worktree (args files)
    406   "Show log for the worktree wip ref of the current branch."
    407   (interactive (magit-log-arguments))
    408   (magit-log-setup-buffer (list (magit--wip-wtree-ref)) args files))
    409 
    410 (defun magit-wip-log-current (branch args files count)
    411   "Show log for the current branch and its wip refs.
    412 With a negative prefix argument only show the worktree wip ref.
    413 The absolute numeric value of the prefix argument controls how
    414 many \"branches\" of each wip ref are shown."
    415   (interactive
    416    (nconc (list (or (magit-get-current-branch) "HEAD"))
    417           (magit-log-arguments)
    418           (list (prefix-numeric-value current-prefix-arg))))
    419   (magit-wip-log branch args files count))
    420 
    421 (defun magit-wip-log (branch args files count)
    422   "Show log for a branch and its wip refs.
    423 With a negative prefix argument only show the worktree wip ref.
    424 The absolute numeric value of the prefix argument controls how
    425 many \"branches\" of each wip ref are shown."
    426   (interactive
    427    (nconc (list (magit-completing-read
    428                  "Log branch and its wip refs"
    429                  (-snoc (magit-list-local-branch-names) "HEAD")
    430                  nil t nil 'magit-revision-history
    431                  (or (magit-branch-at-point)
    432                      (magit-get-current-branch)
    433                      "HEAD")))
    434           (magit-log-arguments)
    435           (list (prefix-numeric-value current-prefix-arg))))
    436   (magit-log-setup-buffer (nconc (list branch)
    437                                  (magit-wip-log-get-tips
    438                                   (magit--wip-wtree-ref branch)
    439                                   (abs count))
    440                                  (and (>= count 0)
    441                                       (magit-wip-log-get-tips
    442                                        (magit--wip-index-ref branch)
    443                                        (abs count))))
    444                           args files))
    445 
    446 (defun magit-wip-log-get-tips (wipref count)
    447   (when-let ((reflog (magit-git-lines "reflog" wipref)))
    448     (let (tips)
    449       (while (and reflog (> count 1))
    450         ;; "start autosaving ..." is the current message, but it used
    451         ;; to be "restart autosaving ...", and those messages may
    452         ;; still be around (e.g., if gc.reflogExpire is to "never").
    453         (setq reflog (cl-member "^[^ ]+ [^:]+: \\(?:re\\)?start autosaving"
    454                                 reflog :test #'string-match-p))
    455         (when (and (cadr reflog)
    456                    (string-match "^[^ ]+ \\([^:]+\\)" (cadr reflog)))
    457           (push (match-string 1 (cadr reflog)) tips))
    458         (setq reflog (cddr reflog))
    459         (cl-decf count))
    460       (cons wipref (nreverse tips)))))
    461 
    462 ;;; _
    463 (provide 'magit-wip)
    464 ;;; magit-wip.el ends here