config

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

magit-wip.el (19074B)


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