config

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

magit-wip.el (19023B)


      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                            (setq files (let ((default-directory top))
    162                                          (magit-tracked-files)))
    163                            (push `(,top ,top ,@files)
    164                                  magit--wip-activation-cache)
    165                            (unless (eq default-directory top)
    166                              (push `(,default-directory ,top ,@files)
    167                                    magit--wip-activation-cache)))
    168                          (member (file-relative-name buffer-file-name) files))
    169                      (push (list default-directory nil)
    170                            magit--wip-activation-cache)
    171                      nil))
    172                (and (magit-inside-worktree-p t)
    173                     (magit-file-tracked-p buffer-file-name))))
    174     (magit-wip-after-save-local-mode)))
    175 
    176 ;;;###autoload
    177 (define-globalized-minor-mode magit-wip-after-save-mode
    178   magit-wip-after-save-local-mode magit-wip-after-save-local-mode-turn-on
    179   :package-version '(magit . "2.1.0")
    180   :group 'magit-wip)
    181 
    182 (defun magit-wip-commit-buffer-file (&optional msg)
    183   "Commit visited file to a worktree work-in-progress ref.
    184 
    185 Also see `magit-wip-after-save-mode' which calls this function
    186 automatically whenever a buffer visiting a tracked file is saved."
    187   (interactive (list "wip-save %s after save"))
    188   (when-let (((not magit--wip-inhibit-autosave))
    189              (ref (magit-wip-get-ref)))
    190     (magit-with-toplevel
    191       (let ((file (file-relative-name buffer-file-name)))
    192         (magit-wip-commit-worktree
    193          ref (list file)
    194          (format (or msg "autosave %s after save") file))))))
    195 
    196 ;;;###autoload
    197 (define-minor-mode magit-wip-after-apply-mode
    198   "Commit to work-in-progress refs.
    199 
    200 After applying a change using any \"apply variant\"
    201 command (apply, stage, unstage, discard, and reverse) commit the
    202 affected files to the current wip refs.  For each branch there
    203 may be two wip refs; one contains snapshots of the files as found
    204 in the worktree and the other contains snapshots of the entries
    205 in the index."
    206   :package-version '(magit . "2.1.0")
    207   :group 'magit-wip
    208   :lighter magit-wip-after-apply-mode-lighter
    209   :global t)
    210 
    211 (defun magit-wip-commit-after-apply (&optional files msg)
    212   (when magit-wip-after-apply-mode
    213     (magit-wip-commit files msg)))
    214 
    215 ;;;###autoload
    216 (define-minor-mode magit-wip-before-change-mode
    217   "Commit to work-in-progress refs before certain destructive changes.
    218 
    219 Before invoking a revert command or an \"apply variant\"
    220 command (apply, stage, unstage, discard, and reverse) commit the
    221 affected tracked files to the current wip refs.  For each branch
    222 there may be two wip refs; one contains snapshots of the files
    223 as found in the worktree and the other contains snapshots of the
    224 entries in the index.
    225 
    226 Only changes to files which could potentially be affected by the
    227 command which is about to be called are committed."
    228   :package-version '(magit . "2.1.0")
    229   :group 'magit-wip
    230   :lighter magit-wip-before-change-mode-lighter
    231   :global t)
    232 
    233 (defun magit-wip-commit-before-change (&optional files msg)
    234   (when magit-wip-before-change-mode
    235     (magit-with-toplevel
    236       (magit-wip-commit files msg))))
    237 
    238 (define-minor-mode magit-wip-initial-backup-mode
    239   "Before saving a buffer for the first time, commit to a wip ref."
    240   :package-version '(magit . "2.90.0")
    241   :group 'magit-wip
    242   :lighter magit-wip-initial-backup-mode-lighter
    243   :global t
    244   (if magit-wip-initial-backup-mode
    245       (add-hook  'before-save-hook #'magit-wip-commit-initial-backup)
    246     (remove-hook 'before-save-hook #'magit-wip-commit-initial-backup)))
    247 
    248 (defun magit--any-wip-mode-enabled-p ()
    249   "Return non-nil if any global wip mode is enabled."
    250   (or magit-wip-mode
    251       magit-wip-after-save-mode
    252       magit-wip-after-apply-mode
    253       magit-wip-before-change-mode
    254       magit-wip-initial-backup-mode))
    255 
    256 (defvar-local magit-wip-buffer-backed-up nil)
    257 (put 'magit-wip-buffer-backed-up 'permanent-local t)
    258 
    259 ;;;###autoload
    260 (defun magit-wip-commit-initial-backup ()
    261   "Before saving, commit current file to a worktree wip ref.
    262 
    263 The user has to add this function to `before-save-hook'.
    264 
    265 Commit the current state of the visited file before saving the
    266 current buffer to that file.  This backs up the same version of
    267 the file as `backup-buffer' would, but stores the backup in the
    268 worktree wip ref, which is also used by the various Magit Wip
    269 modes, instead of in a backup file as `backup-buffer' would.
    270 
    271 This function ignores the variables that affect `backup-buffer'
    272 and can be used along-side that function, which is recommended
    273 because this function only backs up files that are tracked in
    274 a Git repository."
    275   (when (and (not magit-wip-buffer-backed-up)
    276              buffer-file-name
    277              (magit-inside-worktree-p t)
    278              (magit-file-tracked-p buffer-file-name))
    279     (let ((magit-save-repository-buffers nil))
    280       (magit-wip-commit-buffer-file "autosave %s before save"))
    281     (setq magit-wip-buffer-backed-up t)))
    282 
    283 ;;; Core
    284 
    285 (defun magit-wip-commit (&optional files msg)
    286   "Commit all tracked files to the work-in-progress refs.
    287 
    288 Interactively, commit all changes to all tracked files using
    289 a generic commit message.  With a prefix-argument the commit
    290 message is read in the minibuffer.
    291 
    292 Non-interactively, only commit changes to FILES using MSG as
    293 commit message."
    294   (interactive (list nil (if current-prefix-arg
    295                              (magit-read-string "Wip commit message")
    296                            "wip-save tracked files")))
    297   (when-let ((ref (magit-wip-get-ref)))
    298     (magit-wip-commit-index ref files msg)
    299     (magit-wip-commit-worktree ref files msg)))
    300 
    301 (defun magit-wip-commit-index (ref files msg)
    302   (let* ((wipref (magit--wip-index-ref ref))
    303          (parent (magit-wip-get-parent ref wipref))
    304          (tree   (magit-git-string "write-tree")))
    305     (magit-wip-update-wipref ref wipref tree parent files msg "index")))
    306 
    307 (defun magit-wip-commit-worktree (ref files msg)
    308   (when (or (not files)
    309             ;; `update-index' will either ignore (before Git v2.32.0)
    310             ;; or fail when passed directories (relevant for the
    311             ;; untracked files code paths).
    312             (setq files (seq-remove #'file-directory-p files)))
    313     (let* ((wipref (magit--wip-wtree-ref ref))
    314            (parent (magit-wip-get-parent ref wipref))
    315            (tree (magit-with-temp-index parent (list "--reset" "-i")
    316                    (if files
    317                        ;; Note: `update-index' is used instead of `add'
    318                        ;; because `add' will fail if a file is already
    319                        ;; deleted in the temporary index.
    320                        (magit-call-git
    321                         "update-index" "--add" "--remove"
    322                         (and (magit-git-version>= "2.25.0")
    323                              "--ignore-skip-worktree-entries")
    324                         "--" files)
    325                      (magit-with-toplevel
    326                        (magit-call-git "add" "-u" ".")))
    327                    (magit-git-string "write-tree"))))
    328       (magit-wip-update-wipref ref wipref tree parent files msg "worktree"))))
    329 
    330 (defun magit-wip-update-wipref (ref wipref tree parent files msg start-msg)
    331   (cond
    332    ((and (not (equal parent wipref))
    333          (or (not magit-wip-merge-branch)
    334              (not (magit-rev-verify wipref))))
    335     (setq start-msg (concat "start autosaving " start-msg))
    336     (magit-update-ref wipref start-msg
    337                       (magit-git-string "commit-tree" "--no-gpg-sign"
    338                                         "-p" parent "-m" start-msg
    339                                         (concat parent "^{tree}")))
    340     (setq parent wipref))
    341    ((and magit-wip-merge-branch
    342          (or (not (magit-rev-ancestor-p ref wipref))
    343              (not (magit-rev-ancestor-p
    344                    (concat (magit-git-string "log" "--format=%H"
    345                                              "-1" "--merges" wipref)
    346                            "^2")
    347                    ref))))
    348     (setq start-msg (format "merge %s into %s" ref start-msg))
    349     (magit-update-ref wipref start-msg
    350                       (magit-git-string "commit-tree" "--no-gpg-sign"
    351                                         "-p" wipref "-p" ref
    352                                         "-m" start-msg
    353                                         (concat ref "^{tree}")))
    354     (setq parent wipref)))
    355   (when (magit-git-failure "diff-tree" "--quiet" parent tree "--" files)
    356     (unless (and msg (not (= (aref msg 0) ?\s)))
    357       (let ((len (length files)))
    358         (setq msg (concat
    359                    (cond ((= len 0) "autosave tracked files")
    360                          ((> len 1) (format "autosave %s files" len))
    361                          ((concat "autosave "
    362                                   (file-relative-name (car files)
    363                                                       (magit-toplevel)))))
    364                    msg))))
    365     (magit-update-ref wipref msg
    366                       (magit-git-string "commit-tree" "--no-gpg-sign"
    367                                         "-p" parent "-m" msg tree))))
    368 
    369 (defun magit-wip-get-ref ()
    370   (let ((ref (or (magit-git-string "symbolic-ref" "HEAD") "HEAD")))
    371     (and (magit-rev-verify ref)
    372          ref)))
    373 
    374 (defun magit-wip-get-parent (ref wipref)
    375   (if (and (magit-rev-verify wipref)
    376            (equal (magit-git-string "merge-base" wipref ref)
    377                   (magit-rev-verify ref)))
    378       wipref
    379     ref))
    380 
    381 (defun magit--wip-index-ref (&optional ref)
    382   (magit--wip-ref "index/" ref))
    383 
    384 (defun magit--wip-wtree-ref (&optional ref)
    385   (magit--wip-ref "wtree/" ref))
    386 
    387 (defun magit--wip-ref (namespace &optional ref)
    388   (concat magit-wip-namespace namespace
    389           (or (and ref (string-prefix-p "refs/" ref) ref)
    390               (and-let* ((branch (and (not (equal ref "HEAD"))
    391                                       (or ref (magit-get-current-branch)))))
    392                 (concat "refs/heads/" branch))
    393               "HEAD")))
    394 
    395 (defun magit-wip-maybe-add-commit-hook ()
    396   (when (and magit-wip-merge-branch
    397              (magit-wip-any-enabled-p))
    398     (add-hook 'git-commit-post-finish-hook #'magit-wip-commit nil t)))
    399 
    400 (defun magit-wip-any-enabled-p ()
    401   (or magit-wip-mode
    402       magit-wip-after-save-local-mode
    403       magit-wip-after-save-mode
    404       magit-wip-after-apply-mode
    405       magit-wip-before-change-mode
    406       magit-wip-initial-backup-mode))
    407 
    408 ;;; Log
    409 
    410 (defun magit-wip-log-index (args files)
    411   "Show log for the index wip ref of the current branch."
    412   (interactive (magit-log-arguments))
    413   (magit-log-setup-buffer (list (magit--wip-index-ref)) args files))
    414 
    415 (defun magit-wip-log-worktree (args files)
    416   "Show log for the worktree wip ref of the current branch."
    417   (interactive (magit-log-arguments))
    418   (magit-log-setup-buffer (list (magit--wip-wtree-ref)) args files))
    419 
    420 (defun magit-wip-log-current (branch args files count)
    421   "Show log for the current branch and its wip refs.
    422 With a negative prefix argument only show the worktree wip ref.
    423 The absolute numeric value of the prefix argument controls how
    424 many \"branches\" of each wip ref are shown."
    425   (interactive
    426    (nconc (list (or (magit-get-current-branch) "HEAD"))
    427           (magit-log-arguments)
    428           (list (prefix-numeric-value current-prefix-arg))))
    429   (magit-wip-log branch args files count))
    430 
    431 (defun magit-wip-log (branch args files count)
    432   "Show log for a branch and its wip refs.
    433 With a negative prefix argument only show the worktree wip ref.
    434 The absolute numeric value of the prefix argument controls how
    435 many \"branches\" of each wip ref are shown."
    436   (interactive
    437    (nconc (list (magit-completing-read
    438                  "Log branch and its wip refs"
    439                  (nconc (magit-list-local-branch-names)
    440                         (list "HEAD"))
    441                  nil t nil 'magit-revision-history
    442                  (or (magit-branch-at-point)
    443                      (magit-get-current-branch)
    444                      "HEAD")))
    445           (magit-log-arguments)
    446           (list (prefix-numeric-value current-prefix-arg))))
    447   (magit-log-setup-buffer (nconc (list branch)
    448                                  (magit-wip-log-get-tips
    449                                   (magit--wip-wtree-ref branch)
    450                                   (abs count))
    451                                  (and (>= count 0)
    452                                       (magit-wip-log-get-tips
    453                                        (magit--wip-index-ref branch)
    454                                        (abs count))))
    455                           args files))
    456 
    457 (defun magit-wip-log-get-tips (wipref count)
    458   (and-let* ((reflog (magit-git-lines "reflog" wipref)))
    459     (let (tips)
    460       (while (and reflog (> count 1))
    461         ;; "start autosaving ..." is the current message, but it used
    462         ;; to be "restart autosaving ...", and those messages may
    463         ;; still be around (e.g., if gc.reflogExpire is set to "never").
    464         (setq reflog (cl-member "^[^ ]+ [^:]+: \\(?:re\\)?start autosaving"
    465                                 reflog :test #'string-match-p))
    466         (when (and (cadr reflog)
    467                    (string-match "^[^ ]+ \\([^:]+\\)" (cadr reflog)))
    468           (push (match-string 1 (cadr reflog)) tips))
    469         (setq reflog (cddr reflog))
    470         (cl-decf count))
    471       (cons wipref (nreverse tips)))))
    472 
    473 ;;; _
    474 (provide 'magit-wip)
    475 ;;; magit-wip.el ends here