|
|
- ;;; magit-extras.el --- additional functionality for Magit -*- lexical-binding: t -*-
-
- ;; Copyright (C) 2008-2019 The Magit Project Contributors
- ;;
- ;; You should have received a copy of the AUTHORS.md file which
- ;; lists all contributors. If not, see http://magit.vc/authors.
-
- ;; Magit is free software; you can redistribute it and/or modify it
- ;; under the terms of the GNU General Public License as published by
- ;; the Free Software Foundation; either version 3, or (at your option)
- ;; any later version.
- ;;
- ;; Magit is distributed in the hope that it will be useful, but WITHOUT
- ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
- ;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
- ;; License for more details.
- ;;
- ;; You should have received a copy of the GNU General Public License
- ;; along with Magit. If not, see http://www.gnu.org/licenses.
-
- ;;; Commentary:
-
- ;; Additional functionality for Magit.
-
- ;;; Code:
-
- (eval-when-compile
- (require 'subr-x))
-
- (require 'magit)
-
- (declare-function dired-read-shell-command "dired-aux" (prompt arg files))
-
- (defvar ido-exit)
- (defvar ido-fallback)
-
- (defgroup magit-extras nil
- "Additional functionality for Magit."
- :group 'magit-extensions)
-
- ;;; External Tools
-
- (defcustom magit-gitk-executable
- (or (and (eq system-type 'windows-nt)
- (let ((exe (magit-git-string
- "-c" "alias.X=!x() { which \"$1\" | cygpath -mf -; }; x"
- "X" "gitk.exe")))
- (and exe (file-executable-p exe) exe)))
- (executable-find "gitk") "gitk")
- "The Gitk executable."
- :group 'magit-extras
- :set-after '(magit-git-executable)
- :type 'string)
-
- ;;;###autoload
- (defun magit-run-git-gui ()
- "Run `git gui' for the current git repository."
- (interactive)
- (magit-with-toplevel
- (magit-process-file magit-git-executable nil 0 nil "gui")))
-
- ;;;###autoload
- (defun magit-run-git-gui-blame (commit filename &optional linenum)
- "Run `git gui blame' on the given FILENAME and COMMIT.
- Interactively run it for the current file and the `HEAD', with a
- prefix or when the current file cannot be determined let the user
- choose. When the current buffer is visiting FILENAME instruct
- blame to center around the line point is on."
- (interactive
- (let (revision filename)
- (when (or current-prefix-arg
- (not (setq revision "HEAD"
- filename (magit-file-relative-name nil 'tracked))))
- (setq revision (magit-read-branch-or-commit "Blame from revision"))
- (setq filename (magit-read-file-from-rev revision "Blame file")))
- (list revision filename
- (and (equal filename
- (ignore-errors
- (magit-file-relative-name buffer-file-name)))
- (line-number-at-pos)))))
- (magit-with-toplevel
- (apply #'magit-process-file magit-git-executable nil 0 nil "gui" "blame"
- `(,@(and linenum (list (format "--line=%d" linenum)))
- ,commit
- ,filename))))
-
- ;;;###autoload
- (defun magit-run-gitk ()
- "Run `gitk' in the current repository."
- (interactive)
- (magit-process-file magit-gitk-executable nil 0))
-
- ;;;###autoload
- (defun magit-run-gitk-branches ()
- "Run `gitk --branches' in the current repository."
- (interactive)
- (magit-process-file magit-gitk-executable nil 0 nil "--branches"))
-
- ;;;###autoload
- (defun magit-run-gitk-all ()
- "Run `gitk --all' in the current repository."
- (interactive)
- (magit-process-file magit-gitk-executable nil 0 nil "--all"))
-
- ;;; Emacs Tools
-
- ;;;###autoload
- (defun ido-enter-magit-status ()
- "Drop into `magit-status' from file switching.
-
- This command does not work in Emacs 26.1.
- See https://github.com/magit/magit/issues/3634
- and https://debbugs.gnu.org/cgi/bugreport.cgi?bug=31707.
-
- To make this command available use something like:
-
- (add-hook \\='ido-setup-hook
- (lambda ()
- (define-key ido-completion-map
- (kbd \"C-x g\") \\='ido-enter-magit-status)))
-
- Starting with Emacs 25.1 the Ido keymaps are defined just once
- instead of every time Ido is invoked, so now you can modify it
- like pretty much every other keymap:
-
- (define-key ido-common-completion-map
- (kbd \"C-x g\") \\='ido-enter-magit-status)"
- (interactive)
- (setq ido-exit 'fallback)
- (setq ido-fallback 'magit-status) ; for Emacs >= 26.2
- (with-no-warnings (setq fallback 'magit-status)) ; for Emacs 25
- (exit-minibuffer))
-
- ;;;###autoload
- (defun magit-dired-jump (&optional other-window)
- "Visit file at point using Dired.
- With a prefix argument, visit in another window. If there
- is no file at point, then instead visit `default-directory'."
- (interactive "P")
- (dired-jump other-window
- (when-let ((file (magit-file-at-point)))
- (expand-file-name (if (file-directory-p file)
- (file-name-as-directory file)
- file)))))
-
- ;;;###autoload
- (defun magit-dired-log (&optional follow)
- "Show log for all marked files, or the current file."
- (interactive "P")
- (if-let ((topdir (magit-toplevel default-directory)))
- (let ((args (car (magit-log-arguments)))
- (files (dired-get-marked-files nil nil #'magit-file-tracked-p)))
- (unless files
- (user-error "No marked file is being tracked by Git"))
- (when (and follow
- (not (member "--follow" args))
- (not (cdr files)))
- (push "--follow" args))
- (magit-log-setup-buffer
- (list (or (magit-get-current-branch) "HEAD"))
- args
- (let ((default-directory topdir))
- (mapcar #'file-relative-name files))
- magit-log-buffer-file-locked))
- (magit--not-inside-repository-error)))
-
- ;;;###autoload
- (defun magit-do-async-shell-command (file)
- "Open FILE with `dired-do-async-shell-command'.
- Interactively, open the file at point."
- (interactive (list (or (magit-file-at-point)
- (completing-read "Act on file: "
- (magit-list-files)))))
- (require 'dired-aux)
- (dired-do-async-shell-command
- (dired-read-shell-command "& on %s: " current-prefix-arg (list file))
- nil (list file)))
-
- ;;; Shift Selection
-
- (defun magit--turn-on-shift-select-mode-p ()
- (and shift-select-mode
- this-command-keys-shift-translated
- (not mark-active)
- (not (eq (car-safe transient-mark-mode) 'only))))
-
- ;;;###autoload
- (defun magit-previous-line (&optional arg try-vscroll)
- "Like `previous-line' but with Magit-specific shift-selection.
-
- Magit's selection mechanism is based on the region but selects an
- area that is larger than the region. This causes `previous-line'
- when invoked while holding the shift key to move up one line and
- thereby select two lines. When invoked inside a hunk body this
- command does not move point on the first invocation and thereby
- it only selects a single line. Which inconsistency you prefer
- is a matter of preference."
- (declare (interactive-only
- "use `forward-line' with negative argument instead."))
- (interactive "p\np")
- (unless arg (setq arg 1))
- (let ((stay (or (magit-diff-inside-hunk-body-p)
- (magit-section-position-in-heading-p))))
- (if (and stay (= arg 1) (magit--turn-on-shift-select-mode-p))
- (push-mark nil nil t)
- (with-no-warnings
- (handle-shift-selection)
- (previous-line (if stay (max (1- arg) 1) arg) try-vscroll)))))
-
- ;;;###autoload
- (defun magit-next-line (&optional arg try-vscroll)
- "Like `next-line' but with Magit-specific shift-selection.
-
- Magit's selection mechanism is based on the region but selects
- an area that is larger than the region. This causes `next-line'
- when invoked while holding the shift key to move down one line
- and thereby select two lines. When invoked inside a hunk body
- this command does not move point on the first invocation and
- thereby it only selects a single line. Which inconsistency you
- prefer is a matter of preference."
- (declare (interactive-only forward-line))
- (interactive "p\np")
- (unless arg (setq arg 1))
- (let ((stay (or (magit-diff-inside-hunk-body-p)
- (magit-section-position-in-heading-p))))
- (if (and stay (= arg 1) (magit--turn-on-shift-select-mode-p))
- (push-mark nil nil t)
- (with-no-warnings
- (handle-shift-selection)
- (next-line (if stay (max (1- arg) 1) arg) try-vscroll)))))
-
- ;;; Clean
-
- ;;;###autoload
- (defun magit-clean (&optional arg)
- "Remove untracked files from the working tree.
- With a prefix argument also remove ignored files,
- with two prefix arguments remove ignored files only.
- \n(git clean -f -d [-x|-X])"
- (interactive "p")
- (when (yes-or-no-p (format "Remove %s files? "
- (pcase arg
- (1 "untracked")
- (4 "untracked and ignored")
- (_ "ignored"))))
- (magit-wip-commit-before-change)
- (magit-run-git "clean" "-f" "-d" (pcase arg (4 "-x") (16 "-X")))))
-
- (put 'magit-clean 'disabled t)
-
- ;;; ChangeLog
-
- ;;;###autoload
- (defun magit-add-change-log-entry (&optional whoami file-name other-window)
- "Find change log file and add date entry and item for current change.
- This differs from `add-change-log-entry' (which see) in that
- it acts on the current hunk in a Magit buffer instead of on
- a position in a file-visiting buffer."
- (interactive (list current-prefix-arg
- (prompt-for-change-log-name)))
- (pcase-let ((`(,buf ,pos) (magit-diff-visit-file--noselect)))
- (magit--with-temp-position buf pos
- (add-change-log-entry whoami file-name other-window))))
-
- ;;;###autoload
- (defun magit-add-change-log-entry-other-window (&optional whoami file-name)
- "Find change log file in other window and add entry and item.
- This differs from `add-change-log-entry-other-window' (which see)
- in that it acts on the current hunk in a Magit buffer instead of
- on a position in a file-visiting buffer."
- (interactive (and current-prefix-arg
- (list current-prefix-arg
- (prompt-for-change-log-name))))
- (magit-add-change-log-entry whoami file-name t))
-
- ;;; Edit Line Commit
-
- ;;;###autoload
- (defun magit-edit-line-commit (&optional type)
- "Edit the commit that added the current line.
-
- With a prefix argument edit the commit that removes the line,
- if any. The commit is determined using `git blame' and made
- editable using `git rebase --interactive' if it is reachable
- from `HEAD', or by checking out the commit (or a branch that
- points at it) otherwise."
- (interactive (list (and current-prefix-arg 'removal)))
- (let* ((chunk (magit-current-blame-chunk (or type 'addition)))
- (rev (oref chunk orig-rev)))
- (if (equal rev "0000000000000000000000000000000000000000")
- (message "This line has not been committed yet")
- (let ((rebase (magit-rev-ancestor-p rev "HEAD"))
- (file (expand-file-name (oref chunk orig-file)
- (magit-toplevel))))
- (if rebase
- (let ((magit--rebase-published-symbol 'edit-published))
- (magit-rebase-edit-commit rev (magit-rebase-arguments)))
- (magit-checkout (or (magit-rev-branch rev) rev)))
- (unless (and buffer-file-name
- (file-equal-p file buffer-file-name))
- (let ((blame-type (and magit-blame-mode magit-blame-type)))
- (if rebase
- (set-process-sentinel
- magit-this-process
- (lambda (process event)
- (magit-sequencer-process-sentinel process event)
- (when (eq (process-status process) 'exit)
- (find-file file)
- (when blame-type
- (magit-blame--pre-blame-setup blame-type)
- (magit-blame--run)))))
- (find-file file)
- (when blame-type
- (magit-blame--pre-blame-setup blame-type)
- (magit-blame--run)))))))))
-
- (put 'magit-edit-line-commit 'disabled t)
-
- ;;;###autoload
- (defun magit-diff-edit-hunk-commit (file)
- "From a hunk, edit the respective commit and visit the file.
-
- First visit the file being modified by the hunk at the correct
- location using `magit-diff-visit-file'. This actually visits a
- blob. When point is on a diff header, not within an individual
- hunk, then this visits the blob the first hunk is about.
-
- Then invoke `magit-edit-line-commit', which uses an interactive
- rebase to make the commit editable, or if that is not possible
- because the commit is not reachable from `HEAD' by checking out
- that commit directly. This also causes the actual worktree file
- to be visited.
-
- Neither the blob nor the file buffer are killed when finishing
- the rebase. If that is undesirable, then it might be better to
- use `magit-rebase-edit-command' instead of this command."
- (interactive (list (magit-file-at-point t t)))
- (let ((magit-diff-visit-previous-blob nil))
- (with-current-buffer
- (magit-diff-visit-file--internal file nil #'pop-to-buffer-same-window)
- (magit-edit-line-commit))))
-
- (put 'magit-diff-edit-hunk-commit 'disabled t)
-
- ;;; Reshelve
-
- ;;;###autoload
- (defun magit-reshelve-since (rev)
- "Change the author and committer dates of the commits since REV.
-
- Ask the user for the first reachable commit whose dates should
- be changed. The read the new date for that commit. The initial
- minibuffer input and the previous history element offer good
- values. The next commit will be created one minute later and so
- on.
-
- This command is only intended for interactive use and should only
- be used on highly rearranged and unpublished history."
- (interactive (list nil))
- (cond
- ((not rev)
- (let ((backup (concat "refs/original/refs/heads/"
- (magit-get-current-branch))))
- (when (and (magit-ref-p backup)
- (not (magit-y-or-n-p
- "Backup ref %s already exists. Override? " backup)))
- (user-error "Abort")))
- (magit-log-select 'magit-reshelve-since
- "Type %p on a commit to reshelve it and the commits above it,"))
- (t
- (cl-flet ((adjust (time offset)
- (format-time-string
- "%F %T %z"
- (+ (floor time)
- (* offset 60)
- (- (car (decode-time time)))))))
- (let* ((start (concat rev "^"))
- (range (concat start ".." (magit-get-current-branch)))
- (time-rev (adjust (float-time (string-to-number
- (magit-rev-format "%at" start)))
- 1))
- (time-now (adjust (float-time)
- (- (string-to-number
- (magit-git-string "rev-list" "--count"
- range))))))
- (push time-rev magit--reshelve-history)
- (let ((date (floor
- (float-time
- (date-to-time
- (read-string "Date for first commit: "
- time-now 'magit--reshelve-history))))))
- (magit-with-toplevel
- (magit-run-git-async
- "filter-branch" "--force" "--env-filter"
- (format "case $GIT_COMMIT in %s\nesac"
- (mapconcat (lambda (rev)
- (prog1 (format "%s) \
- export GIT_AUTHOR_DATE=\"%s\"; \
- export GIT_COMMITTER_DATE=\"%s\";;" rev date date)
- (cl-incf date 60)))
- (magit-git-lines "rev-list" "--reverse"
- range)
- " "))
- range "--")
- (set-process-sentinel
- magit-this-process
- (lambda (process event)
- (when (memq (process-status process) '(exit signal))
- (if (> (process-exit-status process) 0)
- (magit-process-sentinel process event)
- (process-put process 'inhibit-refresh t)
- (magit-process-sentinel process event)
- (magit-run-git "update-ref" "-d"
- (concat "refs/original/refs/heads/"
- (magit-get-current-branch))))))))))))))
-
- ;;; Revision Stack
-
- (defvar magit-revision-stack nil)
-
- (defcustom magit-pop-revision-stack-format
- '("[%N: %h] " "%N: %H\n %s\n" "\\[\\([0-9]+\\)[]:]")
- "Control how `magit-pop-revision-stack' inserts a revision.
-
- The command `magit-pop-revision-stack' inserts a representation
- of the revision last pushed to the `magit-revision-stack' into
- the current buffer. It inserts text at point and/or near the end
- of the buffer, and removes the consumed revision from the stack.
-
- The entries on the stack have the format (HASH TOPLEVEL) and this
- option has the format (POINT-FORMAT EOB-FORMAT INDEX-REGEXP), all
- of which may be nil or a string (though either one of EOB-FORMAT
- or POINT-FORMAT should be a string, and if INDEX-REGEXP is
- non-nil, then the two formats should be too).
-
- First INDEX-REGEXP is used to find the previously inserted entry,
- by searching backward from point. The first submatch must match
- the index number. That number is incremented by one, and becomes
- the index number of the entry to be inserted. If you don't want
- to number the inserted revisions, then use nil for INDEX-REGEXP.
-
- If INDEX-REGEXP is non-nil, then both POINT-FORMAT and EOB-FORMAT
- should contain \"%N\", which is replaced with the number that was
- determined in the previous step.
-
- Both formats, if non-nil and after removing %N, are then expanded
- using `git show --format=FORMAT ...' inside TOPLEVEL.
-
- The expansion of POINT-FORMAT is inserted at point, and the
- expansion of EOB-FORMAT is inserted at the end of the buffer (if
- the buffer ends with a comment, then it is inserted right before
- that)."
- :package-version '(magit . "2.3.0")
- :group 'magit-commands
- :type '(list (choice (string :tag "Insert at point format")
- (cons (string :tag "Insert at point format")
- (repeat (string :tag "Argument to git show")))
- (const :tag "Don't insert at point" nil))
- (choice (string :tag "Insert at eob format")
- (cons (string :tag "Insert at eob format")
- (repeat (string :tag "Argument to git show")))
- (const :tag "Don't insert at eob" nil))
- (choice (regexp :tag "Find index regexp")
- (const :tag "Don't number entries" nil))))
-
- ;;;###autoload
- (defun magit-pop-revision-stack (rev toplevel)
- "Insert a representation of a revision into the current buffer.
-
- Pop a revision from the `magit-revision-stack' and insert it into
- the current buffer according to `magit-pop-revision-stack-format'.
- Revisions can be put on the stack using `magit-copy-section-value'
- and `magit-copy-buffer-revision'.
-
- If the stack is empty or with a prefix argument, instead read a
- revision in the minibuffer. By using the minibuffer history this
- allows selecting an item which was popped earlier or to insert an
- arbitrary reference or revision without first pushing it onto the
- stack.
-
- When reading the revision from the minibuffer, then it might not
- be possible to guess the correct repository. When this command
- is called inside a repository (e.g. while composing a commit
- message), then that repository is used. Otherwise (e.g. while
- composing an email) then the repository recorded for the top
- element of the stack is used (even though we insert another
- revision). If not called inside a repository and with an empty
- stack, or with two prefix arguments, then read the repository in
- the minibuffer too."
- (interactive
- (if (or current-prefix-arg (not magit-revision-stack))
- (let ((default-directory
- (or (and (not (= (prefix-numeric-value current-prefix-arg) 16))
- (or (magit-toplevel)
- (cadr (car magit-revision-stack))))
- (magit-read-repository))))
- (list (magit-read-branch-or-commit "Insert revision")
- default-directory))
- (push (caar magit-revision-stack) magit-revision-history)
- (pop magit-revision-stack)))
- (if rev
- (pcase-let ((`(,pnt-format ,eob-format ,idx-format)
- magit-pop-revision-stack-format))
- (let ((default-directory toplevel)
- (idx (and idx-format
- (save-excursion
- (if (re-search-backward idx-format nil t)
- (number-to-string
- (1+ (string-to-number (match-string 1))))
- "1"))))
- pnt-args eob-args)
- (when (listp pnt-format)
- (setq pnt-args (cdr pnt-format))
- (setq pnt-format (car pnt-format)))
- (when (listp eob-format)
- (setq eob-args (cdr eob-format))
- (setq eob-format (car eob-format)))
- (when pnt-format
- (when idx-format
- (setq pnt-format
- (replace-regexp-in-string "%N" idx pnt-format t t)))
- (magit-rev-insert-format pnt-format rev pnt-args)
- (backward-delete-char 1))
- (when eob-format
- (when idx-format
- (setq eob-format
- (replace-regexp-in-string "%N" idx eob-format t t)))
- (save-excursion
- (goto-char (point-max))
- (skip-syntax-backward ">s-")
- (beginning-of-line)
- (if (and comment-start (looking-at comment-start))
- (while (looking-at comment-start)
- (forward-line -1))
- (forward-line)
- (unless (= (current-column) 0)
- (insert ?\n)))
- (insert ?\n)
- (magit-rev-insert-format eob-format rev eob-args)
- (backward-delete-char 1)))))
- (user-error "Revision stack is empty")))
-
- (define-key git-commit-mode-map
- (kbd "C-c C-w") 'magit-pop-revision-stack)
-
- ;;;###autoload
- (defun magit-copy-section-value ()
- "Save the value of the current section for later use.
-
- Save the section value to the `kill-ring', and, provided that
- the current section is a commit, branch, or tag section, push
- the (referenced) revision to the `magit-revision-stack' for use
- with `magit-pop-revision-stack'.
-
- When the current section is a branch or a tag, and a prefix
- argument is used, then save the revision at its tip to the
- `kill-ring' instead of the reference name.
-
- When the region is active, then save that to the `kill-ring',
- like `kill-ring-save' would, instead of behaving as described
- above. If a prefix argument is used and the region is within a
- hunk, strip the outer diff marker column."
- (interactive)
- (cond
- ((and current-prefix-arg
- (magit-section-internal-region-p)
- (magit-section-match 'hunk))
- (deactivate-mark)
- (kill-new (replace-regexp-in-string
- "^[ \\+\\-]" ""
- (buffer-substring-no-properties
- (region-beginning) (region-end)))))
- ((use-region-p)
- (copy-region-as-kill nil nil 'region))
- (t
- (when-let ((section (magit-current-section))
- (value (oref section value)))
- (magit-section-case
- ((branch commit module-commit tag)
- (let ((default-directory default-directory) ref)
- (magit-section-case
- ((branch tag)
- (setq ref value))
- (module-commit
- (setq default-directory
- (file-name-as-directory
- (expand-file-name (magit-section-parent-value section)
- (magit-toplevel))))))
- (setq value (magit-rev-parse value))
- (push (list value default-directory) magit-revision-stack)
- (kill-new (message "%s" (or (and current-prefix-arg ref)
- value)))))
- (t (kill-new (message "%s" value))))))))
-
- ;;;###autoload
- (defun magit-copy-buffer-revision ()
- "Save the revision of the current buffer for later use.
-
- Save the revision shown in the current buffer to the `kill-ring'
- and push it to the `magit-revision-stack'.
-
- This command is mainly intended for use in `magit-revision-mode'
- buffers, the only buffers where it is always unambiguous exactly
- which revision should be saved.
-
- Most other Magit buffers usually show more than one revision, in
- some way or another, so this command has to select one of them,
- and that choice might not always be the one you think would have
- been the best pick.
-
- In such buffers it is often more useful to save the value of
- the current section instead, using `magit-copy-section-value'.
-
- When the region is active, then save that to the `kill-ring',
- like `kill-ring-save' would, instead of behaving as described
- above."
- (interactive)
- (if (use-region-p)
- (copy-region-as-kill nil nil 'region)
- (when-let ((rev (or magit-buffer-revision
- (cl-case major-mode
- (magit-diff-mode
- (if (string-match "\\.\\.\\.?\\(.+\\)"
- magit-buffer-range)
- (match-string 1 magit-buffer-range)
- magit-buffer-range))
- (magit-status-mode "HEAD")))))
- (when (magit-commit-p rev)
- (setq rev (magit-rev-parse rev))
- (push (list rev default-directory) magit-revision-stack)
- (kill-new (message "%s" rev))))))
-
- ;;; Miscellaneous
-
- ;;;###autoload
- (defun magit-abort-dwim ()
- "Abort current operation.
- Depending on the context, this will abort a merge, a rebase, a
- patch application, a cherry-pick, a revert, or a bisect."
- (interactive)
- (cond ((magit-merge-in-progress-p) (magit-merge-abort))
- ((magit-rebase-in-progress-p) (magit-rebase-abort))
- ((magit-am-in-progress-p) (magit-am-abort))
- ((magit-sequencer-in-progress-p) (magit-sequencer-abort))
- ((magit-bisect-in-progress-p) (magit-bisect-reset))))
-
- ;;; _
- (provide 'magit-extras)
- ;;; magit-extras.el ends here
|