| 1 | ;;; magit-wip.el --- Commit snapshots to work-in-progress refs -*- lexical-binding:t -*- |
| 2 | |
| 3 | ;; Copyright (C) 2008-2026 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 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 | (defcustom magit-wip-mode-lighter " Wip" |
| 44 | "Lighter for Magit-Wip mode." |
| 45 | :package-version '(magit . "2.90.0") |
| 46 | :group 'magit-wip |
| 47 | :type 'string) |
| 48 | |
| 49 | (defcustom magit-wip-merge-branch nil |
| 50 | "Whether to merge the current branch into its wip ref. |
| 51 | |
| 52 | If nil and the current branch has new commits, then the wip ref |
| 53 | is reset to the tip of the branch before creating a new wip |
| 54 | commit. With this setting wip commits are eventually garbage |
| 55 | collected. This is currently the default. |
| 56 | |
| 57 | If non-nil and the current branch has new commits, then it is |
| 58 | merged into the wip ref before creating a new wip commit. This |
| 59 | makes it easier to inspect wip history and the wip commits are |
| 60 | never garbage collected. |
| 61 | |
| 62 | When this and `magit-run-hooks-from-githooks' are both enabled, |
| 63 | and the other conditions mention in the docstring of that option |
| 64 | are also met, then the wip merge commit is created right after |
| 65 | the user creates a regular commit. Otherwise the wip merge |
| 66 | commit is created right before the next regular commit." |
| 67 | :package-version '(magit . "2.90.0") |
| 68 | :group 'magit-wip |
| 69 | :type 'boolean) |
| 70 | |
| 71 | (defcustom magit-wip-namespace "refs/wip/" |
| 72 | "Namespace used for work-in-progress refs. |
| 73 | The wip refs are named \"<namespace/>index/<branchref>\" |
| 74 | and \"<namespace/>wtree/<branchref>\". When snapshots |
| 75 | are created while the `HEAD' is detached then \"HEAD\" |
| 76 | is used as `branch-ref'." |
| 77 | :package-version '(magit . "2.1.0") |
| 78 | :group 'magit-wip |
| 79 | :type 'string) |
| 80 | |
| 81 | (defcustom magit-wip-debug nil |
| 82 | "Whether to record commands used to update wip refs. |
| 83 | If non-nil, log the used commands and their output in the process |
| 84 | buffer." |
| 85 | :package-version '(magit . "4.5.0") |
| 86 | :group 'magit-wip |
| 87 | :type 'boolean) |
| 88 | |
| 89 | ;;; Mode |
| 90 | |
| 91 | (defvar magit--wip-inhibit-autosave nil) |
| 92 | |
| 93 | ;;;###autoload |
| 94 | (define-minor-mode magit-wip-mode |
| 95 | "Automatically save uncommitted changes to work-in-progress refs." |
| 96 | :package-version '(magit . "2.90.0") |
| 97 | :lighter magit-wip-mode-lighter |
| 98 | :global t |
| 99 | (cond |
| 100 | (magit-wip-mode |
| 101 | (add-hook 'after-save-hook #'magit-wip-commit-buffer-file) |
| 102 | (add-hook 'magit-after-apply-functions #'magit-wip-commit) |
| 103 | (add-hook 'magit-before-change-functions #'magit-wip-commit) |
| 104 | (add-hook 'before-save-hook #'magit-wip-commit-initial-backup) |
| 105 | (add-hook 'magit-common-git-post-commit-functions |
| 106 | #'magit-wip-post-commit)) |
| 107 | (t |
| 108 | (remove-hook 'after-save-hook #'magit-wip-commit-buffer-file) |
| 109 | (remove-hook 'magit-after-apply-functions #'magit-wip-commit) |
| 110 | (remove-hook 'magit-before-change-functions #'magit-wip-commit) |
| 111 | (remove-hook 'before-save-hook #'magit-wip-commit-initial-backup) |
| 112 | (remove-hook 'magit-common-git-post-commit-functions |
| 113 | #'magit-wip-post-commit)))) |
| 114 | |
| 115 | (defun magit-wip-commit-buffer-file (&optional msg) |
| 116 | "Commit visited file to a worktree work-in-progress ref." |
| 117 | (interactive (list "save %s snapshot")) |
| 118 | (when (magit-wip--commitable-p) |
| 119 | (magit-wip-commit-worktree |
| 120 | (magit-wip-get-ref) |
| 121 | (list buffer-file-name) |
| 122 | (format (or msg "autosave %s after save") |
| 123 | (magit-file-relative-name buffer-file-name))))) |
| 124 | |
| 125 | (defun magit-run-after-apply-functions (files task) |
| 126 | (run-hook-with-args 'magit-after-apply-functions |
| 127 | (ensure-list files) |
| 128 | (format " after %s" task))) |
| 129 | |
| 130 | (defun magit-run-before-change-functions (files task) |
| 131 | (run-hook-with-args 'magit-before-change-functions |
| 132 | (ensure-list files) |
| 133 | (format " before %s" task))) |
| 134 | |
| 135 | (defvar-local magit-wip-buffer-backed-up nil) |
| 136 | (put 'magit-wip-buffer-backed-up 'permanent-local t) |
| 137 | |
| 138 | (defun magit-wip-commit-initial-backup () |
| 139 | (when (magit-wip--commitable-p) |
| 140 | (let ((magit-save-repository-buffers nil)) |
| 141 | (magit-wip-commit-buffer-file "autosave %s before save")) |
| 142 | (setq magit-wip-buffer-backed-up t))) |
| 143 | |
| 144 | (defun magit-wip-post-commit (&rest _) |
| 145 | (magit-wip-commit)) |
| 146 | |
| 147 | ;;; Core |
| 148 | |
| 149 | (defun magit-wip-commit (&optional files msg) |
| 150 | "Commit all tracked files to the work-in-progress refs. |
| 151 | |
| 152 | Interactively, commit all changes to all tracked files using |
| 153 | a generic commit message. With a prefix-argument the commit |
| 154 | message is read in the minibuffer. |
| 155 | |
| 156 | Non-interactively, only commit changes to FILES using MSG as |
| 157 | commit message." |
| 158 | (interactive (list nil (if current-prefix-arg |
| 159 | (magit-read-string "Wip commit message") |
| 160 | "wip-save tracked files"))) |
| 161 | (when-let ((ref (magit-wip-get-ref))) |
| 162 | (magit-wip-commit-index ref files msg) |
| 163 | (magit-wip-commit-worktree ref files msg))) |
| 164 | |
| 165 | (defun magit-wip-commit-index (ref files msg) |
| 166 | (let* ((wipref (magit--wip-index-ref ref)) |
| 167 | (parent (magit-wip-get-parent ref wipref)) |
| 168 | (tree (magit-git-string "write-tree"))) |
| 169 | (magit-wip-update-wipref ref wipref tree parent files msg "index"))) |
| 170 | |
| 171 | (defun magit-wip-commit-worktree (ref files msg) |
| 172 | (when (or (not files) |
| 173 | ;; "git update-index" either ignores (before Git v2.32.0) or |
| 174 | ;; fails, when passed directories. This is relevant for the |
| 175 | ;; untracked files code paths. |
| 176 | (setq files (seq-remove #'file-directory-p files))) |
| 177 | (let* ((wipref (magit--wip-wtree-ref ref)) |
| 178 | (parent (magit-wip-get-parent ref wipref)) |
| 179 | (tree (condition-case nil |
| 180 | (magit-with-temp-index parent (list "--reset" "-i") |
| 181 | (if files |
| 182 | ;; Use "git update-index" instead of "git add" |
| 183 | ;; because the latter fails if a file is already |
| 184 | ;; deleted in the temporary index. |
| 185 | (magit-wip--git "update-index" "--add" "--remove" |
| 186 | "--ignore-skip-worktree-entries" |
| 187 | "--" files) |
| 188 | (magit-with-toplevel |
| 189 | (magit-wip--git "add" "-u" "."))) |
| 190 | (magit-git-string "write-tree")) |
| 191 | (error |
| 192 | (message "Index locked; no worktree wip commit created"))))) |
| 193 | (when tree |
| 194 | (magit-wip-update-wipref ref wipref tree parent |
| 195 | files msg "worktree"))))) |
| 196 | |
| 197 | (defun magit-wip--git (&rest args) |
| 198 | (if magit-wip-debug |
| 199 | (let ((default-process-coding-system (magit--process-coding-system))) |
| 200 | (apply #'magit-call-process |
| 201 | (magit-git-executable) |
| 202 | (magit-process-git-arguments args))) |
| 203 | (apply #'magit-process-file |
| 204 | (magit-git-executable) nil nil nil |
| 205 | (magit-process-git-arguments args)))) |
| 206 | |
| 207 | (defun magit-wip-update-wipref (ref wipref tree parent files msg start-msg) |
| 208 | (cond |
| 209 | ((and (not (equal parent wipref)) |
| 210 | (or (not magit-wip-merge-branch) |
| 211 | (not (magit-rev-verify wipref)))) |
| 212 | (setq start-msg (concat "start autosaving " start-msg)) |
| 213 | (magit-wip--update-ref wipref start-msg |
| 214 | (magit-git-string "commit-tree" "--no-gpg-sign" |
| 215 | "-p" parent "-m" start-msg |
| 216 | (concat parent "^{tree}"))) |
| 217 | (setq parent wipref)) |
| 218 | ((and magit-wip-merge-branch |
| 219 | (or (not (magit-rev-ancestor-p ref wipref)) |
| 220 | (not (magit-rev-ancestor-p |
| 221 | (concat (magit-git-string "log" "--format=%H" |
| 222 | "-1" "--merges" wipref) |
| 223 | "^2") |
| 224 | ref)))) |
| 225 | (setq start-msg (format "merge %s into %s" ref start-msg)) |
| 226 | (magit-wip--update-ref wipref start-msg |
| 227 | (magit-git-string "commit-tree" "--no-gpg-sign" |
| 228 | "-p" wipref "-p" ref |
| 229 | "-m" start-msg |
| 230 | (concat ref "^{tree}"))) |
| 231 | (setq parent wipref))) |
| 232 | (when (magit-git-failure "diff-tree" "--quiet" parent tree "--" files) |
| 233 | (unless (and msg (not (= (aref msg 0) ?\s))) |
| 234 | (let ((len (length files))) |
| 235 | (setq msg (concat |
| 236 | (cond ((= len 0) "autosave tracked files") |
| 237 | ((> len 1) (format "autosave %s files" len)) |
| 238 | ((concat "autosave " |
| 239 | (file-relative-name (car files) |
| 240 | (magit-toplevel))))) |
| 241 | msg)))) |
| 242 | (magit-wip--update-ref wipref msg |
| 243 | (magit-git-string "commit-tree" "--no-gpg-sign" |
| 244 | "-p" parent "-m" msg tree)))) |
| 245 | |
| 246 | (defun magit-wip--update-ref (ref message rev) |
| 247 | (let ((magit--refresh-cache nil)) |
| 248 | (unless (zerop (magit-wip--git "update-ref" "--create-reflog" |
| 249 | "-m" message ref rev)) |
| 250 | (error "Cannot update %s with %s" ref rev)))) |
| 251 | |
| 252 | (defun magit-wip-get-ref () |
| 253 | (let ((ref (or (magit-git-string "symbolic-ref" "HEAD") "HEAD"))) |
| 254 | (and (magit-rev-verify ref) |
| 255 | ref))) |
| 256 | |
| 257 | (defun magit-wip-get-parent (ref wipref) |
| 258 | (if (and (magit-rev-verify wipref) |
| 259 | (equal (magit-merge-base wipref ref) |
| 260 | (magit-rev-verify ref))) |
| 261 | wipref |
| 262 | ref)) |
| 263 | |
| 264 | (defun magit--wip-index-ref (&optional ref) |
| 265 | (magit--wip-ref "index/" ref)) |
| 266 | |
| 267 | (defun magit--wip-wtree-ref (&optional ref) |
| 268 | (magit--wip-ref "wtree/" ref)) |
| 269 | |
| 270 | (defun magit--wip-ref (namespace &optional ref) |
| 271 | (concat magit-wip-namespace namespace |
| 272 | (or (and ref (string-prefix-p "refs/" ref) ref) |
| 273 | (and-let ((_(not (equal ref "HEAD"))) |
| 274 | (branch (or ref (magit-get-current-branch)))) |
| 275 | (concat "refs/heads/" branch)) |
| 276 | "HEAD"))) |
| 277 | |
| 278 | (defun magit-wip--commitable-p () |
| 279 | (and (not magit--wip-inhibit-autosave) |
| 280 | buffer-file-name |
| 281 | (magit-inside-worktree-p t) |
| 282 | (magit-file-tracked-p buffer-file-name) |
| 283 | (magit-wip-get-ref))) |
| 284 | |
| 285 | ;;; Log |
| 286 | |
| 287 | (defun magit-wip-log-index (args files) |
| 288 | "Show log for the index wip ref of the current branch." |
| 289 | (interactive (magit-log-arguments)) |
| 290 | (magit-log-setup-buffer (list (magit--wip-index-ref)) args files)) |
| 291 | |
| 292 | (defun magit-wip-log-worktree (args files) |
| 293 | "Show log for the worktree wip ref of the current branch." |
| 294 | (interactive (magit-log-arguments)) |
| 295 | (magit-log-setup-buffer (list (magit--wip-wtree-ref)) args files)) |
| 296 | |
| 297 | (defun magit-wip-log-current (branch args files count) |
| 298 | "Show log for the current branch and its wip refs. |
| 299 | With a negative prefix argument only show the worktree wip ref. |
| 300 | The absolute numeric value of the prefix argument controls how |
| 301 | many \"branches\" of each wip ref are shown." |
| 302 | (interactive |
| 303 | (nconc (list (or (magit-get-current-branch) "HEAD")) |
| 304 | (magit-log-arguments) |
| 305 | (list (prefix-numeric-value current-prefix-arg)))) |
| 306 | (magit-wip-log branch args files count)) |
| 307 | |
| 308 | (defun magit-wip-log (branch args files count) |
| 309 | "Show log for a branch and its wip refs. |
| 310 | With a negative prefix argument only show the worktree wip ref. |
| 311 | The absolute numeric value of the prefix argument controls how |
| 312 | many \"branches\" of each wip ref are shown." |
| 313 | (interactive |
| 314 | (nconc (list (magit-completing-read |
| 315 | "Log branch and its wip refs" |
| 316 | (nconc (magit-list-local-branch-names) |
| 317 | (list "HEAD")) |
| 318 | nil t nil 'magit-revision-history |
| 319 | (or (magit-branch-at-point) |
| 320 | (magit-get-current-branch) |
| 321 | "HEAD"))) |
| 322 | (magit-log-arguments) |
| 323 | (list (prefix-numeric-value current-prefix-arg)))) |
| 324 | (magit-log-setup-buffer (nconc (list branch) |
| 325 | (magit-wip-log-get-tips |
| 326 | (magit--wip-wtree-ref branch) |
| 327 | (abs count)) |
| 328 | (and (>= count 0) |
| 329 | (magit-wip-log-get-tips |
| 330 | (magit--wip-index-ref branch) |
| 331 | (abs count)))) |
| 332 | args files)) |
| 333 | |
| 334 | (defun magit-wip-log-get-tips (wipref count) |
| 335 | (and-let ((reflog (magit-git-lines "reflog" wipref))) |
| 336 | (let (tips) |
| 337 | (while (and reflog (> count 1)) |
| 338 | ;; "start autosaving ..." is the current message, but it used |
| 339 | ;; to be "restart autosaving ...", and those messages may |
| 340 | ;; still be around (e.g., if gc.reflogExpire is set to "never"). |
| 341 | (setq reflog (cl-member "^[^ ]+ [^:]+: \\(?:re\\)?start autosaving" |
| 342 | reflog :test #'string-match-p)) |
| 343 | (when (and (cadr reflog) |
| 344 | (string-match "^[^ ]+ \\([^:]+\\)" (cadr reflog))) |
| 345 | (push (match-str 1 (cadr reflog)) tips)) |
| 346 | (setq reflog (cddr reflog)) |
| 347 | (decf count)) |
| 348 | (cons wipref (nreverse tips))))) |
| 349 | |
| 350 | (defun magit-wip-purge () |
| 351 | "Ask to delete all wip-refs that no longer have a corresponding ref." |
| 352 | (interactive) |
| 353 | (cond-let |
| 354 | ([wiprefs (thread-last |
| 355 | (cl-set-difference (magit-list-refs "refs/wip/") |
| 356 | (magit-list-refs) |
| 357 | :test (##equal (substring %1 15) %2)) |
| 358 | (delete "refs/wip/index/HEAD") |
| 359 | (delete "refs/wip/wtree/HEAD"))] |
| 360 | (magit-confirm 'purge-dangling-wiprefs |
| 361 | "Delete wip-ref %s without corresponding ref" |
| 362 | "Delete %d wip-refs without corresponding ref" |
| 363 | nil wiprefs) |
| 364 | (message "Deleting wip-refs...") |
| 365 | (dolist (wipref wiprefs) |
| 366 | (magit-call-git "update-ref" "-d" wipref)) |
| 367 | (message "Deleting wip-refs...done") |
| 368 | (magit-refresh)) |
| 369 | ((message "All wip-refs have a corresponding ref")))) |
| 370 | |
| 371 | ;;; _ |
| 372 | (provide 'magit-wip) |
| 373 | ;; Local Variables: |
| 374 | ;; read-symbol-shorthands: ( |
| 375 | ;; ("and$" . "cond-let--and$") |
| 376 | ;; ("thread$" . "cond-let--thread$") |
| 377 | ;; ("when$" . "cond-let--when$") |
| 378 | ;; ("and-let*" . "cond-let--and-let*") |
| 379 | ;; ("and-let" . "cond-let--and-let") |
| 380 | ;; ("if-let*" . "cond-let--if-let*") |
| 381 | ;; ("if-let" . "cond-let--if-let") |
| 382 | ;; ("when-let*" . "cond-let--when-let*") |
| 383 | ;; ("when-let" . "cond-let--when-let") |
| 384 | ;; ("while-let*" . "cond-let--while-let*") |
| 385 | ;; ("while-let" . "cond-let--while-let") |
| 386 | ;; ("match-string" . "match-string") |
| 387 | ;; ("match-str" . "match-string-no-properties")) |
| 388 | ;; End: |
| 389 | ;;; magit-wip.el ends here |