Skip to content
Fetching contributors…
Cannot retrieve contributors at this time
5982 lines (5291 sloc) 227 KB
;;; magit.el --- control Git from Emacs
;; Copyright (C) 2010 Aaron Culich.
;; Copyright (C) 2010 Alan Falloon.
;; Copyright (C) 2008, 2010 Alex Ott.
;; Copyright (C) 2008, 2009, 2010 Alexey Voinov.
;; Copyright (C) 2010 Ben Walton.
;; Copyright (C) 2010 Chris Bernard.
;; Copyright (C) 2010 Christian Kluge.
;; Copyright (C) 2008 Daniel Farina.
;; Copyright (C) 2010 David Abrahams.
;; Copyright (C) 2009 David Wallin.
;; Copyright (C) 2009, 2010 Hannu Koivisto.
;; Copyright (C) 2009 Ian Eure.
;; Copyright (C) 2009 Jesse Alama.
;; Copyright (C) 2009 John Wiegley.
;; Copyright (C) 2010 Leo.
;; Copyright (C) 2008, 2009 Marcin Bachry.
;; Copyright (C) 2008, 2009 Marius Vollmer.
;; Copyright (C) 2010 Mark Hepburn.
;; Copyright (C) 2010 Moritz Bunkus.
;; Copyright (C) 2010 Nathan Weizenbaum.
;; Copyright (C) 2010 Oscar Fuentes.
;; Copyright (C) 2009 Pavel Holejsovsky.
;; Copyright (C) 2011-2012 Peter J Weisberg
;; Copyright (C) 2009, 2010 Phil Jackson.
;; Copyright (C) 2010 Philip Weaver.
;; Copyright (C) 2010 Ramkumar Ramachandra.
;; Copyright (C) 2010 Remco van 't Veer.
;; Copyright (C) 2009 René Stadler.
;; Copyright (C) 2010 Robin Green.
;; Copyright (C) 2010 Roger Crew.
;; Copyright (C) 2009, 2010, 2011, 2012 Rémi Vanicat.
;; Copyright (C) 2010 Sean Bryant.
;; Copyright (C) 2009, 2011 Steve Purcell.
;; Copyright (C) 2010 Timo Juhani Lindfors.
;; Copyright (C) 2010, 2011 Yann Hodique.
;; Copyright (C) 2010 Ævar Arnfjörð Bjarmason.
;; Copyright (C) 2010 Óscar Fuentes.
;; Original Author: Marius Vollmer <>
;; Former Maintainer: Phil Jackson <>
;; Maintenance Group:
;; Currently composed of:
;; - Phil Jackson
;; - Peter J Weisberg
;; - Yann Hodique
;; - Rémi Vanicat
;; Version: @GIT_DEV_VERSION@
;; Keywords: tools
;; 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
;; License for more details.
;; You should have received a copy of the GNU General Public License
;; along with Magit. If not, see <>.
;;; Commentary:
;; Invoking the magit-status function will show a buffer with the
;; status of the current git repository and its working tree. That
;; buffer offers key bindings for manipulating the status in simple
;; ways.
;; The status buffer mainly shows the difference between the working
;; tree and the index, and the difference between the index and the
;; current HEAD. You can add individual hunks from the working tree
;; to the index, and you can commit the index.
;; See the Magit User Manual for more information.
;;; Code:
(eval-when-compile (require 'cl))
(require 'log-edit)
(require 'easymenu)
(require 'diff-mode)
;; Silences byte-compiler warnings
(unless (fboundp 'declare-function) (defmacro declare-function (&rest args))))
(eval-when-compile (require 'view))
(declare-function view-mode 'view)
(eval-when-compile (require 'iswitchb))
(eval-when-compile (require 'ido))
(eval-when-compile (require 'ediff))
;; Dummy to be used by the defcustoms when first loading the file.
(eval-when (load eval)
(defalias 'magit-set-variable-and-refresh 'set-default))
;;; Code:
(defgroup magit nil
"Controlling Git from Emacs."
:prefix "magit-"
:group 'tools)
(defcustom magit-git-executable "git"
"The name of the Git executable."
:group 'magit
:type 'string)
(defcustom magit-gitk-executable (concat (file-name-directory magit-git-executable)
"The name of the Gitk executable."
:group 'magit
:type 'string)
(defcustom magit-git-standard-options '("--no-pager")
"Standard options when running Git."
:group 'magit
:type '(repeat string))
(defcustom magit-repo-dirs nil
"Directories containing Git repositories.
Magit will look into these directories for Git repositories and
offer them as choices for `magit-status'."
:group 'magit
:type '(repeat string))
(defcustom magit-repo-dirs-depth 3
"The maximum depth to look for Git repos.
When looking for a Git repository below the directories in `magit-repo-dirs',
Magit will only descend this many levels deep."
:group 'magit
:type 'integer)
(defcustom magit-set-upstream-on-push nil
"Non-nil means that `magit-push' may use --set-upstream when pushing a branch.
This only applies if the branch does not have an upstream set yet.
Setting this to t will ask if --set-upstream should be used.
Setting it to 'dontask will always use --set-upstream.
Setting it to 'refuse will refuse to push unless a remote branch has already been set.
--set-upstream is supported with git > 1.7.0"
:group 'magit
:type '(choice (const :tag "Never" nil)
(const :tag "Ask" t)
(const :tag "Refuse" refuse)
(const :tag "Always" dontask)))
(defcustom magit-save-some-buffers t
"Non-nil means that \\[magit-status] will save modified buffers before running.
Setting this to t will ask which buffers to save, setting it to 'dontask will
save all modified buffers without asking."
:group 'magit
:type '(choice (const :tag "Never" nil)
(const :tag "Ask" t)
(const :tag "Save without asking" dontask)))
(defcustom magit-save-some-buffers-predicate
"A predicate function to decide whether to save a buffer.
Used by function `magit-save-some-buffers' when the variable of
the same name is non-nil."
:group 'magit
:type '(radio (function-item magit-save-buffers-predicate-tree-only)
(function-item magit-save-buffers-predicate-all)
(function :tag "Other")))
(defcustom magit-default-tracking-name-function
"Specifies the function to use to generate default tracking branch names
when doing a \\[magit-checkout].
The default is magit-default-tracking-name-remote-plus-branch,
which generates a tracking name of the form 'REMOTE-BRANCHNAME'."
:group 'magit
:type '(radio (function-item magit-default-tracking-name-remote-plus-branch)
(function-item magit-default-tracking-name-branch-only)
(function :tag "Other")))
(defcustom magit-commit-all-when-nothing-staged 'ask
"Determines what \\[magit-log-edit] does when nothing is staged.
Setting this to nil will make it do nothing, setting it to t will
arrange things so that the actual commit command will use the \"--all\" option,
setting it to 'ask will first ask for confirmation whether to do this,
and setting it to 'ask-stage will cause all changes to be staged,
after a confirmation."
:group 'magit
:type '(choice (const :tag "No" nil)
(const :tag "Always" t)
(const :tag "Ask" ask)
(const :tag "Ask to stage everything" ask-stage)))
(defcustom magit-commit-signoff nil
"Add the \"Signed-off-by:\" line when committing."
:group 'magit
:type 'boolean)
(defcustom magit-sha1-abbrev-length 7
"The number of digits to show when a sha1 is displayed in abbreviated form."
:group 'magit
:type 'integer)
(defcustom magit-log-cutoff-length 100
"The maximum number of commits to show in the log and whazzup buffers."
:group 'magit
:type 'integer)
(defcustom magit-log-infinite-length 99999
"Number of log used to show as maximum for `magit-log-cutoff-length'."
:group 'magit
:type 'integer)
(defcustom magit-log-auto-more nil
"Insert more log entries automatically when moving past the last entry.
Only considered when moving past the last entry with
`magit-goto-*-section' commands."
:group 'magit
:type 'boolean)
(defcustom magit-process-popup-time -1
"Popup the process buffer if a command takes longer than this many seconds."
:group 'magit
:type '(choice (const :tag "Never" -1)
(const :tag "Immediately" 0)
(integer :tag "After this many seconds")))
(defcustom magit-revert-item-confirm t
"Require acknowledgment before reverting an item."
:group 'magit
:type 'boolean)
(defcustom magit-log-edit-confirm-cancellation nil
"Require acknowledgment before canceling the log edit buffer."
:group 'magit
:type 'boolean)
(defcustom magit-remote-ref-format 'branch-then-remote
"What format to use for autocompleting refs, in pariticular for remotes.
Autocompletion is used by functions like `magit-checkout',
`magit-interactive-rebase' and others which offer branch name
The value 'name-then-remote means remotes will be of the
form \"name (remote)\", while the value 'remote-slash-name
means that they'll be of the form \"remote/name\". I.e. something that's
listed as \"remotes/upstream/next\" by \"git branch -l -a\"
will be \"upstream/next\"."
:group 'magit
:type '(choice (const :tag "name (remote)" branch-then-remote)
(const :tag "remote/name" remote-slash-branch)))
(defcustom magit-process-connection-type (not (eq system-type 'cygwin))
"Connection type used for the git process.
If nil, use pipes: this is usually more efficient, and works on Cygwin.
If t, use ptys: this enables magit to prompt for passphrases when needed."
:group 'magit
:type '(choice (const :tag "pipe" nil)
(const :tag "pty" t)))
(defcustom magit-completing-read-function 'magit-builtin-completing-read
"Function to be called when requesting input from the user."
:group 'magit
:type '(radio (function-item magit-iswitchb-completing-read)
(function-item magit-ido-completing-read)
(function-item magit-builtin-completing-read)
(function :tag "Other")))
(defcustom magit-create-branch-behaviour 'at-head
"Where magit will create a new branch if not supplied a branchname or ref.
The value 'at-head means a new branch will be created at the tip
of your current branch, while the value 'at-point means magit
will try to find a valid reference at point..."
:group 'magit
:type '(choice (const :tag "at HEAD" at-head)
(const :tag "at point" at-point)))
(defcustom magit-status-buffer-switch-function 'pop-to-buffer
"Function for `magit-status' to use for switching to the status buffer.
The function is given one argument, the status buffer."
:group 'magit
:type '(radio (function-item switch-to-buffer)
(function-item pop-to-buffer)
(function :tag "Other")))
(defcustom magit-rewrite-inclusive t
"Whether magit includes the selected base commit in a rewrite operation.
t means both the selected commit as well as any subsequent
commits will be rewritten. This is magit's default behaviour,
equivalent to 'git rebase -i ${REV}~1'
nil means the selected commit will be literally used as 'base',
so only subsequent commits will be rewritten. This is consistent
with git-rebase, equivalent to 'git rebase -i ${REV}', yet more
cumbersome to use from the status buffer.
:group 'magit
:type '(choice (const :tag "Always" t)
(const :tag "Never" nil)
(const :tag "Ask" ask)))
(defcustom magit-highlight-whitespace t
"Specifies where to highlight whitespace errors.
See `magit-highlight-trailing-whitespace',
`magit-highlight-indentation'. The symbol t means in all diffs,
'status means only in the status buffer, and nil means nowhere."
:group 'magit
:type '(choice (const :tag "Always" t)
(const :tag "Never" nil)
(const :tag "In status buffer" status))
:set 'magit-set-variable-and-refresh)
(defcustom magit-highlight-trailing-whitespace t
"Highlight whitespace at the end of a line in diffs.
Used only when `magit-highlight-whitespace' is non-nil."
:group 'magit
:type 'boolean
:set 'magit-set-variable-and-refresh)
(defcustom magit-highlight-indentation nil
"Highlight the \"wrong\" indentation style.
Used only when `magit-highlight-whitespace' is non-nil.
The value is a list of cons cells. The car is a regular
expression, and the cdr is the value that applies to repositories
whose directory matches the regular expression. If more than one
item matches, then the *last* item in the list applies. So, the
default value should come first in the list.
If the value is `tabs', highlight indentation with tabs. If the
value is an integer, highlight indentation with at least that
many spaces. Otherwise, highlight neither."
:group 'magit
:type `(repeat (cons (string :tag "Directory regexp")
(choice (const :tag "Tabs" tabs)
(integer :tag "Spaces" :value ,tab-width)
(const :tag "Neither" nil))))
:set 'magit-set-variable-and-refresh)
(defcustom magit-diff-refine-hunk nil
"Show fine (word-granularity) differences within diff hunks.
There are three possible settings:
nil means to never show fine differences
t means to only show fine differences for the currently
selected diff hunk
`all' means to always show fine differences for all displayed diff hunks"
:group 'magit
:type '(choice (const :tag "Never" nil)
(const :tag "Selected only" t)
(const :tag "All" all))
:set 'magit-set-variable-and-refresh)
(defvar magit-current-indentation nil
"Indentation highlight used in the current buffer.
This is calculated from `magit-highlight-indentation'.")
(make-variable-buffer-local 'magit-current-indentation)
(defgroup magit-faces nil
"Customize the appearance of Magit."
:prefix "magit-"
:group 'faces
:group 'magit)
(defface magit-header
'((t :inherit header-line))
"Face for generic header lines.
Many Magit faces inherit from this one by default."
:group 'magit-faces)
(defface magit-section-title
'((t :inherit magit-header))
"Face for section titles."
:group 'magit-faces)
(defface magit-branch
'((t :inherit magit-header))
"Face for the current branch."
:group 'magit-faces)
(defface magit-diff-file-header
'((t :inherit diff-file-header))
"Face for diff file header lines."
:group 'magit-faces)
(defface magit-diff-hunk-header
'((t :inherit diff-hunk-header))
"Face for diff hunk header lines."
:group 'magit-faces)
(defface magit-diff-add
'((t :inherit diff-added))
"Face for lines in a diff that have been added."
:group 'magit-faces)
(defface magit-diff-none
'((t :inherit diff-context))
"Face for lines in a diff that are unchanged."
:group 'magit-faces)
(defface magit-diff-del
'((t :inherit diff-removed))
"Face for lines in a diff that have been deleted."
:group 'magit-faces)
(defface magit-log-graph
'((((class color) (background light))
:foreground "grey11")
(((class color) (background dark))
:foreground "grey80"))
"Face for the graph element of the log output."
:group 'magit-faces)
(defface magit-log-sha1
'((((class color) (background light))
:foreground "firebrick")
(((class color) (background dark))
:foreground "tomato"))
"Face for the sha1 element of the log output."
:group 'magit-faces)
(defface magit-log-message
"Face for the message element of the log output."
:group 'magit-faces)
(defface magit-item-highlight
'((t :inherit highlight))
"Face for highlighting the current item."
:group 'magit-faces)
(defface magit-item-mark
'((t :inherit secondary-selection))
"Face for highlighting marked item."
:group 'magit-faces)
(defface magit-log-head-label-bisect-good
'((((class color) (background light))
:box t
:background "light green"
:foreground "dark olive green")
(((class color) (background dark))
:box t
:background "light green"
:foreground "dark olive green"))
"Face for good bisect refs."
:group 'magit-faces)
(defface magit-log-head-label-bisect-bad
'((((class color) (background light))
:box t
:background "IndianRed1"
:foreground "IndianRed4")
(((class color) (background dark))
:box t
:background "IndianRed1"
:foreground "IndianRed4"))
"Face for bad bisect refs."
:group 'magit-faces)
(defface magit-log-head-label-remote
'((((class color) (background light))
:box t
:background "Grey85"
:foreground "OliveDrab4")
(((class color) (background dark))
:box t
:background "Grey11"
:foreground "DarkSeaGreen2"))
"Face for remote branch head labels shown in log buffer."
:group 'magit-faces)
(defface magit-log-head-label-tags
'((((class color) (background light))
:box t
:background "LemonChiffon1"
:foreground "goldenrod4")
(((class color) (background dark))
:box t
:background "LemonChiffon1"
:foreground "goldenrod4"))
"Face for tag labels shown in log buffer."
:group 'magit-faces)
(defface magit-log-head-label-patches
'((((class color) (background light))
:box t
:background "IndianRed1"
:foreground "IndianRed4")
(((class color) (background dark))
:box t
:background "IndianRed1"
:foreground "IndianRed4"))
"Face for Stacked Git patches."
:group 'magit-faces)
(defface magit-whitespace-warning-face
'((t :inherit trailing-whitespace))
"Face for highlighting whitespace errors in Magit diffs."
:group 'magit-faces)
(defvar magit-custom-options '()
"List of custom options to pass to Git.
Do not customize this (used in the `magit-key-mode' implementation).")
(defvar magit-read-rev-history nil
"The history of inputs to `magit-read-rev'.")
(defvar magit-buffer-internal nil
"Track associated *magit* buffers.
Do not customize this (used in the `magit-log-edit-mode' implementation
to switch back to the *magit* buffer associated with a given commit
operation after commit).")
(defvar magit-back-navigation-history nil
"History items that will be visited by successively going \"back\".")
(make-variable-buffer-local 'magit-back-navigation-history)
(put 'magit-back-navigation-history 'permanent-local t)
(defvar magit-forward-navigation-history nil
"History items that will be visited by successively going \"forward\".")
(make-variable-buffer-local 'magit-forward-navigation-history)
(put 'magit-forward-navigation-history 'permanent-local t)
(defvar magit-omit-untracked-dir-contents nil
"When non-nil magit will only list an untracked directory, not its contents.")
(defvar magit-tmp-buffer-name " *magit-tmp*")
(defface magit-log-head-label-local
'((((class color) (background light))
:box t
:background "Grey85"
:foreground "LightSkyBlue4")
(((class color) (background dark))
:box t
:background "Grey13"
:foreground "LightSkyBlue1"))
"Face for local branch head labels shown in log buffer."
:group 'magit-faces)
(defface magit-log-head-label-default
'((((class color) (background light))
:box t
:background "Grey50")
(((class color) (background dark))
:box t
:background "Grey50"))
"Face for unknown ref labels shown in log buffer."
:group 'magit-faces)
(defvar magit-mode-map
(let ((map (make-keymap)))
(suppress-keymap map t)
(define-key map (kbd "n") 'magit-goto-next-section)
(define-key map (kbd "p") 'magit-goto-previous-section)
(define-key map (kbd "^") 'magit-goto-parent-section)
(define-key map (kbd "M-n") 'magit-goto-next-sibling-section)
(define-key map (kbd "M-p") 'magit-goto-previous-sibling-section)
(define-key map (kbd "TAB") 'magit-toggle-section)
(define-key map (kbd "<backtab>") 'magit-expand-collapse-section)
(define-key map (kbd "1") 'magit-show-level-1)
(define-key map (kbd "2") 'magit-show-level-2)
(define-key map (kbd "3") 'magit-show-level-3)
(define-key map (kbd "4") 'magit-show-level-4)
(define-key map (kbd "M-1") 'magit-show-level-1-all)
(define-key map (kbd "M-2") 'magit-show-level-2-all)
(define-key map (kbd "M-3") 'magit-show-level-3-all)
(define-key map (kbd "M-4") 'magit-show-level-4-all)
(define-key map (kbd "M-h") 'magit-show-only-files)
(define-key map (kbd "M-H") 'magit-show-only-files-all)
(define-key map (kbd "M-s") 'magit-show-level-4)
(define-key map (kbd "M-S") 'magit-show-level-4-all)
(define-key map (kbd "g") 'magit-refresh)
(define-key map (kbd "G") 'magit-refresh-all)
(define-key map (kbd "?") 'magit-describe-item)
(define-key map (kbd "!") 'magit-key-mode-popup-running)
(define-key map (kbd ":") 'magit-git-command)
(define-key map (kbd "C-x 4 a") 'magit-add-change-log-entry-other-window)
(define-key map (kbd "L") 'magit-add-change-log-entry-no-option)
(define-key map (kbd "RET") 'magit-visit-item)
(define-key map (kbd "SPC") 'magit-show-item-or-scroll-up)
(define-key map (kbd "DEL") 'magit-show-item-or-scroll-down)
(define-key map (kbd "C-w") 'magit-copy-item-as-kill)
(define-key map (kbd "R") 'magit-rebase-step)
(define-key map (kbd "t") 'magit-key-mode-popup-tagging)
(define-key map (kbd "r") 'magit-key-mode-popup-rewriting)
(define-key map (kbd "P") 'magit-key-mode-popup-pushing)
(define-key map (kbd "f") 'magit-key-mode-popup-fetching)
(define-key map (kbd "b") 'magit-key-mode-popup-branching)
(define-key map (kbd "M") 'magit-key-mode-popup-remoting)
(define-key map (kbd "B") 'magit-key-mode-popup-bisecting)
(define-key map (kbd "F") 'magit-key-mode-popup-pulling)
(define-key map (kbd "l") 'magit-key-mode-popup-logging)
(define-key map (kbd "$") 'magit-display-process)
(define-key map (kbd "c") 'magit-log-edit)
(define-key map (kbd "E") 'magit-interactive-rebase)
(define-key map (kbd "e") 'magit-ediff)
(define-key map (kbd "w") 'magit-wazzup)
(define-key map (kbd "q") 'magit-quit-window)
(define-key map (kbd "m") 'magit-key-mode-popup-merging)
(define-key map (kbd "x") 'magit-reset-head)
(define-key map (kbd "v") 'magit-revert-item)
(define-key map (kbd "a") 'magit-apply-item)
(define-key map (kbd "A") 'magit-cherry-pick-item)
(define-key map (kbd "d") 'magit-diff-working-tree)
(define-key map (kbd "D") 'magit-diff)
(define-key map (kbd "-") 'magit-diff-smaller-hunks)
(define-key map (kbd "+") 'magit-diff-larger-hunks)
(define-key map (kbd "0") 'magit-diff-default-hunks)
(define-key map (kbd "h") 'magit-toggle-diff-refine-hunk)
(defvar magit-commit-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-c C-b") 'magit-show-commit-backward)
(define-key map (kbd "C-c C-f") 'magit-show-commit-forward)
(defvar magit-status-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "s") 'magit-stage-item)
(define-key map (kbd "S") 'magit-stage-all)
(define-key map (kbd "u") 'magit-unstage-item)
(define-key map (kbd "U") 'magit-unstage-all)
(define-key map (kbd "i") 'magit-ignore-item)
(define-key map (kbd "I") 'magit-ignore-item-locally)
(define-key map (kbd ".") 'magit-mark-item)
(define-key map (kbd "=") 'magit-diff-with-mark)
(define-key map (kbd "k") 'magit-discard-item)
(define-key map (kbd "C") 'magit-add-log)
(define-key map (kbd "X") 'magit-reset-working-tree)
(define-key map (kbd "z") 'magit-key-mode-popup-stashing)
(eval-after-load 'dired-x
'(define-key magit-status-mode-map [remap dired-jump] 'magit-dired-jump))
(defvar magit-log-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd ".") 'magit-mark-item)
(define-key map (kbd "=") 'magit-diff-with-mark)
(define-key map (kbd "e") 'magit-log-show-more-entries)
(defvar magit-wazzup-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd ".") 'magit-mark-item)
(define-key map (kbd "=") 'magit-diff-with-mark)
(define-key map (kbd "i") 'magit-ignore-item)
(defvar magit-branch-manager-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "c") 'magit-create-branch)
(define-key map (kbd "a") 'magit-add-remote)
(define-key map (kbd "r") 'magit-move-item)
(define-key map (kbd "k") 'magit-discard-item)
(define-key map (kbd "T") 'magit-change-what-branch-tracks)
(defvar magit-bug-report-url
(defconst magit-version "@GIT_DEV_VERSION@"
"The version of Magit that you're using.")
(defun magit-bug-report (str)
"Asks the user to submit a bug report about the error described in STR."
;; XXX - should propose more information to be included.
(message (concat
"Unknown error: %s\n"
"Please, with as much information as possible, file a bug at\n"
"You are using Magit version %s.")
str magit-bug-report-url magit-version))
(defun magit-buffer-switch (buf)
(if (string-match "magit" (buffer-name))
(switch-to-buffer buf)
(pop-to-buffer buf)))
;;; Macros
(defmacro magit-with-refresh (&rest body)
(declare (indent 0))
`(magit-refresh-wrapper (lambda () ,@body)))
;;; Git features
(defvar magit-have-graph 'unset)
(defvar magit-have-decorate 'unset)
(defvar magit-have-abbrev 'unset)
(make-variable-buffer-local 'magit-have-graph)
(put 'magit-have-graph 'permanent-local t)
(make-variable-buffer-local 'magit-have-decorate)
(put 'magit-have-decorate 'permanent-local t)
(make-variable-buffer-local 'magit-have-abbrev)
(put 'magit-have-abbrev 'permanent-local t)
(defun magit-configure-have-graph ()
(if (eq magit-have-graph 'unset)
(let ((res (magit-git-exit-code "log" "--graph" "--max-count=0")))
(setq magit-have-graph (eq res 0)))))
(defun magit-configure-have-decorate ()
(if (eq magit-have-decorate 'unset)
(let ((res (magit-git-exit-code "log" "--decorate=full" "--max-count=0")))
(setq magit-have-decorate (eq res 0)))))
(defun magit-configure-have-abbrev ()
(if (eq magit-have-abbrev 'unset)
(let ((res (magit-git-exit-code "log" "--no-abbrev-commit" "--max-count=0")))
(setq magit-have-abbrev (eq res 0)))))
;;; Compatibilities
(defun magit-max-args-internal (function)
"Returns the maximum number of arguments accepted by FUNCTION."
(if (symbolp function)
(setq function (symbol-function function)))
(if (subrp function)
(let ((max (cdr (subr-arity function))))
(if (eq 'many max)
(if (eq 'macro (car-safe function))
(setq function (cdr function)))
(let ((arglist (if (byte-code-function-p function)
(aref function 0)
(second function))))
(if (memq '&rest arglist)
(length (remq '&optional arglist))))))
(if (functionp 'start-file-process)
(defalias 'magit-start-process 'start-file-process)
(defalias 'magit-start-process 'start-process))
(unless (fboundp 'string-match-p)
(defun string-match-p (regexp string &optional start)
"Same as `string-match' except this function does not
change the match data."
(let ((inhibit-changing-match-data t))
(string-match regexp string start))))
(if (fboundp 'with-silent-modifications)
(defalias 'magit-with-silent-modifications 'with-silent-modifications)
(defmacro magit-with-silent-modifications (&rest body)
"Execute body without changing `buffer-modified-p'. Also, do not
record undo information."
(prog1 (buffer-modified-p)
(let ((buffer-undo-list t)
(if (>= (magit-max-args-internal 'delete-directory) 2)
(defalias 'magit-delete-directory 'delete-directory)
(defun magit-delete-directory (directory &optional recursive)
"Deletes a directory named DIRECTORY. If RECURSIVE is non-nil,
recursively delete all of DIRECTORY's contents as well.
Does not follow symlinks."
(if (or (file-symlink-p directory)
(not (file-directory-p directory)))
(delete-file directory)
(if recursive
;; `directory-files-no-dot-files-regex' borrowed from Emacs 23
(dolist (file (directory-files directory 'full "\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))
(magit-delete-directory file recursive)))
(delete-directory directory)))))
;;; Utilities
(defun magit-set-variable-and-refresh (symbol value)
"Set SYMBOL to VALUE and call `magit-refresh-all'"
(set-default symbol value)
(defun magit-iswitchb-completing-read (prompt choices &optional predicate require-match
initial-input hist def)
"iswitchb-based completing-read almost-replacement."
(require 'iswitchb)
(let ((iswitchb-make-buflist-hook
(lambda ()
(setq iswitchb-temp-buflist (if (consp (first choices))
(mapcar #'car choices)
(iswitchb-read-buffer prompt (or initial-input def) require-match)))
(defun magit-ido-completing-read (prompt choices &optional predicate require-match initial-input hist def)
"ido-based completing-read almost-replacement."
(require 'ido)
(let ((selected (ido-completing-read prompt (if (consp (first choices))
(mapcar #'car choices)
predicate require-match initial-input hist def)))
(if (consp (first choices))
(or (cdr (assoc selected choices))
(defun magit-builtin-completing-read (prompt choices &optional predicate require-match
initial-input hist def)
"Magit wrapper for standard `completing-read' function."
(completing-read (if (and def (> (length prompt) 2)
(string-equal ": " (substring prompt -2)))
(format "%s (default %s): " (substring prompt 0 -2) def)
choices predicate require-match initial-input hist def))
(defun magit-completing-read (prompt collection &optional predicate require-match
initial-input hist def)
"Call function in `magit-completing-read-function' to read user input
Read `completing-read' documentation for the meaning of the argument"
(funcall magit-completing-read-function prompt collection predicate require-match
initial-input hist def))
(defun magit-use-region-p ()
(if (fboundp 'use-region-p)
(and transient-mark-mode mark-active)))
(defun magit-goto-line (line)
"Like `goto-line' but doesn't set the mark."
(goto-char 1)
(forward-line (1- line))))
(defun magit-trim-line (str)
(if (string= str "")
(if (equal (elt str (- (length str) 1)) ?\n)
(substring str 0 (- (length str) 1))
(defun magit-split-lines (str)
(if (string= str "")
(let ((lines (nreverse (split-string str "\n"))))
(if (string= (car lines) "")
(setq lines (cdr lines)))
(nreverse lines))))
(defun magit-git-insert (args)
(insert (magit-git-output args)))
(defun magit-git-output (args)
(magit-cmd-output magit-git-executable (append magit-git-standard-options args)))
(defun magit-cmd-insert (cmd args)
(insert (magit-cmd-output cmd args)))
(defun magit-cmd-output (cmd args)
(let ((cmd-output (with-output-to-string
(with-current-buffer standard-output
(apply #'process-file
nil (list t nil) nil
(replace-regexp-in-string "\e\\[.*?m" "" cmd-output)))
(defun magit-git-string (&rest args)
(magit-trim-line (magit-git-output args)))
(defun magit-git-lines (&rest args)
(magit-split-lines (magit-git-output args)))
(defun magit-git-exit-code (&rest args)
(apply #'process-file magit-git-executable nil nil nil
(append magit-git-standard-options args)))
(defun magit-file-lines (file)
(when (file-exists-p file)
(insert-file-contents file)
(let ((rev (nreverse (split-string (buffer-string) "\n"))))
(nreverse (if (equal (car rev) "")
(cdr rev)
(defun magit-write-file-lines (file lines)
(dolist (l lines)
(insert l "\n"))
(write-file file)))
(defun magit-get (&rest keys)
"Return the value of Git config entry specified by KEYS."
(magit-git-string "config" (mapconcat 'identity keys ".")))
(defun magit-get-all (&rest keys)
"Return all values of the Git config entry specified by KEYS."
(magit-git-lines "config" "--get-all" (mapconcat 'identity keys ".")))
(defun magit-get-boolean (&rest keys)
"Return the boolean value of Git config entry specified by KEYS."
(equal (magit-git-string "config" "--bool" (mapconcat 'identity keys "."))
(defun magit-set (val &rest keys)
"Set Git config settings specified by KEYS to VAL."
(if val
(magit-git-string "config" (mapconcat 'identity keys ".") val)
(magit-git-string "config" "--unset" (mapconcat 'identity keys "."))))
(defun magit-remove-conflicts (alist)
(let ((dict (make-hash-table :test 'equal))
(result nil))
(dolist (a alist)
(puthash (car a) (cons (cdr a) (gethash (car a) dict))
(maphash (lambda (key value)
(if (= (length value) 1)
(push (cons key (car value)) result)
(let ((sub (magit-remove-conflicts
(mapcar (lambda (entry)
(let ((dir (directory-file-name
(substring entry 0 (- (length key))))))
(cons (concat (file-name-nondirectory dir) "/" key)
(setq result (append result sub)))))
(defun magit-git-repo-p (dir)
(file-exists-p (expand-file-name ".git" dir)))
(defun magit-git-dir ()
"Returns the .git directory for the current repository."
(concat (expand-file-name (magit-git-string "rev-parse" "--git-dir")) "/"))
(defun magit-no-commit-p ()
"Return non-nil if there is no commit in the current git repository."
(not (magit-git-string
"rev-list" "HEAD" "--max-count=1")))
(defun magit-list-repos* (dir level)
(if (magit-git-repo-p dir)
(list dir)
(apply #'append
(mapcar (lambda (entry)
(unless (or (string= (substring entry -3) "/..")
(string= (substring entry -2) "/."))
(magit-list-repos* entry (+ level 1))))
(and (file-directory-p dir)
(< level magit-repo-dirs-depth)
(directory-files dir t nil t))))))
(defun magit-list-repos (dirs)
(apply #'append
(mapcar (lambda (dir)
(mapcar #'(lambda (repo)
(cons (file-name-nondirectory repo)
(magit-list-repos* dir 0)))
(defun magit-get-top-dir (cwd)
(let ((cwd (expand-file-name (file-truename cwd))))
(when (file-directory-p cwd)
(let* ((default-directory (file-name-as-directory cwd))
(cdup (magit-git-string "rev-parse" "--show-cdup")))
(when cdup
(file-name-as-directory (expand-file-name cdup cwd)))))))
(defun magit-get-ref (ref)
(magit-git-string "symbolic-ref" "-q" ref))
(defun magit-get-current-branch ()
(let* ((head (magit-get-ref "HEAD"))
(pos (and head (string-match "^refs/heads/" head))))
(if pos
(substring head 11)
(defun magit-get-remote (branch)
"Return the name of the remote for BRANCH.
If branch is nil or it has no remote, but a remote named
\"origin\" exists, return that. Otherwise, return nil."
(let ((remote (or (and branch (magit-get "branch" branch "remote"))
(and (magit-get "remote" "origin" "url") "origin"))))
(if (string= remote "") nil remote)))
(defun magit-get-current-remote ()
"Return the name of the remote for the current branch.
If there is no current branch, or no remote for that branch,
but a remote named \"origin\" is configured, return that.
Otherwise, return nil."
(magit-get-remote (magit-get-current-branch)))
(defun magit-ref-exists-p (ref)
(= (magit-git-exit-code "show-ref" "--verify" ref) 0))
(defun magit-read-top-dir (dir)
"Ask the user for a Git repository. The choices offered by
auto-completion will be the repositories under `magit-repo-dirs'.
If `magit-repo-dirs' is nil or DIR is non-nill, then
autocompletion will offer directory names."
(if (and (not dir) magit-repo-dirs)
(let* ((repos (magit-list-repos magit-repo-dirs))
(reply (magit-completing-read "Git repository: " repos)))
(or (cdr (assoc reply repos))
(if (file-directory-p reply)
(expand-file-name reply)
(error "Not a repository or a directory: %s" reply)))))
(read-directory-name "Git repository: "
(or (magit-get-top-dir default-directory)
(defun magit-rev-parse (ref)
"Return the SHA hash for REF."
(magit-git-string "rev-parse" ref))
(defun magit-ref-ambiguous-p (ref)
"Return whether or not REF is ambiguous."
;; If REF is ambiguous, rev-parse just prints errors,
;; so magit-git-string returns nil.
(not (magit-git-string "rev-parse" "--abbrev-ref" ref)))
(defun magit-name-rev (rev &optional no-trim)
"Return a human-readable name for REV.
Unlike git name-rev, this will remove tags/ and remotes/ prefixes
if that can be done unambiguously (unless optional arg NO-TRIM is
non-nil). In addition, it will filter out revs involving HEAD."
(when rev
(let ((name (magit-git-string "name-rev" "--no-undefined" "--name-only" rev)))
;; There doesn't seem to be a way of filtering HEAD out from name-rev,
;; so we have to do it manually.
;; HEAD-based names are too transient to allow.
(when (and (stringp name)
(string-match "^\\(.*\\<HEAD\\)\\([~^].*\\|$\\)" name))
(let ((head-ref (match-string 1 name))
(modifier (match-string 2 name)))
;; Sometimes when name-rev gives a HEAD-based name,
;; rev-parse will give an actual branch or remote name.
(setq name (concat (magit-git-string "rev-parse" "--abbrev-ref" head-ref)
;; If rev-parse doesn't give us what we want, just use the SHA.
(when (or (null name) (string-match-p "\\<HEAD\\>" name))
(setq name (magit-rev-parse rev)))))
(setq rev (or name rev))
(when (string-match "^\\(?:tags\\|remotes\\)/\\(.*\\)" rev)
(let ((plain-name (match-string 1 rev)))
(unless (or no-trim (magit-ref-ambiguous-p plain-name))
(setq rev plain-name))))
(defun magit-highlight-line-whitespace ()
(when (and magit-highlight-whitespace
(or (derived-mode-p 'magit-status-mode)
(not (eq magit-highlight-whitespace 'status))))
(if (and magit-highlight-trailing-whitespace
(looking-at "^[-+].*?\\([ \t]+\\)$"))
(overlay-put (make-overlay (match-beginning 1) (match-end 1))
'face 'magit-whitespace-warning-face))
(if (or (and (eq magit-current-indentation 'tabs)
(looking-at "^[-+]\\( *\t[ \t]*\\)"))
(and (integerp magit-current-indentation)
(looking-at (format "^[-+]\\([ \t]* \\{%s,\\}[ \t]*\\)"
(overlay-put (make-overlay (match-beginning 1) (match-end 1))
'face 'magit-whitespace-warning-face))))
(defun magit-put-line-property (prop val)
(put-text-property (line-beginning-position) (line-beginning-position 2)
prop val))
(defun magit-format-commit (commit format)
(magit-git-string "log" "--max-count=1"
(concat "--pretty=format:" format)
(defun magit-current-line ()
(buffer-substring-no-properties (line-beginning-position)
(defun magit-insert-region (beg end buf)
(let ((text (buffer-substring-no-properties beg end)))
(with-current-buffer buf
(insert text))))
(defun magit-insert-current-line (buf)
(let ((text (buffer-substring-no-properties
(line-beginning-position) (line-beginning-position 2))))
(with-current-buffer buf
(insert text))))
(defun magit-file-uptodate-p (file)
(eq (magit-git-exit-code "diff" "--quiet" "--" file) 0))
(defun magit-anything-staged-p ()
(not (eq (magit-git-exit-code "diff" "--quiet" "--cached") 0)))
(defun magit-everything-clean-p ()
(and (not (magit-anything-staged-p))
(eq (magit-git-exit-code "diff" "--quiet") 0)))
(defun magit-commit-parents (commit)
(cdr (split-string (magit-git-string "rev-list" "-1" "--parents" commit))))
;; XXX - let the user choose the parent
(defun magit-choose-parent-id (commit op)
(let* ((parents (magit-commit-parents commit)))
(if (> (length parents) 1)
(error "Can't %s merge commits" op)
;;; Revisions and ranges
(defvar magit-current-range nil
"The range described by the current buffer.
This is only non-nil in diff and log buffers.
This has three possible (non-nil) forms. If it's a string REF or
a singleton list (REF), then the range is from REF to the current
working directory state (or HEAD in a log buffer). If it's a
pair (START . END), then the range is START..END.")
(make-variable-buffer-local 'magit-current-range)
(defun magit-list-interesting-refs (&optional uninteresting)
"Return interesting references as given by `git show-ref'.
Removes references matching UNINTERESTING from the
results. UNINTERESTING can be either a function taking a single
argument or a list of strings used as regexps."
(let ((refs ()))
(dolist (line (magit-git-lines "show-ref"))
(if (string-match "[^ ]+ +\\(.*\\)" line)
(let ((ref (match-string 1 line)))
(cond ((and (functionp uninteresting)
(funcall uninteresting ref)))
((and (not (functionp uninteresting))
(loop for i in uninteresting thereis (string-match i ref))))
(let ((fmt-ref (magit-format-ref ref)))
(when fmt-ref
(push (cons fmt-ref
(replace-regexp-in-string "^refs/heads/"
"" ref))
(nreverse refs)))
(defun magit-format-ref (ref)
"Convert fully-specified ref REF into its displayable form
according to `magit-remote-ref-format'"
((null ref)
((string-match "refs/heads/\\(.*\\)" ref)
(match-string 1 ref))
((string-match "refs/tags/\\(.*\\)" ref)
(format (if (eq magit-remote-ref-format 'branch-then-remote)
"%s (tag)"
(match-string 1 ref)))
((string-match "refs/remotes/\\([^/]+\\)/\\(.+\\)" ref)
(if (eq magit-remote-ref-format 'branch-then-remote)
(format "%s (%s)"
(match-string 2 ref)
(match-string 1 ref))
(format "%s/%s"
(match-string 1 ref)
(match-string 2 ref))))))
(defun magit-tree-contents (treeish)
"Returns a list of all files under TREEISH. TREEISH can be a tree,
a commit, or any reference to one of those."
(let ((return-value nil))
(magit-git-insert (list "ls-tree" "-r" treeish))
(if (eql 0 (buffer-size))
(error "%s is not a commit or tree." treeish))
(goto-char (point-min))
(while (search-forward-regexp "\t\\(.*\\)" nil 'noerror)
(push (match-string 1) return-value)))
(defvar magit-uninteresting-refs '("refs/remotes/\\([^/]+\\)/HEAD$" "refs/stash"))
(defun magit-read-file-from-rev (revision)
(magit-completing-read (format "Retrieve file from %s: " revision)
(magit-tree-contents revision)
(if buffer-file-name
(let ((topdir-length (length (magit-get-top-dir default-directory))))
(substring (buffer-file-name) topdir-length)))))
(defun magit-read-rev (prompt &optional default uninteresting)
(let* ((interesting-refs (magit-list-interesting-refs
(or uninteresting magit-uninteresting-refs)))
(reply (magit-completing-read (concat prompt ": ") interesting-refs
nil nil nil 'magit-read-rev-history default))
(rev (or (cdr (assoc reply interesting-refs)) reply)))
(if (string= rev "")
(defun magit-read-rev-range (op &optional def-beg def-end)
(let ((beg (magit-read-rev (format "%s start" op)
(if (not beg)
(if (string-match "^\\(.+\\)\\.\\.\\(.+\\)$" beg)
(cons (match-string 1 beg) (match-string 2 beg))
(let ((end (magit-read-rev (format "%s end" op) def-end)))
(cons beg end)))))))
(defun magit-rev-to-git (rev)
(or rev
(error "No revision specified"))
(if (string= rev ".")
(defun magit-rev-range-to-git (range)
(or range
(error "No revision range specified"))
(if (stringp range)
(if (cdr range)
(format "%s..%s"
(magit-rev-to-git (car range))
(magit-rev-to-git (cdr range)))
(format "%s" (magit-rev-to-git (car range))))))
(defun magit-rev-describe (rev)
(or rev
(error "No revision specified"))
(if (string= rev ".")
(magit-name-rev rev)))
(defun magit-rev-range-describe (range things)
(or range
(error "No revision range specified"))
(if (stringp range)
(format "%s in %s" things range)
(if (cdr range)
(format "%s from %s to %s" things
(magit-rev-describe (car range))
(magit-rev-describe (cdr range)))
(format "%s at %s" things (magit-rev-describe (car range))))))
(defun magit-default-rev (&optional no-trim)
(or (magit-name-rev (magit-commit-at-point t) no-trim)
(let ((branch (magit-guess-branch)))
(if branch
(if (string-match "^refs/\\(.*\\)" branch)
(match-string 1 branch)
(defun magit-read-remote (&optional prompt def)
"Read the name of a remote.
PROMPT is used as the prompt, and defaults to \"Remote\".
DEF is the default value."
(let* ((prompt (or prompt "Remote"))
(def (or def (magit-guess-remote)))
(remotes (magit-git-lines "remote"))
(reply (magit-completing-read (concat prompt ": ") remotes
nil nil nil nil def)))
(if (string= reply "") nil reply)))
(defun magit-read-remote-branch (remote &optional prompt default)
(let* ((prompt (or prompt (format "Remote branch (in %s)" remote)))
(branches (delete nil
(lambda (b)
(and (not (string-match " -> " b))
(string-match (format "^ *%s/\\(.*\\)$"
(regexp-quote remote)) b)
(match-string 1 b)))
(magit-git-lines "branch" "-r"))))
(reply (magit-completing-read (concat prompt ": ") branches
nil nil nil nil default)))
(if (string= reply "") nil reply)))
;;; Sections
;; A buffer in magit-mode is organized into hierarchical sections.
;; These sections are used for navigation and for hiding parts of the
;; buffer.
;; Most sections also represent the objects that Magit works with,
;; such as files, diffs, hunks, commits, etc. The 'type' of a section
;; identifies what kind of object it represents (if any), and the
;; parent and grand-parent, etc provide the context.
(defstruct magit-section
parent title beginning end children hidden type info
(defvar magit-top-section nil
"The top section of the current buffer.")
(make-variable-buffer-local 'magit-top-section)
(put 'magit-top-section 'permanent-local t)
(defvar magit-old-top-section nil)
(defvar magit-section-hidden-default nil)
(defun magit-new-section (title type)
"Create a new section with title TITLE and type TYPE in current buffer.
If not `magit-top-section' exist, the new section will be the new top-section
otherwise, the new-section will be a child of the current top-section.
If TYPE is nil, the section won't be highlighted."
(let* ((s (make-magit-section :parent magit-top-section
:title title
:type type
:hidden magit-section-hidden-default))
(old (and magit-old-top-section
(magit-find-section (magit-section-path s)
(if magit-top-section
(push s (magit-section-children magit-top-section))
(setq magit-top-section s))
(if old
(setf (magit-section-hidden s) (magit-section-hidden old)))
(defun magit-cancel-section (section)
"Delete the section SECTION."
(delete-region (magit-section-beginning section)
(magit-section-end section))
(let ((parent (magit-section-parent section)))
(if parent
(setf (magit-section-children parent)
(delq section (magit-section-children parent)))
(setq magit-top-section nil))))
(defmacro magit-with-section (title type &rest body)
"Create a new section of title TITLE and type TYPE and evaluate BODY there.
Sections created inside BODY will become children of the new
section. BODY must leave point at the end of the created section.
If TYPE is nil, the section won't be highlighted."
(declare (indent 2))
(let ((s (make-symbol "*section*")))
`(let* ((,s (magit-new-section ,title ,type))
(magit-top-section ,s))
(setf (magit-section-beginning ,s) (point))
(setf (magit-section-end ,s) (point))
(setf (magit-section-children ,s)
(nreverse (magit-section-children ,s)))
(defun magit-set-section (title type start end)
"Create a new section of title TITLE and type TYPE with specified start and
end positions."
(let ((section (magit-new-section title type)))
(setf (magit-section-beginning section) start)
(setf (magit-section-end section) end)
(defun magit-set-section-info (info &optional section)
(setf (magit-section-info (or section magit-top-section)) info))
(defun magit-set-section-needs-refresh-on-show (flag &optional section)
(setf (magit-section-needs-refresh-on-show
(or section magit-top-section))
(defmacro magit-create-buffer-sections (&rest body)
"Empty current buffer of text and Magit's sections, and then evaluate BODY."
(declare (indent 0))
`(let ((inhibit-read-only t))
(let ((magit-old-top-section magit-top-section))
(setq magit-top-section nil)
(when (null magit-top-section)
(magit-with-section 'top nil
(insert "(empty)\n")))
(magit-propertize-section magit-top-section)
(magit-section-set-hidden magit-top-section
(magit-section-hidden magit-top-section)))))
(defun magit-propertize-section (section)
"Add text-property needed for SECTION."
(put-text-property (magit-section-beginning section)
(magit-section-end section)
'magit-section section)
(dolist (s (magit-section-children section))
(magit-propertize-section s)))
(defun magit-find-section (path top)
"Find the section at the path PATH in subsection of section TOP."
(if (null path)
(let ((secs (magit-section-children top)))
(while (and secs (not (equal (car path)
(magit-section-title (car secs)))))
(setq secs (cdr secs)))
(and (car secs)
(magit-find-section (cdr path) (car secs))))))
(defun magit-section-path (section)
"Return the path of SECTION."
(if (not (magit-section-parent section))
(append (magit-section-path (magit-section-parent section))
(list (magit-section-title section)))))
(defun magit-find-section-after (pos)
"Find the first section that begins after POS."
(magit-find-section-after* pos (list magit-top-section)))
(defun magit-find-section-after* (pos secs)
"Find the first section that begins after POS in the list SECS
\(including children of sections in SECS)."
(while (and secs
(<= (magit-section-beginning (car secs)) pos))
(setq secs (if (magit-section-hidden (car secs))
(cdr secs)
(append (magit-section-children (car secs))
(cdr secs)))))
(car secs))
(defun magit-find-section-before (pos)
"Return the last section that begins before POS."
(let ((section (magit-find-section-at pos)))
(do* ((current (or (magit-section-parent section)
(next (if (not (magit-section-hidden current))
(magit-find-section-before* pos (magit-section-children current)))
(if (not (magit-section-hidden current))
(magit-find-section-before* pos (magit-section-children current)))))
((null next) current))))
(defun magit-find-section-before* (pos secs)
"Find the last section that begins before POS in the list SECS."
(let ((prev nil))
(while (and secs
(< (magit-section-beginning (car secs)) pos))
(setq prev (car secs))
(setq secs (cdr secs)))
(defun magit-current-section ()
"Return the Magit section at point."
(magit-find-section-at (point)))
(defun magit-find-section-at (pos)
"Return the Magit section at POS."
(or (get-text-property pos 'magit-section)
(defun magit-insert-section (section-title-and-type
buffer-title washer cmd &rest args)
"Run CMD and put its result in a new section.
SECTION-TITLE-AND-TYPE is either a string that is the title of the section
or (TITLE . TYPE) where TITLE is the title of the section and TYPE is its type.
If there is no type, or if type is nil, the section won't be highlighted.
BUFFER-TITLE is the inserted title of the section
WASHER is a function that will be run after CMD.
The buffer will be narrowed to the inserted text.
It should add sectioning as needed for Magit interaction.
CMD is an external command that will be run with ARGS as arguments."
(let* ((body-beg nil)
(section-title (if (consp section-title-and-type)
(car section-title-and-type)
(section-type (if (consp section-title-and-type)
(cdr section-title-and-type)
(magit-with-section section-title section-type
(if buffer-title
(insert (propertize buffer-title 'face 'magit-section-title)
(setq body-beg (point))
(magit-cmd-insert cmd args)
(if (not (eq (char-before) ?\n))
(insert "\n"))
(if washer
(narrow-to-region body-beg (point))
(goto-char (point-min))
(funcall washer)
(goto-char (point-max)))))))
(if (= body-beg (point))
(magit-cancel-section section)
(insert "\n"))
(defun magit-git-section (section-title-and-type
buffer-title washer &rest args)
"Run git and put its result in a new section.
see `magit-insert-section' for meaning of the arguments"
(apply #'magit-insert-section
(append magit-git-standard-options args)))
(defun magit-goto-next-section ()
"Go to the next section."
(let ((next (magit-find-section-after (point))))
(if next
(magit-goto-section next)
(message "No next section"))))
(defun magit-goto-previous-section ()
"Go to the previous section."
(if (eq (point) 1)
(message "No previous section")
(magit-goto-section (magit-find-section-before (point)))))
(defun magit-goto-parent-section ()
"Go to the parent section."
(let ((parent (magit-section-parent (magit-current-section))))
(when parent
(goto-char (magit-section-beginning parent)))))
(defun magit-goto-next-sibling-section ()
"Go to the next sibling section."
(let* ((initial (point))
(section (magit-current-section))
(end (- (magit-section-end section) 1))
(parent (magit-section-parent section))
(siblings (magit-section-children parent))
(next-sibling (magit-find-section-after* end siblings)))
(if next-sibling
(magit-goto-section next-sibling)
(defun magit-goto-previous-sibling-section ()
"Go to the previous sibling section."
(let* ((section (magit-current-section))
(beginning (magit-section-beginning section))
(parent (magit-section-parent section))
(siblings (magit-section-children parent))
(previous-sibling (magit-find-section-before* beginning siblings)))
(if previous-sibling
(magit-goto-section previous-sibling)
(defun magit-goto-section (section)
(goto-char (magit-section-beginning section))
((and magit-log-auto-more
(eq (magit-section-type section) 'longer))
(forward-line -1)
((and (eq (magit-section-type section) 'commit)
(derived-mode-p 'magit-log-mode))
(magit-show-commit section))))
(defun magit-goto-section-at-path (path)
"Go to the section described by PATH."
(let ((sec (magit-find-section path magit-top-section)))
(if sec
(goto-char (magit-section-beginning sec))
(message "No such section"))))
(defun magit-for-all-sections (func &optional top)
"Run FUNC on TOP and recursively on all its children.
Default value for TOP is `magit-top-section'"
(let ((section (or top magit-top-section)))
(when section
(funcall func section)
(dolist (c (magit-section-children section))
(magit-for-all-sections func c)))))
(defun magit-section-set-hidden (section hidden)
"Hide SECTION if HIDDEN is not nil, show it otherwise."
(setf (magit-section-hidden section) hidden)
(if (and (not hidden)
(magit-section-needs-refresh-on-show section))
(let ((inhibit-read-only t)
(beg (save-excursion
(goto-char (magit-section-beginning section))
(end (magit-section-end section)))
(if (< beg end)
(put-text-property beg end 'invisible hidden)))
(if (not hidden)
(dolist (c (magit-section-children section))
(magit-section-set-hidden c (magit-section-hidden c))))))
(defun magit-section-any-hidden (section)
"Return true if SECTION or any of its children is hidden."
(or (magit-section-hidden section)
(let ((kids (magit-section-children section)))
(while (and kids (not (magit-section-any-hidden (car kids))))
(setq kids (cdr kids)))
(defun magit-section-collapse (section)
"Show SECTION and hide all its children."
(dolist (c (magit-section-children section))
(setf (magit-section-hidden c) t))
(magit-section-set-hidden section nil))
(defun magit-section-expand (section)
"Show SECTION and all its children."
(dolist (c (magit-section-children section))
(setf (magit-section-hidden c) nil))
(magit-section-set-hidden section nil))
(defun magit-section-expand-all-aux (section)
"Show recursively all SECTION's children."
(dolist (c (magit-section-children section))
(setf (magit-section-hidden c) nil)
(magit-section-expand-all-aux c)))
(defun magit-section-expand-all (section)
"Show SECTION and all its children."
(magit-section-expand-all-aux section)
(magit-section-set-hidden section nil))
(defun magit-section-hideshow (flag-or-func)
"Show or hide current section depending on FLAG-OR-FUNC.
If FLAG-OR-FUNC is a function, it will be ran on current section
IF FLAG-OR-FUNC is a Boolean value, the section will be hidden if its true, shown otherwise"
(let ((section (magit-current-section)))
(when (magit-section-parent section)
(goto-char (magit-section-beginning section))
(if (functionp flag-or-func)
(funcall flag-or-func section)
(magit-section-set-hidden section flag-or-func)))))
(defun magit-show-section ()
"Show current section."
(magit-section-hideshow nil))
(defun magit-hide-section ()
"Hide current section."
(magit-section-hideshow t))
(defun magit-collapse-section ()
"Hide all subsection of current section."
(magit-section-hideshow #'magit-section-collapse))
(defun magit-expand-section ()
"Show all subsection of current section."
(magit-section-hideshow #'magit-section-expand))
(defun magit-toggle-file-section ()
"Like `magit-toggle-section' but toggle at file granularity."
(when (eq 'hunk (first (magit-section-context-type (magit-current-section))))
(defun magit-toggle-section ()
"Toggle hidden status of current section."
(lambda (s)
(magit-section-set-hidden s (not (magit-section-hidden s))))))
(defun magit-expand-collapse-section ()
"Toggle hidden status of subsections of current section."
(lambda (s)
(cond ((magit-section-any-hidden s)
(magit-section-expand-all s))
(magit-section-collapse s))))))
(defun magit-cycle-section ()
"Cycle between expanded, hidden and collapsed state for current section.
Hidden: only the first line of the section is shown
Collapsed: only the first line of the subsection is shown
Expanded: everything is shown."
(lambda (s)
(cond ((magit-section-hidden s)
(magit-section-collapse s))
((notany #'magit-section-hidden (magit-section-children s))
(magit-section-set-hidden s t))
(magit-section-expand s))))))
(defun magit-section-lineage (s)
"Return list of parent, grand-parents... for section S."
(when s
(cons s (magit-section-lineage (magit-section-parent s)))))
(defun magit-section-show-level (section level threshold path)
(magit-section-set-hidden section (>= level threshold))
(when (and (< level threshold)
(not (magit-no-commit-p)))
(if path
(magit-section-show-level (car path) (1+ level) threshold (cdr path))
(dolist (c (magit-section-children section))
(magit-section-show-level c (1+ level) threshold nil)))))
(defun magit-show-level (level all)
"Show section whose level is less than LEVEL, hide the others.
If ALL is non nil, do this in all sections,
otherwise do it only on ancestors and descendants of current section."
(if all
(magit-section-show-level magit-top-section 0 level nil)
(let ((path (reverse (magit-section-lineage (magit-current-section)))))
(magit-section-show-level (car path) 0 level (cdr path))))))
(defun magit-show-only-files ()
"Show section that are files, but not there subsection.
Do this in on ancestors and descendants of current section."
(if (derived-mode-p 'magit-status-mode)
(call-interactively 'magit-show-level-2)
(call-interactively 'magit-show-level-1)))
(defun magit-show-only-files-all ()
"Show section that are files, but not there subsection.
Do this for all sections"
(if (derived-mode-p 'magit-status-mode)
(call-interactively 'magit-show-level-2-all)
(call-interactively 'magit-show-level-1-all)))
(defmacro magit-define-level-shower-1 (level all)
"Define an interactive function to show function of level LEVEL.
If ALL is non nil, this function will affect all section,
otherwise it will affect only ancestors and descendants of current section."
(let ((fun (intern (format "magit-show-level-%s%s"
level (if all "-all" ""))))
(doc (format "Show sections on level %s." level)))
`(defun ,fun ()
(magit-show-level ,level ,all))))
(defmacro magit-define-level-shower (level)
"Define two interactive function to show function of level LEVEL.
one for all, one for current lineage."
(magit-define-level-shower-1 ,level nil)
(magit-define-level-shower-1 ,level t)))
(defmacro magit-define-section-jumper (sym title)
"Define an interactive function to go to section SYM.
TITLE is the displayed title of the section."
(let ((fun (intern (format "magit-jump-to-%s" sym)))
(doc (format "Jump to section `%s'." title)))
(defun ,fun ()
(magit-goto-section-at-path '(,sym)))
(put ',fun 'definition-name ',sym))))
(defmacro magit-define-inserter (sym arglist &rest body)
(declare (indent defun))
(let ((fun (intern (format "magit-insert-%s" sym)))
(before (intern (format "magit-before-insert-%s-hook" sym)))
(after (intern (format "magit-after-insert-%s-hook" sym)))
(doc (format "Insert items for `%s'." sym)))
(defvar ,before nil)
(defvar ,after nil)
(defun ,fun ,arglist
(run-hooks ',before)
(run-hooks ',after))
(put ',before 'definition-name ',sym)
(put ',after 'definition-name ',sym)
(put ',fun 'definition-name ',sym))))
(defvar magit-highlighted-section nil)
(defun magit-refine-section (section)
"Apply temporary refinements to the display of SECTION.
Refinements can be undone with `magit-unrefine-section'."
(let ((type (and section (magit-section-type section))))
(cond ((and (eq type 'hunk)
(not (eq magit-diff-refine-hunk 'all)))
;; Refine the current hunk to show fine details, using
;; diff-mode machinery.
(goto-char (magit-section-beginning magit-highlighted-section))
(defun magit-unrefine-section (section)
"Remove refinements to the display of SECTION done by `magit-refine-section'."
(let ((type (and section (magit-section-type section))))
(cond ((and (eq type 'hunk)
(not (eq magit-diff-refine-hunk 'all)))
;; XXX this should be in some diff-mode function, like
;; `diff-unrefine-hunk'
(remove-overlays (magit-section-beginning section)
(magit-section-end section)
'diff-mode 'fine)))))
(defvar magit-highlight-overlay nil)
(defun magit-highlight-section ()
"Highlight current section if it has a type."
(let ((section (magit-current-section)))
(when (not (eq section magit-highlighted-section))
(when magit-highlighted-section
;; remove any refinement from previous hunk
(magit-unrefine-section magit-highlighted-section))
(setq magit-highlighted-section section)
(if (not magit-highlight-overlay)
(let ((ov (make-overlay 1 1)))
(overlay-put ov 'face 'magit-item-highlight)
(setq magit-highlight-overlay ov)))
(if (and section (magit-section-type section))
(magit-refine-section section)
(move-overlay magit-highlight-overlay
(magit-section-beginning section)
(magit-section-end section)
(delete-overlay magit-highlight-overlay)))))
(defun magit-section-context-type (section)
(if (null section)
(let ((c (or (magit-section-type section)
(if (symbolp (magit-section-title section))
(magit-section-title section)))))
(if c
(cons c (magit-section-context-type
(magit-section-parent section)))
(defun magit-prefix-p (prefix list)
"Returns non-nil if PREFIX is a prefix of LIST. PREFIX and LIST should both be
If the car of PREFIX is the symbol '*, then return non-nil if the cdr of PREFIX
is a sublist of LIST (as if '* matched zero or more arbitrary elements of LIST)"
;;; Very schemish...
(or (null prefix)
(if (eq (car prefix) '*)
(or (magit-prefix-p (cdr prefix) list)
(and (not (null list))
(magit-prefix-p prefix (cdr list))))
(and (not (null list))
(equal (car prefix) (car list))
(magit-prefix-p (cdr prefix) (cdr list))))))
(defmacro magit-section-case (head &rest clauses)
"Make different action depending of current section.
SECTION will be bind to the current section,
INFO will be bind to the info's of the current section,
OPNAME is a string that will be used to describe current action,
CLAUSES is a list of CLAUSE, each clause is (SECTION-TYPE &BODY)
where SECTION-TYPE describe section where BODY will be run.
This returns non-nil if some section matches. If the
corresponding body return a non-nil value, it is returned,
otherwise it returns t.
If no section matches, this returns nil if no OPNAME was given
and throws an error otherwise."
(declare (indent 1))
(let ((section (car head))
(info (cadr head))
(type (make-symbol "*type*"))
(context (make-symbol "*context*"))
(opname (caddr head)))
`(let* ((,section (magit-current-section))
(,info (and ,section (magit-section-info ,section)))
(,type (and ,section (magit-section-type ,section)))
(,context (magit-section-context-type ,section)))
(cond ,@(mapcar (lambda (clause)
(if (eq (car clause) t)
`(t (or (progn ,@(cdr clause))
(let ((prefix (reverse (car clause)))
(body (cdr clause)))
`((magit-prefix-p ',prefix ,context)
(or (progn ,@body)
,@(when opname
',(intern (format "magit-%s-action-hook" opname))))
((not ,type)
(error "Nothing to %s here" ,opname))
(error "Can't %s a %s"
(or (get ,type 'magit-description)
(defmacro magit-section-action (head &rest clauses)
(declare (indent 1))
(magit-section-case ,head ,@clauses)))
(defmacro magit-add-action (head &rest clauses)
"Add additional actions to a pre-existing operator.
The syntax is identical to `magit-section-case', except that
OPNAME is mandatory and specifies the operation to which to add
the actions."
(declare (indent 1))
(let ((section (car head))
(info (cadr head))
(type (caddr head)))
`(add-hook ',(intern (format "magit-%s-action-hook" type))
(lambda ()
;; Don't pass in the opname so we don't recursively
;; run the hook again, and so we don't throw an
;; error if no action matches.
`(magit-section-case (,section ,info)
(defun magit-wash-sequence (func)
"Run FUNC until end of buffer is reached.
FUNC should leave point at the end of the modified region"
(while (and (not (eobp))
(funcall func))))
(defmacro magit-define-command (sym arglist &rest body)
"Macro to define a magit command.
It will define the magit-SYM function having ARGLIST as argument.
It will also define the magit-SYM-command-hook variable.
The defined function will call the function in the hook in
order until one return non nil. If they all return nil then body will be called.
It is used to define hookable magit command: command defined by this
function can be enriched by magit extension like magit-topgit and magit-svn"
(declare (indent defun)
(debug (&define name lambda-list
[&optional stringp] ; Match the doc string, if present.
[&optional ("interactive" interactive)]
(let ((fun (intern (format "magit-%s" sym)))
(hook (intern (format "magit-%s-command-hook" sym)))
(doc (format "Command for `%s'." sym))
(inter nil)
(instr body))
(when (stringp (car body))
(setq doc (car body)
instr (cdr body)))
(let ((form (car instr)))
(when (eq (car form) 'interactive)
(setq inter form
instr (cdr instr))))
(defvar ,hook nil)
(defun ,fun ,arglist
(or (run-hook-with-args-until-success
',hook ,@(remq '&optional (remq '&rest arglist)))
(put ',fun 'definition-name ',sym)
(put ',hook 'definition-name ',sym))))
;;; Running commands
(defun magit-set-mode-line-process (str)
(let ((pr (if str (concat " " str) "")))
(magit-for-all-buffers (lambda ()
(setq mode-line-process pr))))))
(defun magit-process-indicator-from-command (comps)
(if (magit-prefix-p (cons magit-git-executable magit-git-standard-options)
(setq comps (nthcdr (+ (length magit-git-standard-options) 1) comps)))
(cond ((or (null (cdr comps))
(not (member (car comps) '("remote"))))
(car comps))
(concat (car comps) " " (cadr comps)))))
(defvar magit-process nil)
(defvar magit-process-client-buffer nil)
(defvar magit-process-buffer-name "*magit-process*"
"Buffer name for running git commands.")
(defun magit-run* (cmd-and-args
&optional logline noerase noerror nowait input)
(if (and magit-process
(get-buffer magit-process-buffer-name))
(error "Git is already running"))
(let ((cmd (car cmd-and-args))
(args (cdr cmd-and-args))
(dir default-directory)
(buf (get-buffer-create magit-process-buffer-name))
(successp nil))
(magit-process-indicator-from-command cmd-and-args))
(setq magit-process-client-buffer (current-buffer))
(with-current-buffer buf
(view-mode 1)
(set (make-local-variable 'view-no-disable-on-exit) t)
(setq view-exit-action
(lambda (buffer)
(with-current-buffer buffer
(setq buffer-read-only t)
(let ((inhibit-read-only t))
(setq default-directory dir)
(if noerase
(goto-char (point-max))
(insert "$ " (or logline
(mapconcat 'identity cmd-and-args " "))
(cond (nowait
(setq magit-process
(let ((process-connection-type magit-process-connection-type))
(apply 'magit-start-process cmd buf cmd args)))
(set-process-sentinel magit-process 'magit-process-sentinel)
(set-process-filter magit-process 'magit-process-filter)
(when input
(with-current-buffer input
(process-send-region magit-process
(point-min) (point-max)))
(process-send-eof magit-process)
(sit-for 0.1 t))
(cond ((= magit-process-popup-time 0)
(pop-to-buffer (process-buffer magit-process)))
((> magit-process-popup-time 0)
magit-process-popup-time nil
(lambda (buf)
(with-current-buffer buf
(when magit-process
(display-buffer (process-buffer magit-process))
(goto-char (point-max))))))
(setq successp t))
(with-current-buffer input
(setq default-directory dir)
(setq magit-process
;; Don't use a pty, because it would set icrnl
;; which would modify the input (issue #20).
(let ((process-connection-type nil))
(apply 'magit-start-process cmd buf cmd args)))
(set-process-filter magit-process 'magit-process-filter)
(process-send-region magit-process
(point-min) (point-max))
(process-send-eof magit-process)
(while (equal (process-status magit-process) 'run)
(sit-for 0.1 t))
(setq successp
(equal (process-exit-status magit-process) 0))
(setq magit-process nil))
(magit-set-mode-line-process nil)
(magit-need-refresh magit-process-client-buffer))
(setq successp
(equal (apply 'process-file cmd nil buf nil args) 0))
(magit-set-mode-line-process nil)
(magit-need-refresh magit-process-client-buffer))))
(or successp
"%s ... [Hit %s or see buffer %s for details]"
(or (with-current-buffer (get-buffer magit-process-buffer-name)
(when (re-search-backward
(concat "^error: \\(.*\\)" paragraph-separate) nil t)
(match-string 1)))
"Git failed")
(with-current-buffer magit-process-client-buffer
(key-description (car (where-is-internal
(autoload 'dired-uncache "dired")
(defun magit-process-sentinel (process event)
(let ((msg (format "%s %s." (process-name process) (substring event 0 -1)))
(successp (string-match "^finished" event))
(key (with-current-buffer magit-process-client-buffer
(key-description (car (where-is-internal
(with-current-buffer (process-buffer process)
(let ((inhibit-read-only t))
(goto-char (point-max))
(insert msg "\n")
(message (if successp msg
(format "%s Hit %s or see buffer %s for details."
msg key (current-buffer)))))
(unless (memq (process-status process) '(run open))
(dired-uncache default-directory)))
(setq magit-process nil)
(magit-set-mode-line-process nil)
(magit-refresh-buffer magit-process-client-buffer)))
(defun magit-password (proc string)
"Checks if git/ssh asks for a password and ask the user for it."
(let (ask)
(cond ((or (string-match "^Enter passphrase for key '\\\(.*\\\)': $" string)
(string-match "^\\\(.*\\\)'s password:" string)
(string-match "^Password for '\\\(.*\\\)':" string))
(setq ask (format "Password for '%s': " (match-string 1 string))))
((string-match "^[pP]assword:" string)
(setq ask "Password:")))
(when ask
(process-send-string proc (concat (read-passwd ask nil) "\n")))))
(defun magit-username (proc string)
"Checks if git asks for a username and ask the user for it."
(when (string-match "^Username for '\\\(.*\\\)':" string)
(process-send-string proc
(read-string (format "Username for '%s': "
(match-string 1 string))
nil nil (user-login-name))
(defun magit-process-filter (proc string)
(set-buffer (process-buffer proc))
(let ((inhibit-read-only t))
(magit-username proc string)
(magit-password proc string)
(goto-char (process-mark proc))
;; Find last ^M in string. If one was found, ignore everything
;; before it and delete the current line.
(let ((ret-pos (length string)))
(while (and (>= (setq ret-pos (1- ret-pos)) 0)
(/= ?\r (aref string ret-pos))))
(cond ((>= ret-pos 0)
(goto-char (line-beginning-position))
(delete-region (point) (line-end-position))
(insert (substring string (+ ret-pos 1))))
(insert string))))
(set-marker (process-mark proc) (point)))))
(defun magit-run (cmd &rest args)
(magit-run* (cons cmd args))))
(defun magit-run-git (&rest args)
(magit-run* (append (cons magit-git-executable
(defun magit-run-git-with-input (input &rest args)
(magit-run* (append (cons magit-git-executable
nil nil nil nil input)))
(defun magit-run-git-async (&rest args)
(message "Running %s %s" magit-git-executable (mapconcat 'identity args " "))
(magit-run* (append (cons magit-git-executable
nil nil nil t))
(defun magit-run-async-with-input (input cmd &rest args)
(magit-run* (cons cmd args) nil nil nil t input))
(defun magit-display-process ()
"Display output from most recent git command."
(unless (get-buffer magit-process-buffer-name)
(error "No Git commands have run"))
(display-buffer magit-process-buffer-name))
;;; Mode
;; We define individual functions (instead of using lambda etc) so
;; that the online help can show something meaningful.
(magit-define-section-jumper untracked "Untracked files")
(magit-define-section-jumper unstaged "Unstaged changes")
(magit-define-section-jumper staged "Staged changes")
(magit-define-section-jumper unpushed "Unpushed commits")
(magit-define-level-shower 1)
(magit-define-level-shower 2)
(magit-define-level-shower 3)
(magit-define-level-shower 4)
(easy-menu-define magit-mode-menu magit-mode-map
"Magit menu"
["Refresh" magit-refresh t]
["Refresh all" magit-refresh-all t]
["Stage" magit-stage-item t]
["Stage all" magit-stage-all t]
["Unstage" magit-unstage-item t]
["Unstage all" magit-unstage-all t]
["Commit" magit-log-edit t]
["Add log entry" magit-add-log t]
["Tag" magit-tag t]
["Annotated tag" magit-annotated-tag t]
["Diff working tree" magit-diff-working-tree t]
["Diff" magit-diff t]
["Short Log" magit-log t]
["Long Log" magit-log-long t]
["Reflog" magit-reflog t]
["Extended..." magit-key-mode-popup-logging t])
["Cherry pick" magit-cherry-pick-item t]
["Apply" magit-apply-item t]
["Revert" magit-revert-item t]
["Ignore" magit-ignore-item t]
["Ignore locally" magit-ignore-item-locally t]
["Discard" magit-discard-item t]
["Reset head" magit-reset-head t]
["Reset working tree" magit-reset-working-tree t]
["Stash" magit-stash t]
["Snapshot" magit-stash-snapshot t]
["Branch..." magit-checkout t]
["Merge" magit-manual-merge t]
["Interactive resolve" magit-interactive-resolve-item t]
["Rebase" magit-rebase-step t]
["Start" magit-rewrite-start t]
["Stop" magit-rewrite-stop t]
["Finish" magit-rewrite-finish t]
["Abort" magit-rewrite-abort t]
["Set used" magit-rewrite-set-used t]
["Set unused" magit-rewrite-set-unused t])
["Push" magit-push t]
["Pull" magit-pull t]
["Remote update" magit-remote-update t]
["Submodule update" magit-submodule-update t]
["Submodule update and init" magit-submodule-update-init t]
["Submodule init" magit-submodule-init t]
["Submodule sync" magit-submodule-sync t])
["Display Git output" magit-display-process t]
["Quit Magit" magit-quit-window t]))
(defvar magit-mode-hook nil "Hook run by `magit-mode'.")
(put 'magit-mode 'mode-class 'special)
(defvar magit-refresh-function nil)
(make-variable-buffer-local 'magit-refresh-function)
(put 'magit-refresh-function 'permanent-local t)
(defvar magit-refresh-args nil)
(make-variable-buffer-local 'magit-refresh-args)
(put 'magit-refresh-args 'permanent-local t)
(defvar last-point)
(defun magit-remember-point ()
(setq last-point (point)))
(defun magit-invisible-region-end (pos)
(while (and (not (= pos (point-max))) (invisible-p pos))
(setq pos (next-char-property-change pos)))
(defun magit-invisible-region-start (pos)
(while (and (not (= pos (point-min))) (invisible-p pos))
(setq pos (1- (previous-char-property-change pos))))
(defun magit-correct-point-after-command ()
"Move point outside of invisible regions.
Emacs often leaves point in invisible regions, it seems. To fix
this, we move point ourselves and never let Emacs do its own
When point has to be moved out of an invisible region, it can be
moved to its end or its beginning. We usually move it to its
end, except when that would move point back to where it was
before the last command."
(if (invisible-p (point))
(let ((end (magit-invisible-region-end (point))))
(goto-char (if (= end last-point)
(magit-invisible-region-start (point))
(setq disable-point-adjustment t))
(defun magit-post-command-hook ()
(defun magit-mode ()
"Review the status of a git repository and act on it.
Please see the manual for a complete description of Magit.
(setq buffer-read-only t
truncate-lines t
major-mode 'magit-mode
mode-name "Magit"
mode-line-process "")
(add-hook 'pre-command-hook #'magit-remember-point nil t)
(add-hook 'post-command-hook #'magit-post-command-hook t t)
(use-local-map magit-mode-map)
(setq magit-current-indentation (magit-indentation-for default-directory))
;; Emacs' normal method of showing trailing whitespace gives weird
;; results when `magit-whitespace-warning-face' is different from
;; `trailing-whitespace'.
(if (and magit-highlight-whitespace magit-highlight-trailing-whitespace)
(setq show-trailing-whitespace nil))
(run-mode-hooks 'magit-mode-hook))
(defun magit-mode-init (dir submode refresh-func &rest refresh-args)
(setq default-directory dir
magit-refresh-function refresh-func
magit-refresh-args refresh-args)
(funcall submode)
(defun magit-indentation-for (dir)
(let (result)
(dolist (pair magit-highlight-indentation)
(if (string-match-p (car pair) dir)
(setq result (cdr pair))))
(defun magit-find-buffer (submode &optional dir)
(let ((topdir (magit-get-top-dir (or dir default-directory))))
(dolist (buf (buffer-list))
(if (with-current-buffer buf
(and (eq major-mode submode)
(equal (expand-file-name default-directory) topdir)))
(return buf)))))
(defun magit-find-status-buffer (&optional dir)
(magit-find-buffer 'magit-status-mode dir))
(defun magit-for-all-buffers (func &optional dir)
(dolist (buf (buffer-list))
(with-current-buffer buf
(if (and (derived-mode-p 'magit-mode)
(or (null dir)
(equal default-directory dir)))
(funcall func)))))
(defun magit-refresh-buffer (&optional buffer)
(with-current-buffer (or buffer (current-buffer))
(let* ((old-line (line-number-at-pos))
(old-point (point))
(old-section (magit-current-section))
(old-path (and old-section
(magit-section-path (magit-current-section)))))
(let ((section-line (and old-section
(magit-section-beginning old-section)
(line-char (- old-point (point))))
(if magit-refresh-function
(apply magit-refresh-function
(let ((s (and old-path (magit-find-section old-path magit-top-section))))
(cond (s
(goto-char (magit-section-beginning s))
(forward-line section-line)
(forward-char line-char))
(magit-goto-line old-line)))
(dolist (w (get-buffer-window-list (current-buffer)))
(set-window-point w (point)))
(defun magit-string-has-prefix-p (string prefix)
(eq (compare-strings string nil (length prefix) prefix nil nil) t))
(defun magit-revert-buffers (dir &optional ignore-modtime)
(dolist (buffer (buffer-list))
(when (and buffer
(buffer-file-name buffer)
;; don't revert indirect buffers, as the parent will be reverted
(not (buffer-base-buffer buffer))
(magit-string-has-prefix-p (buffer-file-name buffer) dir)
(file-readable-p (buffer-file-name buffer))
(or ignore-modtime (not (verify-visited-file-modtime buffer)))
(not (buffer-modified-p buffer)))
(with-current-buffer buffer
(condition-case var
(revert-buffer t t nil)
(error (let ((signal-data (cadr var)))
(cond (t (magit-bug-report signal-data))))))))))
(defun magit-update-vc-modeline (dir)
"Update the modeline for buffers representable by magit."
(dolist (buffer (buffer-list))
(when (and buffer
(buffer-file-name buffer)
(magit-string-has-prefix-p (buffer-file-name buffer) dir))
(with-current-buffer buffer
(condition-case var
(error (let ((signal-data (cadr var)))
(cond (t (magit-bug-report signal-data))))))))))
(defvar magit-refresh-needing-buffers nil)
(defvar magit-refresh-pending nil)
(defun magit-refresh-wrapper (func)
(if magit-refresh-pending
(funcall func)
(let* ((dir default-directory)
(status-buffer (magit-find-status-buffer dir))
(magit-refresh-needing-buffers nil)
(magit-refresh-pending t))
(funcall func)
(when magit-refresh-needing-buffers
(magit-revert-buffers dir)
(dolist (b (adjoin status-buffer
(magit-refresh-buffer b)))))))
(defun magit-need-refresh (&optional buffer)
"Mark BUFFER as needing to be refreshed. If BUFFER is nil, use the
current buffer."
(pushnew (or buffer (current-buffer)) magit-refresh-needing-buffers :test 'eq))
(defun magit-refresh ()
"Refresh current buffer to match repository state.
Also revert every unmodified buffer visiting files
in the corresponding directory."
(defun magit-refresh-all ()
"Refresh all magit buffers to match respective repository states.
Also revert every unmodified buffer visiting files
in the corresponding directories."
(magit-for-all-buffers #'magit-refresh-buffer default-directory))
;;; Untracked files
(defun magit-wash-untracked-file ()
(if (looking-at "^? \\(.*\\)$")
(let ((file (match-string-no-properties 1)))
(delete-region (point) (+ (line-end-position) 1))
(magit-with-section file 'file
(magit-set-section-info file)
(insert "\t" file "\n"))
(defun magit-wash-untracked-files ()
;; Setting magit-old-top-section to nil speeds up washing: no time
;; is wasted looking up the old visibility, which doesn't matter for
;; untracked files.
;; XXX - speed this up in a more general way.
(let ((magit-old-top-section nil))
(magit-wash-sequence #'magit-wash-untracked-file)))
(defun magit-insert-untracked-files ()
(unless (string= (magit-get "status" "showUntrackedFiles") "no")
(apply 'magit-git-section
"Untracked files:"
"ls-files" "--others" "-t" "--exclude-standard"
,@(when magit-omit-untracked-dir-contents
;;; Diffs and Hunks
(defvar magit-diff-context-lines 3)
(defun magit-diff-U-arg ()
(format "-U%d" magit-diff-context-lines))
(defun magit-diff-smaller-hunks (&optional count)
"Decrease the context for diff hunks by COUNT."
(interactive "p")
(setq magit-diff-context-lines (max 0 (- magit-diff-context-lines count)))
(defun magit-diff-larger-hunks (&optional count)
"Increase the context for diff hunks by COUNT."
(interactive "p")
(setq magit-diff-context-lines (+ magit-diff-context-lines count))
(defun magit-diff-default-hunks ()
"Reset context for diff hunks to the default size."
(interactive "")
(setq magit-diff-context-lines 3)
(defun magit-toggle-diff-refine-hunk (&optional other)
(interactive "P")
"Turn diff-hunk refining on or off.
If hunk refining is currently on, then hunk refining is turned off.
If hunk refining is off, then hunk refining is turned on, in
`selected' mode (only the currently selected hunk is refined).
With a prefix argument, the \"third choice\" is used instead:
If hunk refining is currently on, then refining is kept on, but
the refining mode (`selected' or `all') is switched.
If hunk refining is off, then hunk refining is turned on, in
`all' mode (all hunks refined).
Customize `magit-diff-refine-hunk' to change the default mode."
(let* ((old magit-diff-refine-hunk)
(if other
(if (eq old 'all) t 'all)
(not old))))
;; remove any old refining in currently highlighted section
(when (and magit-highlighted-section old (not (eq old 'all)))
(magit-unrefine-section magit-highlighted-section))
;; set variable to new value locally
(set (make-local-variable 'magit-diff-refine-hunk) new)
;; if now highlighting in "selected only" mode, turn refining back
;; on in the current section
(when (and magit-highlighted-section new (not (eq new 'all)))
(magit-refine-section magit-highlighted-section))
;; `all' mode being turned on or off needs a complete refresh
(when (or (eq old 'all) (eq new 'all))
(defun magit-diff-line-file ()
(cond ((looking-at "^diff --git ./\\(.*\\) ./\\(.*\\)$")
(match-string-no-properties 2))
((looking-at "^diff --cc +\\(.*\\)$")
(match-string-no-properties 1))
(defun magit-wash-diffs ()
(magit-wash-sequence #'magit-wash-diff-or-other-file))
(defun magit-wash-diff-or-other-file ()
(or (magit-wash-diff)
(defun magit-wash-other-file ()
(if (looking-at "^? \\(.*\\)$")
(let ((file (match-string-no-properties 1)))
(delete-region (point) (+ (line-end-position) 1))
(magit-with-section file 'file
(magit-set-section-info file)
(insert "\tNew " file "\n"))
(defvar magit-hide-diffs nil)
(defvar magit-indentation-level 1)
(defun magit-insert-diff-title (status file file2)
(let ((status-text (case status
(format "Unmerged %s" file))
(format "New %s" file))
(format "Deleted %s" file))
(format "Renamed %s (from %s)"
file file2))
(format "Modified %s" file))
(format "Typechange %s" file))
(format "? %s" file)))))
(insert (make-string magit-indentation-level ?\t) status-text "\n")))
(defvar magit-current-diff-range nil
"Used internally when setting up magit diff sections.")
(defun magit-wash-typechange-section (file)
(magit-set-section-info (list 'typechange file))
(let ((first-start (point-marker))
(second-start (progn (forward-line 1)
(search-forward-regexp "^diff")
(let ((magit-indentation-level (+ magit-indentation-level 1)))
(narrow-to-region first-start second-start)
(goto-char (point-min))
(magit-with-section file 'diff
(narrow-to-region second-start (point-max))
(goto-char (point-min))
(magit-with-section file 'diff
(defun magit-wash-diff-section ()
(cond ((looking-at "^\\* Unmerged path \\(.*\\)")
(let ((file (match-string-no-properties 1)))
(delete-region (point) (line-end-position))
(insert "\tUnmerged " file "\n")
(magit-set-section-info (list 'unmerged file nil))
((looking-at "^diff")
(let ((file (magit-diff-line-file))
(end (save-excursion
(forward-line) ;; skip over "diff" line
(if (search-forward-regexp "^diff\\|^@@" nil t)
(goto-char (match-beginning 0))
(goto-char (point-max)))
(let* ((status (cond
((looking-at "^diff --cc")
(search-forward-regexp "^new file" end t))
(search-forward-regexp "^deleted" end t))
(search-forward-regexp "^rename" end t))
(file2 (cond
(search-forward-regexp "^rename from \\(.*\\)"
end t))
(match-string-no-properties 1)))))
(magit-set-section-info (list status
(or file2 file)
(magit-insert-diff-title status file file2)
(when (search-forward-regexp "\\(--- \\(.*\\)\n\\+\\+\\+ \\(.*\\)\n\\)" () t)
(when (match-string 1)
(add-text-properties (match-beginning 1) (match-end 1)
'(face magit-diff-hunk-header))
(add-text-properties (match-beginning 2) (match-end 2)
'(face magit-diff-file-header))
(add-text-properties (match-beginning 3) (match-end 3)
'(face magit-diff-file-header))))
(goto-char end)
(let ((magit-section-hidden-default nil))
(magit-wash-sequence #'magit-wash-hunk))))
(defun magit-wash-diff ()
(let ((magit-section-hidden-default magit-hide-diffs))
(magit-with-section (magit-current-line) 'diff
(defun magit-diff-item-kind (diff)
(car (magit-section-info diff)))
(defun magit-diff-item-file (diff)
(cadr (magit-section-info diff)))
(defun magit-diff-item-file2 (diff)
(caddr (magit-section-info diff)))
(defun magit-diff-item-range (diff)
(nth 3 (magit-section-info diff)))
(defun magit-wash-hunk ()
(cond ((looking-at "\\(^@+\\)[^@]*@+.*")
(let ((n-columns (1- (length (match-string 1))))
(head (match-string 0))
(hunk-start-pos (point)))
(magit-with-section head 'hunk
(add-text-properties (match-beginning 0) (match-end 0)
'(face magit-diff-hunk-header))
(while (not (or (eobp)
(looking-at "^diff\\|^@@")))
(let ((prefix (buffer-substring-no-properties
(point) (min (+ (point) n-columns) (point-max)))))
(cond ((string-match "\\+" prefix)
(magit-put-line-property 'face 'magit-diff-add))
((string-match "-" prefix)
(magit-put-line-property 'face 'magit-diff-del))
(magit-put-line-property 'face 'magit-diff-none))))
(when (eq magit-diff-refine-hunk 'all)
(goto-char hunk-start-pos)
(defvar magit-diff-options nil)
(defun magit-insert-diff (file status)
(let ((cmd magit-git-executable)
(args (append (list "diff")
(list (magit-diff-U-arg))
(list "--" file))))
(let ((p (point)))
(magit-git-insert args)
(if (not (eq (char-before) ?\n))
(insert "\n"))
(narrow-to-region p (point))
(goto-char p)
((eq status 'typechange)
(magit-insert-diff-title status file file)
(magit-wash-typechange-section file))
(goto-char (point-max))))))
(defvar magit-last-raw-diff nil)
(defvar magit-ignore-unmerged-raw-diffs nil)
(defun magit-wash-raw-diffs ()
(let ((magit-last-raw-diff nil))
(magit-wash-sequence #'magit-wash-raw-diff)))
(defun magit-wash-raw-diff ()
(if (looking-at
":\\([0-7]+\\) \\([0-7]+\\) [0-9a-f]+ [0-9a-f]+ \\(.\\)[0-9]*\t\\([^\t\n]+\\)$")
(let ((old-perm (match-string-no-properties 1))
(new-perm (match-string-no-properties 2))
(status (case (string-to-char (match-string-no-properties 3))
(?A 'new)
(?D 'deleted)
(?M 'modified)
(?U 'unmerged)
(?T 'typechange)
(t nil)))
(file (match-string-no-properties 4)))
;; If this is for the same file as the last diff, ignore it.
;; Unmerged files seem to get two entries.
;; We also ignore unmerged files when told so.
(if (or (equal file magit-last-raw-diff)
(and magit-ignore-unmerged-raw-diffs (eq status 'unmerged)))
(delete-region (point) (+ (line-end-position) 1))
(setq magit-last-raw-diff file)
;; The 'diff' section that is created here will not work with
;; magit-insert-diff-item-patch etc when we leave it empty.
;; Luckily, raw diffs are only produced for staged and
;; unstaged changes, and we never call
;; magit-insert-diff-item-patch on them. This is a bit
;; brittle, of course.
(let ((magit-section-hidden-default magit-hide-diffs))
(magit-with-section file 'diff
(delete-region (point) (+ (line-end-position) 1))
(if (not (magit-section-hidden magit-top-section))
(magit-insert-diff file status)
(magit-set-section-info (list status file nil))
(magit-set-section-needs-refresh-on-show t)
(magit-insert-diff-title status file nil)))))
(defun magit-hunk-item-diff (hunk)
(let ((diff (magit-section-parent hunk)))
(or (eq (magit-section-type diff) 'diff)
(error "Huh? Parent of hunk not a diff"))
(defun magit-diff-item-insert-header (diff buf)
(let ((beg (save-excursion
(goto-char (magit-section-beginning diff))
(end (if (magit-section-children diff)
(magit-section-beginning (car (magit-section-children diff)))
(magit-section-end diff))))
(magit-insert-region beg end buf)))
(defun magit-insert-diff-item-patch (diff buf)
(let ((beg (save-excursion
(goto-char (magit-section-beginning diff))
(end (magit-section-end diff)))
(magit-insert-region beg end buf)))
(defun magit-insert-hunk-item-patch (hunk buf)
(magit-diff-item-insert-header (magit-hunk-item-diff hunk) buf)
(magit-insert-region (magit-section-beginning hunk) (magit-section-end hunk)
(defun magit-insert-hunk-item-region-patch (hunk reverse beg end buf)
(magit-diff-item-insert-header (magit-hunk-item-diff hunk) buf)
(goto-char (magit-section-beginning hunk))
(magit-insert-current-line buf)
(let ((copy-op (if reverse "+" "-")))
(while (< (point) (magit-section-end hunk))
(if (and (<= beg (point)) (< (point) end))
(magit-insert-current-line buf)
(cond ((looking-at " ")
(magit-insert-current-line buf))
((looking-at copy-op)
(let ((text (buffer-substring-no-properties
(+ (point) 1) (line-beginning-position 2))))
(with-current-buffer buf
(insert " " text))))))
(with-current-buffer buf
(diff-fixup-modifs (point-min) (point-max))))
(defun magit-hunk-item-is-conflict-p (hunk)
;;; XXX - Using the title is a bit too clever...
(string-match "^diff --cc"
(magit-section-title (magit-hunk-item-diff hunk))))
(defun magit-hunk-item-target-line (hunk)
(let ((line (line-number-at-pos)))
(goto-char (magit-section-beginning hunk))
(if (not (looking-at "@@+ .* \\+\\([0-9]+\\)\\(,[0-9]+\\)? @@+"))
(error "Hunk header not found"))
(let ((target (string-to-number (match-string 1))))
(while (< (line-number-at-pos) line)
;; XXX - deal with combined diffs
(if (not (looking-at "-"))
(setq target (+ target 1)))
(defun magit-show (commit filename &optional select prefix)
"Returns a buffer containing the contents of the file FILENAME, as stored in
COMMIT. COMMIT may be one of the following:
- A string with the name of a commit, such as \"head\" or \"dae86e\". See 'git
help revisions' for syntax.
- The symbol 'index, indicating that you want the version in Git's index or
staging area.
- The symbol 'working, indicating that you want the version in the working
directory. In this case you'll get a buffer visiting the file. If there's
already a buffer visiting that file, you'll get that one.
When called interactively or when SELECT is non-nil, make the buffer active,
either in another window or (with a prefix argument) in the current window."
(interactive (let* ((revision (magit-read-rev "Retrieve file from revision"))
(filename (magit-read-file-from-rev revision)))
(list revision filename t current-prefix-arg)))
(if (eq commit 'working)
(find-file-noselect filename)
(let ((buffer (create-file-buffer (format "%s.%s" filename (replace-regexp-in-string ".*/" "" (prin1-to-string commit t))))))
((eq commit 'index)
(let ((checkout-string (magit-git-string "checkout-index"
(string-match "^\\(.*\\)\t" checkout-string)
(with-current-buffer buffer
(let ((tmpname (match-string 1 checkout-string)))
(insert-file-contents tmpname nil nil nil t))
(delete-file tmpname)))))
(with-current-buffer buffer
(magit-git-insert (list "cat-file" "-p"
(concat commit ":" filename)))))))
(with-current-buffer buffer
(let ((buffer-file-name filename))
(goto-char (point-min)))
(if select
(if prefix
(switch-to-buffer buffer)
(switch-to-buffer-other-window buffer))
(defmacro with-magit-tmp-buffer (var &rest body)
(declare (indent 1)
(debug (symbolp &rest form)))
`(let ((,var (generate-new-buffer magit-tmp-buffer-name)))
(progn ,@body)
(kill-buffer ,var))))
(defun magit-apply-diff-item (diff &rest args)
(when (zerop magit-diff-context-lines)
(setq args (cons "--unidiff-zero" args)))
(with-magit-tmp-buffer tmp
(magit-insert-diff-item-patch diff tmp)
(apply #'magit-run-git-with-input tmp
"apply" (append args (list "-")))))
(defun magit-apply-hunk-item* (hunk reverse &rest args)
"Apply single hunk or part of a hunk to the index or working file.
This function is the core of magit's stage, unstage, apply, and
revert operations. HUNK (or the portion of it selected by the
region) will be applied to either the index, if \"--cached\" is a
member of ARGS, or to the working file otherwise."
(let ((zero-context (zerop magit-diff-context-lines))
(use-region (magit-use-region-p)))
(when zero-context
(setq args (cons "--unidiff-zero" args)))
(when reverse
(setq args (cons "--reverse" args)))
(when (and use-region zero-context)
(error (concat "Not enough context to partially apply hunk. "
"Use `+' to increase context.")))
(with-magit-tmp-buffer tmp
(if use-region
hunk reverse (region-beginning) (region-end) tmp)
(magit-insert-hunk-item-patch hunk tmp))
(apply #'magit-run-git-with-input tmp
"apply" (append args (list "-"))))))
(defun magit-apply-hunk-item (hunk &rest args)
(apply #'magit-apply-hunk-item* hunk nil args))
(defun magit-apply-hunk-item-reverse (hunk &rest args)
(apply #'magit-apply-hunk-item* hunk t args))
(magit-define-inserter unstaged-changes (title)
(let ((magit-hide-diffs t)
(magit-current-diff-range (cons 'index 'working)))
(let ((magit-diff-options (append '() magit-diff-options)))
(magit-git-section 'unstaged title 'magit-wash-raw-diffs
(magit-define-inserter staged-changes (staged no-commit)
(let ((magit-current-diff-range (cons "HEAD" 'index)))
(when staged
(let ((magit-hide-diffs t)
(base (if no-commit
(magit-git-string "mktree")
(let ((magit-diff-options (append '("--cached") magit-diff-options))
(magit-ignore-unmerged-raw-diffs t))
(magit-git-section 'staged "Staged changes:" 'magit-wash-raw-diffs
"diff-index" "--cached"
;;; Logs and Commits
; Note: making this a plain defcustom would probably let users break
; the parser too easily
(defvar magit-git-log-options
"--pretty=format:* %h %s"
(format "--abbrev=%s" magit-sha1-abbrev-length)))
; --decorate=full otherwise some ref prefixes are stripped
; '("--pretty=format:* %H%d %s" "--decorate=full"))
;; Regexps for parsing ref names
;; see the `git-check-ref-format' manpage for details
(defconst magit-ref-nonchars "\000-\037\177 ~^:?*[\\"
"Characters specifically disallowed from appearing in Git symbolic refs.
Evaluate (man \"git-check-ref-format\") for details")
(defconst magit-ref-nonslash-re
(concat "\\(?:"
;; "no slash-separated component can begin with a dot ." (rule 1)
"[^" magit-ref-nonchars "./]"
;; "cannot have two consecutive dots .. anywhere." (rule 3)
"Regexp that matches the non-slash parts of a ref name.
Evaluate (man \"git-check-ref-format\") for details")
(defconst magit-refname-re
"\\(?:tag: \\)?"
;; optional non-slash sequence at the beginning
;; any number of slash-prefixed sequences
"/" ;; "must contain at least one /." (rule 2)
;; "cannot end with a slash / nor a dot .." (rule 5)
"[^" magit-ref-nonchars "./]"
"Regexp that matches a git symbolic reference name.
Evaluate (man \"git-check-ref-format\") for details")
(defconst magit-log-oneline-re
"^\\([_\\*|/ -.]+\\)?" ; graph (1)
"\\([0-9a-fA-F]+\\)" ; sha1 (2)
"\\(?:" ; refs (3)
" "
magit-refname-re "\\(?:, " magit-refname-re "\\)*"
" ?\\(.*\\)$" ; msg (4)
(defconst magit-log-longline-re
;; use \0 delimiter (from -z option) to identify commits. this prevents
;; commit messages containing lines like "commit 00000" from polluting the
;; display
"\\([_\\*|/ -.]+\\)?" ; graph (1)
"commit "
"\\([0-9a-fA-F]+\\)" ; sha1 (2)
"\\(?:" ; refs (3)
" "
magit-refname-re "\\(?:, " magit-refname-re "\\)*"
" ?\\(.*\\)$" ; msg (4)
(defvar magit-present-log-line-function 'magit-present-log-line
"The function to use when generating a log line.
It takes four args: CHART, SHA1, REFS and MESSAGE. The function
must return a string which will represent the log line.")
(defun magit-log-get-bisect-state-color (suffix)
(if (string= suffix "bad")
(list suffix 'magit-log-head-label-bisect-bad)
(list suffix 'magit-log-head-label-bisect-good)))
(defun magit-log-get-patches-color (suffix)
(list (and (string-match ".+/\\(.+\\)" suffix)
(match-string 1 suffix))
(defvar magit-log-remotes-color-hook nil)
(defun magit-log-get-remotes-color (suffix)
'magit-log-remotes-color-hook suffix)
(list suffix 'magit-log-head-label-remote)))
(defvar magit-refs-namespaces
'(("tags" . magit-log-head-label-tags)
("remotes" magit-log-get-remotes-color)
("heads" . magit-log-head-label-local)
("patches" magit-log-get-patches-color)
("bisect" magit-log-get-bisect-state-color)))
(defun magit-ref-get-label-color (r)
(let ((uninteresting (loop for re in magit-uninteresting-refs
thereis (string-match re r))))
(if uninteresting (list nil nil)
(let* ((ref-re "\\(?:tag: \\)?refs/\\(?:\\([^/]+\\)/\\)?\\(.+\\)")
(label (and (string-match ref-re r)
(match-string 2 r)))
(res (let ((colorizer
(cdr (assoc (match-string 1 r)
(cond ((null colorizer)
(list r 'magit-log-head-label-default))
((symbolp colorizer)
(list label colorizer))
((listp colorizer)
(funcall (car colorizer)
(match-string 2 r)))
(list r 'magit-log-head-label-default))))))
(defun magit-present-log-line (graph sha1 refs message)
"The default log line generator."
(let ((string-refs
(when refs
(let ((colored-labels
(delete nil
(mapcar (lambda (r)
(destructuring-bind (label face)
(magit-ref-get-label-color r)
(and label
(propertize label 'face face))))
(mapconcat 'identity colored-labels " ")
" ")))))
(if sha1
(propertize sha1 'face 'magit-log-sha1)
(insert-char ? magit-sha1-abbrev-length))
" "
(when graph
(propertize graph 'face 'magit-log-graph))
(when message
(propertize message 'face 'magit-log-message)))))
(defvar magit-log-count ()
"Internal var used to count the number of logs actually added in a buffer.")
(defmacro magit-create-log-buffer-sections (&rest body)
"Empty current buffer of text and magit's section, and then evaluate BODY.
if the number of logs inserted in the buffer is `magit-log-cutoff-length'
insert a line to tell how to insert more of them"
(declare (indent 0))
`(let ((magit-log-count 0) (inhibit-read-only t))
(magit-with-section 'log nil
(if (= magit-log-count magit-log-cutoff-length)
(magit-with-section "longer" 'longer
(insert "type \"e\" to show more logs\n")))))))
(defun magit-wash-log-line (style)
(let ((line-re (cond ((eq style 'long) magit-log-longline-re)
(t magit-log-oneline-re))))
((looking-at line-re)
(let ((chart (match-string 1))
(sha1 (match-string 2))
(msg (match-string 4))
(refs (when (match-string 3)
(delq nil
(lambda (s)
(and (not
(or (string= s "tag:")
(string= s "HEAD"))) ; as of 1.6.6
(split-string (match-string 3) "[(), ]" t))))))
(delete-region (point-at-bol) (point-at-eol))
(insert (funcall magit-present-log-line-function chart sha1 refs msg))
(goto-char (point-at-bol))
(if sha1
(magit-with-section sha1 'commit
(when magit-log-count (setq magit-log-count (1+ magit-log-count)))
(magit-set-section-info sha1)
(defun magit-wash-log (&optional style)
(let ((magit-old-top-section nil))
(magit-wash-sequence (apply-partially 'magit-wash-log-line style))))
(defvar magit-currently-shown-commit nil)
(defun magit-wash-commit ()
(let ((magit-current-diff-range))
(when (looking-at "^commit \\([0-9a-fA-F]\\{40\\}\\)")
(setq magit-current-diff-range (match-string 1))
(add-text-properties (match-beginning 1) (match-end 1)
'(face magit-log-sha1)))
((search-forward-regexp "^Merge: \\([0-9a-fA-F]+\\) \\([0-9a-fA-F]+\\)$" nil t)
(setq magit-current-diff-range (cons (cons (match-string 1)
(match-string 2))
(let ((first (magit-set-section nil 'commit (match-beginning 1) (match-end 1)))
(second (magit-set-section nil 'commit (match-beginning 2) (match-end 2))))
(magit-set-section-info (match-string 1) first)
(magit-set-section-info (match-string 2) second))
(make-commit-button (match-beginning 1) (match-end 1))
(make-commit-button (match-beginning 2) (match-end 2)))
(setq magit-current-diff-range (cons (concat magit-current-diff-range "^")
(search-forward-regexp "^$")
(while (and
(search-forward-regexp "\\(\\b[0-9a-fA-F]\\{4,40\\}\\b\\)\\|\\(^diff\\)" nil 'noerror)
(not (match-string 2)))
(let ((sha1 (match-string 1))
(start (match-beginning 1))
(end (match-end 1)))
(when (string-equal "commit" (magit-git-string "cat-file" "-t" sha1))
(make-commit-button start end)
(let ((section (magit-set-section sha1 'commit start end)))
(magit-set-section-info sha1 section)))))
(when (looking-at "^diff")
(goto-char (point-max))
(insert "\n")
(if magit-back-navigation-history
(magit-with-section "[back]" 'button
(insert-text-button "[back]"
'help-echo "Previous commit"
'action 'magit-show-commit-backward
'follow-link t
'mouse-face 'magit-item-highlight)))
(insert " ")
(if magit-forward-navigation-history
(magit-with-section "[forward]" 'button
(insert-text-button "[forward]"
'help-echo "Next commit"
'action 'magit-show-commit-forward
'follow-link t
'mouse-face 'magit-item-highlight)))))
(defun make-commit-button (start end)
(make-text-button start end
'help-echo "Visit commit"
'action (lambda (button)
(goto-char button)
'follow-link t
'mouse-face 'magit-item-highlight
'face 'magit-log-sha1))
(defun magit-refresh-commit-buffer (commit)
(apply #'magit-git-section nil nil
`(,@(if magit-have-abbrev (list "--no-abbrev-commit"))
,@(if magit-have-decorate (list "--decorate=full"))
"-p" ,commit))))
(define-derived-mode magit-commit-mode magit-mode "Magit"
"Mode to view a git commit.
:group 'magit)
(defvar magit-commit-buffer-name "*magit-commit*"
"Buffer name for displaying commit log messages.")
(defun magit-show-commit (commit &optional scroll inhibit-history select)
"Show information about a commit in the buffer named by
`magit-commit-buffer-name'. COMMIT can be any valid name for a commit
in the current Git repository.
When called interactively or when SELECT is non-nil, switch to
the commit buffer using `pop-to-buffer'.
Unless INHIBIT-HISTORY is non-nil, the commit currently shown
will be pushed onto `magit-back-navigation-history' and
`magit-forward-navigation-history' will be cleared.
Noninteractively, if the commit is already displayed and SCROLL
is provided, call SCROLL's function definition in the commit
window. (`scroll-up' and `scroll-down' are typically passed in
for this argument.)"
(interactive (list (magit-read-rev "Show commit (hash or ref)")
nil nil t))
(when (magit-section-p commit)
(setq commit (magit-section-info commit)))
(unless (eql 0 (magit-git-exit-code "cat-file" "commit" commit))
(error "%s is not a commit" commit))
(let ((dir default-directory)
(buf (get-buffer-create magit-commit-buffer-name)))
((and (equal magit-currently-shown-commit commit)
;; if it's empty then the buffer was killed
(with-current-buffer buf
(> (length (buffer-string)) 1)))
(let ((win (get-buffer-window buf)))
(cond ((not win)
(display-buffer buf))
(with-selected-window win
(funcall scroll))))))
(display-buffer buf)
(with-current-buffer buf
(unless inhibit-history
(push (cons default-directory magit-currently-shown-commit)
(setq magit-forward-navigation-history nil))
(setq magit-currently-shown-commit commit)
(goto-char (point-min))
(magit-mode-init dir 'magit-commit-mode
#'magit-refresh-commit-buffer commit))))
(if select
(pop-to-buffer buf))))
(defun magit-show-commit-backward (&optional ignored)
;; Ignore argument passed by push-button
"Show the commit at the head of `magit-back-navigation-history in
(with-current-buffer magit-commit-buffer-name
(unless magit-back-navigation-history
(error "No previous commit."))
(let ((histitem (pop magit-back-navigation-history)))
(push (cons default-directory magit-currently-shown-commit)
(setq default-directory (car histitem))
(magit-show-commit (cdr histitem) nil 'inhibit-history))))
(defun magit-show-commit-forward (&optional ignored)
;; Ignore argument passed by push-button
"Show the commit at the head of `magit-forward-navigation-history in
(with-current-buffer magit-commit-buffer-name
(unless magit-forward-navigation-history
(error "No next commit."))
(let ((histitem (pop magit-forward-navigation-history)))
(push (cons default-directory magit-currently-shown-commit)
(setq default-directory (car histitem))
(magit-show-commit (cdr histitem) nil 'inhibit-history))))
(defvar magit-marked-commit nil)
(defvar magit-mark-overlay nil)
(make-variable-buffer-local 'magit-mark-overlay)
(put 'magit-mark-overlay 'permanent-local t)
(defun magit-refresh-marked-commits ()
(magit-for-all-buffers #'magit-refresh-marked-commits-in-buffer))
(defun magit-refresh-marked-commits-in-buffer ()
(if (not magit-mark-overlay)
(let ((ov (make-overlay 1 1)))
(overlay-put ov 'face 'magit-item-mark)
(setq magit-mark-overlay ov)))
(delete-overlay magit-mark-overlay)
(lambda (section)
(when (and (eq (magit-section-type section) 'commit)
(equal (magit-section-info section)
(move-overlay magit-mark-overlay
(magit-section-beginning section)
(magit-section-end section)
(defun magit-set-marked-commit (commit)
(setq magit-marked-commit commit)
(defun magit-marked-commit ()
(or magit-marked-commit
(error "No commit marked")))
(defun magit-remote-branch-name (remote branch)
"Get the name of the branch BRANCH on remote REMOTE"
(if (string= remote ".")
(concat remote "/" branch)))
(magit-define-inserter unpulled-commits (remote branch)
(when remote
(apply #'magit-git-section
'unpulled "Unpulled commits:" 'magit-wash-log "log"
(append magit-git-log-options
(format "HEAD..%s" (magit-remote-branch-name remote branch)))))))
(magit-define-inserter unpushed-commits (remote branch)
(when remote
(apply #'magit-git-section
'unpushed "Unpushed commits:" 'magit-wash-log "log"
(append magit-git-log-options
(format "%s..HEAD" (magit-remote-branch-name remote branch)))))))
(defun magit-remote-branch-for (local-branch &optional fully-qualified-name)
"Guess the remote branch name that LOCAL-BRANCH is tracking.
Gives a fully qualified name (e.g., refs/remotes/origin/master) if
(let ((merge (magit-get "branch" local-branch "merge")))
(if (and merge (string-match "^refs/heads/\\(.+\\)" merge))
(concat (if fully-qualified-name
(let ((remote-name (magit-get "branch" local-branch "remote")))
(if (string= "." remote-name)
(concat "refs/remotes/" remote-name "/"))))
(match-string 1 merge))))))
;;; Status
(defvar magit-remote-string-hook nil)
(defun magit-remote-string (remote remote-branch remote-rebase)
((string= "." remote)
(when remote-rebase "onto ")
"branch "
(propertize remote-branch 'face 'magit-branch)))
(when remote-rebase "onto ")
(propertize remote-branch 'face 'magit-branch)
" @ "
" ("
(magit-get "remote" remote "url")
(run-hook-with-args-until-success 'magit-remote-string-hook))))
(declare-function magit--bisect-info-for-status "magit-bisect" (branch))
(defun magit-refresh-status ()
(magit-with-section 'status nil
(let* ((branch (magit-get-current-branch))
(remote (and branch (magit-get "branch" branch "remote")))
(remote-rebase (and branch (magit-get-boolean "branch" branch "rebase")))
(remote-branch (or (and branch (magit-remote-branch-for branch)) branch))
(remote-string (magit-remote-string remote remote-branch remote-rebase))
(head (magit-git-string
(format "--abbrev=%s" magit-sha1-abbrev-length)
(no-commit (not head)))
(when remote-string
(insert "Remote: " remote-string "\n"))
(insert (format "Local: %s %s\n"
(propertize (magit--bisect-info-for-status branch)
'face 'magit-branch)
(abbreviate-file-name default-directory)))
(insert (format "Head: %s\n"
(if no-commit "nothing commited (yet)" head)))
(let ((merge-heads (magit-file-lines (concat (magit-git-dir)
(if merge-heads
(insert (format "Merging: %s\n"
(mapconcat 'identity
(mapcar 'magit-name-rev merge-heads)
", ")))))
(let ((rebase (magit-rebase-info)))
(if rebase
(insert (apply 'format "Rebasing: onto %s (%s of %s); Press \"R\" to Abort, Skip, or Continue\n" rebase))))
(insert "\n")
(magit-git-exit-code "update-index" "--refresh")
(magit-insert-unpulled-commits remote remote-branch)
(let ((staged (or no-commit (magit-anything-staged-p))))
(if staged "Unstaged changes:" "Changes:"))
(magit-insert-staged-changes staged no-commit))
(magit-insert-unpushed-commits remote remote-branch)
(run-hooks 'magit-refresh-status-hook)))))
(defun magit-init (dir)
"Initialize git repository in the DIR directory."
(interactive (list (read-directory-name "Directory for Git repository: ")))
(let* ((dir (file-name-as-directory (expand-file-name dir)))
(topdir (magit-get-top-dir dir)))
(when (or (not topdir)
(if (string-equal topdir dir)
"There is already a Git repository in %s. Reinitialize? "
"There is a Git repository in %s. Create another in %s? ")
topdir dir)))
(unless (file-directory-p dir)
(and (y-or-n-p (format "Directory %s does not exists. Create it? " dir))
(make-directory dir)))
(let ((default-directory dir))
(magit-run* (list magit-git-executable "init"))))))
(define-derived-mode magit-status-mode magit-mode "Magit"
"Mode for looking at git status.
:group 'magit)
(defvar magit-default-directory nil)
(defun magit-save-some-buffers (&optional msg pred)
"Save some buffers if variable `magit-save-some-buffers' is non-nil.
If variable `magit-save-some-buffers' is set to 'dontask then
don't ask the user before saving the buffers, just go ahead and
do it.
Optional argument MSG is displayed in the minibuffer if variable
`magit-save-some-buffers' is nil.
Optional second argument PRED determines which buffers are considered:
If PRED is nil, all the file-visiting buffers are considered.
If PRED is t, then certain non-file buffers will also be considered.
If PRED is a zero-argument function, it indicates for each buffer whether
to consider it or not when called with that buffer current."
(let ((predicate-function (or pred magit-save-some-buffers-predicate))
(magit-default-directory default-directory))
(if magit-save-some-buffers
(eq magit-save-some-buffers 'dontask)
(when msg
(message msg)))))
(defun magit-save-buffers-predicate-all ()
"Prompt to save all buffers with unsaved changes"
(defun magit-save-buffers-predicate-tree-only ()
"Only prompt to save buffers which are within the current git project (as
determined by the dir passed to `magit-status'."
(and buffer-file-name
(string= (magit-get-top-dir magit-default-directory)
(magit-get-top-dir (file-name-directory buffer-file-name)))))
(defun magit-status (dir)
"Open a Magit status buffer for the Git repository containing
DIR. If DIR is not within a Git repository, offer to create a
Git repository in DIR.
Interactively, a prefix argument means to ask the user which Git
repository to use even if `default-directory' is under Git control.
Two prefix arguments means to ignore `magit-repo-dirs' when asking for
user input."
(interactive (list (if current-prefix-arg
(> (prefix-numeric-value current-prefix-arg)
(or (magit-get-top-dir default-directory)
(magit-read-top-dir nil)))))
(let ((topdir (magit-get-top-dir dir)))
(unless topdir
(when (y-or-n-p (format "There is no Git repository in %S. Create one? "
(magit-init dir)
(setq topdir (magit-get-top-dir dir))))
(when topdir
(let ((default-directory topdir))
(let ((buf (or (magit-find-status-buffer topdir)
(concat "*magit: "
(directory-file-name topdir)) "*")))))
(funcall magit-status-buffer-switch-function buf)
(magit-mode-init topdir 'magit-status-mode #'magit-refresh-status)))))
(magit-define-command automatic-merge (revision)
"Merge REVISION into the current 'HEAD'; commit unless merge fails.
\('git merge REVISION')."
(interactive (list (magit-read-rev "Merge" (magit-guess-branch))))
(if revision
(magit-run-git "merge" (magit-rev-to-git revision))))
(magit-define-command manual-merge (revision)
"Merge REVISION into the current 'HEAD'; commit unless merge fails.
\('git merge REVISION')."
(interactive (list (magit-read-rev "Merge" (magit-guess-branch))))
(when revision
(apply 'magit-run-git
"merge" "--no-commit"
(magit-rev-to-git revision)
(when (file-exists-p ".git/MERGE_MSG")
;;; Staging and Unstaging
(defun magit-stage-item (&optional ask)
"Add the item at point to the staging area.
If ASK is set, ask for the file name rather than picking the one
at point."
(interactive "P")
(if ask
(magit-run-git "add" (read-file-name "File to stage: "))
(magit-section-action (item info "stage")
((untracked file)
(magit-run-git "add" info))
(apply #'magit-run-git "add" "--"
(magit-git-lines "ls-files" "--other" "--exclude-standard")))
((unstaged diff hunk)
(if (magit-hunk-item-is-conflict-p item)
(error (concat "Can't stage individual resolution hunks. "
"Please stage the whole file.")))
(magit-apply-hunk-item item "--cached"))
((unstaged diff)
(magit-run-git "add" "-u" (magit-diff-item-file item)))
((staged *)
(error "Already staged"))
((diff diff)
((diff diff hunk)
(error "Can't stage this hunk"))
(error "Can't stage this diff")))))
(defun magit-unstage-item ()
"Remove the item at point from the staging area."
(magit-section-action (item info "unstage")
((staged diff hunk)
(magit-apply-hunk-item-reverse item "--cached"))
((staged diff)
(if (eq (car info) 'unmerged)
(error "Can't unstage an unmerged file. Resolve it first"))
(if (magit-no-commit-p)
(magit-run-git "rm" "--cached" "--" (magit-diff-item-file item))
(magit-run-git "reset" "-q" "HEAD" "--" (magit-diff-item-file item))))
((unstaged *)
(error "Already unstaged"))
((diff diff)
((diff diff hunk)
(error "Can't unstage this hunk"))
(error "Can't unstage this diff"))))
(defun magit-stage-all (&optional also-untracked-p)
"Add all remaining changes in tracked files to staging area.
With prefix argument, add remaining untracked files as well.
\('git add -u .' or 'git add .', respectively)."
(interactive "P")
(if also-untracked-p
(magit-run-git "add" ".")
(magit-run-git "add" "-u" ".")))
(defun magit-unstage-all ()
"Remove all changes from staging area.
\('git reset --mixed HEAD')."
(magit-run-git "reset" "HEAD"))
;;; Branches
(defun escape-branch-name (branch)
"Escapes branch names to remove problematic characters."
(replace-regexp-in-string "[/]" "-" branch))
(defun magit-default-tracking-name-remote-plus-branch
(remote branch)
"Use the remote name plus a hyphen plus the escaped branch name for tracking branches."
(concat remote "-" (escape-branch-name branch)))
(defun magit-default-tracking-name-branch-only
(remote branch)
"Use just the escaped branch name for tracking branches."
(escape-branch-name branch))
(defun magit-get-tracking-name (remote branch)
"Given a REMOTE and a BRANCH name, ask the user for a local
tracking brach name suggesting a sensible default."
(when (yes-or-no-p
(format "Create local tracking branch for %s? " branch))
(let* ((default-name
(funcall magit-default-tracking-name-function remote branch))
(chosen-name (read-string (format "Call local branch (%s): " default-name)