'(gnuserv-program (concat exec-directory "/gnuserv"))
'(history-length 1000)
'(org-agenda-files (quote ("~/org/emacs.org" "~/org/work.org" "~/org/private.org" "~/org/it.org")))
+ '(package-archives (quote (("gnu" . "http://elpa.gnu.org/packages/") ("marmalade" . "http://marmalade-repo.org/packages/") ("melpa" . "http://melpa.milkbox.net/packages"))))
+ '(package-user-dir "/home/baron/.xemacs/elpa")
'(recentf-max-saved-items 42)
'(savehist-mode t nil (savehist))
'(toolbar-visible-p nil)
--- /dev/null
+(1
+ (ack .
+ [(1 3)
+ nil "Interface to ack-like source code search tools" tar
+ ((:keywords "tools" "processes" "convenience")
+ (:url . "https://github.com/leoliu/ack-el"))])
+ (ada-mode .
+ [(5 0)
+ ((wisi
+ (1 0)))
+ "major-mode for editing Ada sources" tar
+ ((:url . "http://stephe-leake.org/emacs/ada-mode/emacs-ada-mode.html"))])
+ (adaptive-wrap .
+ [(0 5)
+ nil "Smart line-wrapping with wrap-prefix" single
+ ((:url . "http://elpa.gnu.org/packages/adaptive-wrap.html")
+ (:keywords))])
+ (adjust-parens .
+ [(3 0)
+ nil "Indent and dedent Lisp code, automatically adjust close parens" tar
+ ((:url . "http://elpa.gnu.org/packages/adjust-parens.html"))])
+ (all .
+ [(1 0)
+ nil "Edit all lines matching a given regexp" single
+ ((:url . "http://elpa.gnu.org/packages/all.html")
+ (:keywords "matching"))])
+ (auctex .
+ [(11 87 2)
+ nil "Integrated environment for *TeX*" tar
+ ((:url . "http://www.gnu.org/software/auctex/"))])
+ (cl-lib .
+ [(0 3)
+ nil "Properly prefixed CL functions and macros" single
+ ((:url . "http://elpa.gnu.org/packages/cl-lib.html")
+ (:keywords))])
+ (coffee-mode .
+ [(0 4 1 1)
+ nil "Major mode for CoffeeScript files" single
+ ((:url . "http://github.com/defunkt/coffee-mode")
+ (:keywords "CoffeeScript major mode"))])
+ (company .
+ [(0 6 12)
+ nil "Modular in-buffer completion framework" tar
+ ((:keywords "abbrev" "convenience" "matching")
+ (:url . "http://company-mode.github.io/"))])
+ (csv-mode .
+ [(1 2)
+ nil "Major mode for editing comma/char separated values" single
+ ((:url . "http://centaur.maths.qmul.ac.uk/Emacs/")
+ (:keywords "convenience"))])
+ (debbugs .
+ [(0 5)
+ nil "SOAP library to access debbugs servers" tar
+ ((:keywords "comm" "hypermedia")
+ (:url . "http://elpa.gnu.org/packages/debbugs.html"))])
+ (dict-tree .
+ [(0 12 8)
+ ((trie
+ (0 2 5))
+ (tNFA
+ (0 1 1))
+ (heap
+ (0 3)))
+ "Dictionary data structure" single
+ ((:url . "http://www.dr-qubit.org/emacs.php")
+ (:keywords "extensions" "matching" "data structures"))])
+ (diff-hl .
+ [(1 5 1)
+ ((cl-lib
+ (0 2)))
+ "Highlight uncommitted changes" tar
+ ((:keywords "vc" "diff")
+ (:url . "https://github.com/dgutov/diff-hl"))])
+ (dismal .
+ [(1 5)
+ ((cl-lib
+ (0)))
+ "Dis Mode Ain't Lotus: Spreadsheet program Emacs" tar
+ ((:url . "http://elpa.gnu.org/packages/dismal.html"))])
+ (djvu .
+ [(0 5)
+ nil "Edit and view Djvu files via djvused" single
+ ((:url . "http://elpa.gnu.org/packages/djvu.html")
+ (:keywords "files" "wp"))])
+ (docbook .
+ [(0 1)
+ nil "Info-like viewer for DocBook" single
+ ((:url . "http://elpa.gnu.org/packages/docbook.html")
+ (:keywords "docs" "help"))])
+ (ediprolog .
+ [(1 0)
+ nil "Emacs Does Interactive Prolog" single
+ ((:url . "http://elpa.gnu.org/packages/ediprolog.html")
+ (:keywords "languages" "processes"))])
+ (eldoc-eval .
+ [(0 1)
+ nil "Enable eldoc support when minibuffer is in use." single
+ ((:url . "http://elpa.gnu.org/packages/eldoc-eval.html")
+ (:keywords))])
+ (enwc .
+ [(1 0)
+ nil "The Emacs Network Client" tar
+ ((:keywords "enwc" "network" "wicd" "manager" "nm")
+ (:url . "http://elpa.gnu.org/packages/enwc.html"))])
+ (epoch-view .
+ [(0 0 1)
+ nil "Minor mode to visualize epoch timestamps" single
+ ((:url . "http://elpa.gnu.org/packages/epoch-view.html")
+ (:keywords "data" "timestamp" "epoch" "unix"))])
+ (f90-interface-browser .
+ [(1 1)
+ nil "Parse and browse f90 interfaces" single
+ ((:url . "http://github.com/wence-/f90-iface/")
+ (:keywords))])
+ (flylisp .
+ [(0 2)
+ nil "Color unbalanced parentheses and parentheses inconsistent with indentation" single
+ ((:url . "http://elpa.gnu.org/packages/flylisp.html")
+ (:keywords))])
+ (ggtags .
+ [(0 7 8)
+ ((emacs
+ (24)))
+ "emacs frontend to GNU Global source code tagging system" single
+ ((:url . "https://github.com/leoliu/ggtags")
+ (:keywords "tools" "convenience"))])
+ (heap .
+ [(0 3)
+ nil "Heap (a.k.a. priority queue) data structure" single
+ ((:url . "http://www.dr-qubit.org/emacs.php")
+ (:keywords "extensions" "data structures" "heap" "priority queue"))])
+ (ioccur .
+ [(2 4)
+ nil "Incremental occur" single
+ ((:url . "http://elpa.gnu.org/packages/ioccur.html")
+ (:keywords))])
+ (jgraph-mode .
+ [(1 0)
+ nil "Major mode for Jgraph files" single
+ ((:url . "http://elpa.gnu.org/packages/jgraph-mode.html")
+ (:keywords "tex" "wp"))])
+ (js2-mode .
+ [(20140114)
+ ((emacs
+ (24 1)))
+ "Improved JavaScript editing mode" tar
+ ((:keywords "languages" "javascript")
+ (:url . "https://github.com/mooz/js2-mode/"))])
+ (jumpc .
+ [(3 0)
+ nil "jump to previous insertion points" single
+ ((:url . "http://elpa.gnu.org/packages/jumpc.html")
+ (:keywords))])
+ (lex .
+ [(1 1)
+ nil "Lexical analyser construction" tar
+ ((:url . "http://elpa.gnu.org/packages/lex.html"))])
+ (lmc .
+ [(1 2)
+ nil "Little Man Computer in Elisp" single
+ ((:url . "http://elpa.gnu.org/packages/lmc.html")
+ (:keywords))])
+ (load-dir .
+ [(0 0 3)
+ nil "Load all Emacs Lisp files in a given directory" single
+ ((:url . "http://elpa.gnu.org/packages/load-dir.html")
+ (:keywords "lisp" "files" "convenience"))])
+ (markchars .
+ [(0 2 0)
+ nil "Mark chars fitting certain characteristics" single
+ ((:url . "http://elpa.gnu.org/packages/markchars.html")
+ (:keywords))])
+ (memory-usage .
+ [(0 2)
+ nil "Analyze the memory usage of Emacs in various ways" single
+ ((:url . "http://elpa.gnu.org/packages/memory-usage.html")
+ (:keywords "maint"))])
+ (minimap .
+ [(1 0)
+ nil "Sidebar showing a \"mini-map\" of a buffer" single
+ ((:url . "http://elpa.gnu.org/packages/minimap.html")
+ (:keywords))])
+ (muse .
+ [(3 20)
+ nil "Authoring and publishing tool for Emacs" tar
+ ((:keywords "hypermedia")
+ (:url . "http://mwolson.org/projects/EmacsMuse.html"))])
+ (nhexl-mode .
+ [(0 1)
+ nil "Minor mode to edit files via hex-dump format" single
+ ((:url . "http://elpa.gnu.org/packages/nhexl-mode.html")
+ (:keywords "data"))])
+ (nlinum .
+ [(1 2)
+ nil "Show line numbers in the margin" single
+ ((:url . "http://elpa.gnu.org/packages/nlinum.html")
+ (:keywords "convenience"))])
+ (notes-mode .
+ [(1 30)
+ nil "Indexing system for on-line note-taking" tar
+ ((:url . "http://elpa.gnu.org/packages/notes-mode.html"))])
+ (num3-mode .
+ [(1 1)
+ nil "highlight groups of digits in long numbers" single
+ ((:url . "http://elpa.gnu.org/packages/num3-mode.html")
+ (:keywords))])
+ (oauth2 .
+ [(0 9)
+ nil "OAuth 2.0 Authorization Protocol" single
+ ((:url . "http://elpa.gnu.org/packages/oauth2.html")
+ (:keywords "comm"))])
+ (omn-mode .
+ [(1 0)
+ nil "Support for OWL Manchester Notation" single
+ ((:url . "http://elpa.gnu.org/packages/omn-mode.html")
+ (:keywords))])
+ (org .
+ [(20140113)
+ nil "Outline-based notes management and organizer" tar nil])
+ (quarter-plane .
+ [(0 1)
+ nil "Minor mode for quarter-plane style editing" single
+ ((:url . "http://elpa.gnu.org/packages/quarter-plane.html")
+ (:keywords "convenience wp"))])
+ (queue .
+ [(0 1)
+ nil "Queue data structure" single
+ ((:url . "http://www.dr-qubit.org/emacs.php")
+ (:keywords "extensions" "data structures" "queue"))])
+ (rainbow-mode .
+ [(0 9)
+ nil "Colorize color names in buffers" single
+ ((:url . "http://elpa.gnu.org/packages/rainbow-mode.html")
+ (:keywords "faces"))])
+ (register-list .
+ [(0 1)
+ nil "Interactively list/edit registers" single
+ ((:url . "http://elpa.gnu.org/packages/register-list.html")
+ (:keywords "register"))])
+ (shen-mode .
+ [(0 1)
+ nil "A major mode for editing shen source code" tar
+ ((:keywords "languages" "shen")
+ (:url . "http://elpa.gnu.org/packages/shen-mode.html"))])
+ (sisu-mode .
+ [(3 0 3)
+ nil "Major mode for SiSU markup text" single
+ ((:url . "http://elpa.gnu.org/packages/sisu-mode.html")
+ (:keywords "text" "processes" "tools"))])
+ (smart-operator .
+ [(4 0)
+ nil "Insert operators with surrounding spaces smartly" single
+ ((:url . "http://xwl.appspot.com/ref/smart-operator.el")
+ (:keywords))])
+ (sml-mode .
+ [(6 4)
+ nil "Major mode for editing (Standard) ML" single
+ ((:url . "http://elpa.gnu.org/packages/sml-mode.html")
+ (:keywords "SML"))])
+ (sokoban .
+ [(1 0 4)
+ nil "Sokoban game for emacs" tar nil])
+ (svg-clock .
+ [(0 5)
+ nil "Analog clock using Scalable Vector Graphics" single
+ ((:url . "http://elpa.gnu.org/packages/svg-clock.html")
+ (:keywords "demo" "svg" "clock"))])
+ (tNFA .
+ [(0 1 1)
+ ((queue
+ (0 1)))
+ "Tagged non-deterministic finite-state automata" single
+ ((:url . "http://www.dr-qubit.org/emacs.php")
+ (:keywords "extensions" "matching" "data structures"))])
+ (temp-buffer-browse .
+ [(1 1)
+ nil "temp buffer browse mode" single
+ ((:url . "http://elpa.gnu.org/packages/temp-buffer-browse.html")
+ (:keywords "convenience"))])
+ (trie .
+ [(0 2 6)
+ ((tNFA
+ (0 1 1))
+ (heap
+ (0 3)))
+ "Trie data structure" single
+ ((:url . "http://www.dr-qubit.org/emacs.php")
+ (:keywords "extensions" "matching" "data structures"))])
+ (undo-tree .
+ [(0 6 5)
+ nil "Treat undo history as a tree" single
+ ((:url . "http://www.dr-qubit.org/emacs.php")
+ (:keywords "convenience" "files" "undo" "redo" "history" "tree"))])
+ (uni-confusables .
+ [(0 1)
+ nil "Unicode confusables table" tar nil])
+ (vlf .
+ [(1 2)
+ nil "View Large Files" single
+ ((:url . "https://github.com/m00natic/vlfi")
+ (:keywords "large files" "utilities"))])
+ (w3 .
+ [(4 0 49)
+ nil "Fully customizable, largely undocumented web browser for Emacs" tar
+ ((:keywords "faces" "help" "comm" "news" "mail" "processes" "mouse" "hypermedia")
+ (:url . "http://elpa.gnu.org/packages/w3.html"))])
+ (websocket .
+ [(1 1)
+ nil "Emacs WebSocket client and server" tar
+ ((:keywords "Communication" "Websocket" "Server")
+ (:url . "http://elpa.gnu.org/packages/websocket.html"))])
+ (windresize .
+ [(0 1)
+ nil "Resize windows interactively" single
+ ((:url . "http://elpa.gnu.org/packages/windresize.html")
+ (:keywords "window"))])
+ (wisi .
+ [(1 0)
+ ((cl-lib
+ (0)))
+ "Utilities for implementing an indentation/navigation engine using a generalized LALR parser" tar
+ ((:url . "http://stephe-leake.org/emacs/ada-mode/emacs-ada-mode.html"))])
+ (wpuzzle .
+ [(1 0)
+ nil "find as many word in a given time" single
+ ((:url . "http://elpa.gnu.org/packages/wpuzzle.html")
+ (:keywords))])
+ (xclip .
+ [(1 3)
+ nil "use xclip to copy&paste" single
+ ((:url . "http://elpa.gnu.org/packages/xclip.html")
+ (:keywords "convenience" "tools"))])
+ (yasnippet .
+ [(0 8 0)
+ nil "Yet another snippet extension for Emacs." tar
+ ((:keywords "convenience" "emulation")
+ (:url . "http://github.com/capitaomorte/yasnippet"))]))
--- /dev/null
+(1(haml-mode .[(3 1 3)((ruby-mode (1 0)))"Major mode for editing Haml files"single])(paredit .[(22)()"minor mode for editing parentheses -*- Mode: Emacs-Lisp -*-"single])(sass-mode .[(3 0 14)((haml-mode (3 0 14)))"Major mode for editing Sass files"single])(perspective .[(1 9)()"switch between named \"perspectives\" of the editor"single])(slime .[(20100404 1)()"Superior Lisp Interaction Mode for Emacs"single])(slime-repl .[(20100404)((slime (20100404)))"Read-Eval-Print Loop written in Emacs Lisp"single])(scpaste .[(0 6)((htmlize (1 39)))"Paste to the web via scp."single])(idle-highlight .[(1 0)()"highlight.[(0 3)()"Font-lock support for Jam files"single])(fakir .[(0 1 8)((noflet (0 0 8)) (dash (1 3 2)) (kv (0 0 19)))"fakeing bits of Emacs -*- lexical-binding: t -*-"single])(flycheck-haskell .[(0 1)((flycheck (0 16)) (haskell-mode (13 7)) (dash (2 4 0)) (f (0 11 0)))"Flycheck: Haskell configuration"tar]))
\ No newline at end of file
--- /dev/null
+This is the file .../info/dir, which contains the
+topmost node of the Info hierarchy, called (dir)Top.
+The first time you invoke Info you start off looking at this node.
+\1f
+File: dir, Node: Top This is the top of the INFO tree
+
+ This (the Directory node) gives a menu of major topics.
+ Typing "q" exits, "?" lists all Info commands, "d" returns here,
+ "h" gives a primer for first-timers,
+ "mEmacs<Return>" visits the Emacs manual, etc.
+
+ In Emacs, you can click mouse button 2 on a menu item or cross reference
+ to select it.
+
+* Menu:
+
+Emacs
+* Magit: (magit). Using Git from Emacs with Magit.
--- /dev/null
+;;; magit-autoloads.el --- automatically extracted autoloads
+;;
+;;; Code:
+
+\f
+;;;### (autoloads (magit-status) "magit" "magit.el" (21205 9255))
+;;; Generated autoloads from magit.el
+
+(autoload 'magit-status "magit" "\
+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.
+
+\(fn DIR)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (magit-blame-mode) "magit-blame" "magit-blame.el"
+;;;;;; (21205 9255))
+;;; Generated autoloads from magit-blame.el
+
+(autoload 'magit-blame-mode "magit-blame" "\
+Display blame information inline.
+
+\(fn &optional ARG)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (turn-on-magit-stgit magit-stgit-mode) "magit-stgit"
+;;;;;; "magit-stgit.el" (21205 9255))
+;;; Generated autoloads from magit-stgit.el
+
+(autoload 'magit-stgit-mode "magit-stgit" "\
+StGit support for Magit
+
+\(fn &optional ARG)" t nil)
+
+(autoload 'turn-on-magit-stgit "magit-stgit" "\
+Unconditionally turn on `magit-stgit-mode'.
+
+\(fn)" nil nil)
+
+;;;***
+\f
+;;;### (autoloads (turn-on-magit-svn magit-svn-mode) "magit-svn"
+;;;;;; "magit-svn.el" (21205 9255))
+;;; Generated autoloads from magit-svn.el
+
+(autoload 'magit-svn-mode "magit-svn" "\
+SVN support for Magit
+
+\(fn &optional ARG)" t nil)
+
+(autoload 'turn-on-magit-svn "magit-svn" "\
+Unconditionally turn on `magit-svn-mode'.
+
+\(fn)" nil nil)
+
+;;;***
+\f
+;;;### (autoloads (turn-on-magit-topgit magit-topgit-mode) "magit-topgit"
+;;;;;; "magit-topgit.el" (21205 9255))
+;;; Generated autoloads from magit-topgit.el
+
+(autoload 'magit-topgit-mode "magit-topgit" "\
+Topgit support for Magit
+
+\(fn &optional ARG)" t nil)
+
+(autoload 'turn-on-magit-topgit "magit-topgit" "\
+Unconditionally turn on `magit-topgit-mode'.
+
+\(fn)" nil nil)
+
+;;;***
+\f
+;;;### (autoloads (global-magit-wip-save-mode magit-wip-save-mode
+;;;;;; magit-wip-mode) "magit-wip" "magit-wip.el" (21205 9255))
+;;; Generated autoloads from magit-wip.el
+
+(defvar magit-wip-mode nil "\
+Non-nil if Magit-Wip mode is enabled.
+See the command `magit-wip-mode' for a description of this minor mode.
+Setting this variable directly does not take effect;
+either customize it (see the info node `Easy Customization')
+or call the function `magit-wip-mode'.")
+
+(custom-autoload 'magit-wip-mode "magit-wip" nil)
+
+(autoload 'magit-wip-mode "magit-wip" "\
+In Magit log buffers; give wip refs a special appearance.
+
+\(fn &optional ARG)" t nil)
+
+(autoload 'magit-wip-save-mode "magit-wip" "\
+Magit support for committing to a work-in-progress ref.
+
+When this minor mode is turned on and a file is saved inside a writable
+git repository then it is also committed to a special work-in-progress
+ref.
+
+\(fn &optional ARG)" t nil)
+
+(defvar global-magit-wip-save-mode nil "\
+Non-nil if Global-Magit-Wip-Save mode is enabled.
+See the command `global-magit-wip-save-mode' for a description of this minor mode.
+Setting this variable directly does not take effect;
+either customize it (see the info node `Easy Customization')
+or call the function `global-magit-wip-save-mode'.")
+
+(custom-autoload 'global-magit-wip-save-mode "magit-wip" nil)
+
+(autoload 'global-magit-wip-save-mode "magit-wip" "\
+Toggle Magit-Wip-Save mode in every possible buffer.
+With prefix ARG, turn Global-Magit-Wip-Save mode on if and only if ARG is positive.
+Magit-Wip-Save mode is enabled in all buffers where `turn-on-magit-wip-save' would do it.
+See `magit-wip-save-mode' for more information on Magit-Wip-Save mode.
+
+\(fn &optional ARG)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (rebase-mode) "rebase-mode" "rebase-mode.el" (21205
+;;;;;; 9256))
+;;; Generated autoloads from rebase-mode.el
+
+(autoload 'rebase-mode "rebase-mode" "\
+Major mode for editing of a Git rebase file.
+
+Rebase files are generated when you run 'git rebase -i' or run
+`magit-interactive-rebase'. They describe how Git should perform
+the rebase. See the documentation for git-rebase (e.g., by
+running 'man git-rebase' at the command line) for details.
+
+\(fn)" t nil)
+
+(add-to-list 'auto-mode-alist '("git-rebase-todo" . rebase-mode))
+
+;;;***
+\f
+;;;### (autoloads nil nil ("magit-bisect.el" "magit-key-mode.el"
+;;;;;; "magit-pkg.el") (21205 9256 127962))
+
+;;;***
+\f
+(provide 'magit-autoloads)
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; coding: utf-8
+;; End:
+;;; magit-autoloads.el ends here
--- /dev/null
+(require 'magit)
+
+(defvar magit--bisect-last-pos)
+(defvar magit--bisect-tmp-file)
+(defvar magit--bisect-info nil)
+(make-variable-buffer-local 'magit--bisect-info)
+(put 'magit--bisect-info 'permanent-local t)
+
+(defun magit--bisecting-p (&optional required-status)
+ "Return t if a bisect session is running.
+If REQUIRED-STATUS is not nil then the current status must also
+match REQUIRED-STATUS."
+ (and (file-exists-p (concat (magit-git-dir) "BISECT_LOG"))
+ (or (not required-status)
+ (eq (plist-get (magit--bisect-info) :status)
+ required-status))))
+
+(defun magit--bisect-info ()
+ (with-current-buffer (magit-find-status-buffer)
+ (or (if (local-variable-p 'magit--bisect-info) magit--bisect-info)
+ (list :status (if (magit--bisecting-p) 'running 'not-running)))))
+
+(defun magit--bisect-cmd (&rest args)
+ "Run `git bisect ...' and update the status buffer"
+ (with-current-buffer (magit-find-status-buffer)
+ (let* ((output (apply 'magit-git-lines (append '("bisect") args)))
+ (cmd (car args))
+ (first-line (car output)))
+ (save-match-data
+ (setq magit--bisect-info
+ (cond ((string= cmd "reset")
+ (list :status 'not-running))
+ ;; Bisecting: 78 revisions left to test after this (roughly 6 steps)
+ ((string-match "^Bisecting:\\s-+\\([0-9]+\\).+roughly\\s-+\\([0-9]+\\)" first-line)
+ (list :status 'running
+ :revs (match-string 1 first-line)
+ :steps (match-string 2 first-line)))
+ ;; e2596955d9253a80aec9071c18079705597fa102 is the first bad commit
+ ((string-match "^\\([a-f0-9]+\\)\\s-.*first bad commit" first-line)
+ (list :status 'finished
+ :bad (match-string 1 first-line)))
+ (t
+ (list :status 'error)))))))
+ (magit-refresh))
+
+(defun magit--bisect-info-for-status (branch)
+ "Return bisect info suitable for display in the status buffer"
+ (let* ((info (magit--bisect-info))
+ (status (plist-get info :status)))
+ (cond ((eq status 'not-running)
+ (or branch "(detached)"))
+ ((eq status 'running)
+ (format "(bisecting; %s revisions & %s steps left)"
+ (or (plist-get info :revs) "unknown number of")
+ (or (plist-get info :steps) "unknown number of")))
+ ((eq status 'finished)
+ (format "(bisected: first bad revision is %s)" (plist-get info :bad)))
+ (t
+ "(bisecting; unknown error occured)"))))
+
+(defun magit-bisect-start ()
+ "Start a bisect session"
+ (interactive)
+ (if (magit--bisecting-p)
+ (error "Already bisecting"))
+ (let ((bad (magit-read-rev "Start bisect with known bad revision" "HEAD"))
+ (good (magit-read-rev "Good revision" (magit-default-rev))))
+ (magit--bisect-cmd "start" bad good)))
+
+(defun magit-bisect-reset ()
+ "Quit a bisect session"
+ (interactive)
+ (unless (magit--bisecting-p)
+ (error "Not bisecting"))
+ (magit--bisect-cmd "reset"))
+
+(defun magit-bisect-good ()
+ "Tell git that the current revision is good during a bisect session"
+ (interactive)
+ (unless (magit--bisecting-p 'running)
+ (error "Not bisecting"))
+ (magit--bisect-cmd "good"))
+
+(defun magit-bisect-bad ()
+ "Tell git that the current revision is bad during a bisect session"
+ (interactive)
+ (unless (magit--bisecting-p 'running)
+ (error "Not bisecting"))
+ (magit--bisect-cmd "bad"))
+
+(defun magit-bisect-skip ()
+ "Tell git to skip the current revision during a bisect session."
+ (interactive)
+ (unless (magit--bisecting-p 'running)
+ (error "Not bisecting"))
+ (magit--bisect-cmd "skip"))
+
+(defun magit-bisect-log ()
+ "Show the bisect log"
+ (interactive)
+ (unless (magit--bisecting-p)
+ (error "Not bisecting"))
+ (magit-run-git "bisect" "log")
+ (magit-display-process))
+
+(defun magit-bisect-visualize ()
+ "Show the remaining suspects with gitk"
+ (interactive)
+ (unless (magit--bisecting-p)
+ (error "Not bisecting"))
+ (magit-run-git "bisect" "visualize")
+ (unless (getenv "DISPLAY")
+ (magit-display-process)))
+
+(easy-mmode-defmap magit-bisect-minibuffer-local-map
+ '(("\C-i" . comint-dynamic-complete-filename))
+ "Keymap for minibuffer prompting of rebase command."
+ :inherit minibuffer-local-map)
+
+(defvar magit-bisect-mode-history nil
+ "Previously run bisect commands.")
+
+(defun magit-bisect-run (command)
+ "Bisect automatically by running commands after each step"
+ (interactive
+ (list
+ (read-from-minibuffer "Run command (like this): "
+ ""
+ magit-bisect-minibuffer-local-map
+ nil
+ 'magit-bisect-mode-history)))
+ (unless (magit--bisecting-p)
+ (error "Not bisecting"))
+ (let ((file (make-temp-file "magit-bisect-run"))
+ buffer)
+ (with-temp-buffer
+ (insert "#!/bin/sh\n" command "\n")
+ (write-region (point-min) (point-max) file))
+ (set-file-modes file #o755)
+ (magit-run-git-async "bisect" "run" file)
+ (magit-display-process)
+ (setq buffer (get-buffer magit-process-buffer-name))
+ (with-current-buffer buffer
+ (set (make-local-variable 'magit--bisect-last-pos) 0)
+ (set (make-local-variable 'magit--bisect-tmp-file) file))
+ (set-process-filter (get-buffer-process buffer) 'magit--bisect-run-filter)
+ (set-process-sentinel (get-buffer-process buffer) 'magit--bisect-run-sentinel)))
+
+(defun magit--bisect-run-filter (process output)
+ (with-current-buffer (process-buffer process)
+ (save-match-data
+ (let ((inhibit-read-only t)
+ line new-info)
+ (insert output)
+ (goto-char magit--bisect-last-pos)
+ (beginning-of-line)
+ (while (< (point) (point-max))
+ (cond ( ;; Bisecting: 78 revisions left to test after this (roughly 6 steps)
+ (looking-at "^Bisecting:\\s-+\\([0-9]+\\).+roughly\\s-+\\([0-9]+\\)")
+ (setq new-info (list :status 'running
+ :revs (match-string 1)
+ :steps (match-string 2))))
+ ( ;; e2596955d9253a80aec9071c18079705597fa102 is the first bad commit
+ (looking-at "^\\([a-f0-9]+\\)\\s-.*first bad commit")
+ (setq new-info (list :status 'finished
+ :bad (match-string 1)))))
+ (forward-line 1))
+ (goto-char (point-max))
+ (setq magit--bisect-last-pos (point))
+ (if new-info
+ (with-current-buffer (magit-find-status-buffer)
+ (setq magit--bisect-info new-info)
+ (magit--bisect-update-status-buffer)))))))
+
+(defun magit--bisect-run-sentinel (process event)
+ (if (string-match-p "^finish" event)
+ (with-current-buffer (process-buffer process)
+ (delete-file magit--bisect-tmp-file)))
+ (magit-process-sentinel process event))
+
+(defun magit--bisect-update-status-buffer ()
+ (with-current-buffer (magit-find-status-buffer)
+ (save-excursion
+ (save-match-data
+ (let ((inhibit-read-only t))
+ (goto-char (point-min))
+ (when (search-forward-regexp "Local:" nil t)
+ (beginning-of-line)
+ (kill-line)
+ (insert (format "Local: %s %s"
+ (propertize (magit--bisect-info-for-status (magit-get-current-branch))
+ 'face 'magit-branch)
+ (abbreviate-file-name default-directory)))))))))
+
+(provide 'magit-bisect)
--- /dev/null
+;;; magit-blame.el --- blame support for magit
+
+;; Copyright (C) 2012 Rüdiger Sonderfeld
+;; Copyright (C) 2012 Yann Hodique
+;; Copyright (C) 2011 byplayer
+;; Copyright (C) 2010 Alexander Prusov
+;; Copyright (C) 2009 Tim Moore
+;; Copyright (C) 2008 Linh Dang
+;; Copyright (C) 2008 Marius Vollmer
+
+;; Author: Yann Hodique <yann.hodiqueNOSPAMgmail.com>
+;; Keywords:
+
+;; Magit is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+;;
+;; Magit is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
+;; License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with Magit. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This code has been backported from Egg (Magit fork) to Magit
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(require 'magit)
+
+(defface magit-blame-header
+ '((t :inherit magit-header))
+ "Face for blame header."
+ :group 'magit-faces)
+
+(defface magit-blame-sha1
+ '((t :inherit (magit-log-sha1
+ magit-blame-header)))
+ "Face for blame sha1."
+ :group 'magit-faces)
+
+(defface magit-blame-culprit
+ '((t :inherit magit-blame-header))
+ "Face for blame culprit."
+ :group 'magit-faces)
+
+(defface magit-blame-time
+ '((t :inherit magit-blame-header))
+ "Face for blame time."
+ :group 'magit-faces)
+
+(defface magit-blame-subject
+ '((t :inherit (magit-log-message magit-blame-header)))
+ "Face for blame tag line."
+ :group 'magit-faces)
+
+(defconst magit-blame-map
+ (let ((map (make-sparse-keymap "Magit:Blame")))
+ (define-key map (kbd "l") 'magit-blame-locate-commit)
+ (define-key map (kbd "RET") 'magit-blame-locate-commit)
+ (define-key map (kbd "q") 'magit-blame-mode)
+ (define-key map (kbd "n") 'magit-blame-next-chunk)
+ (define-key map (kbd "p") 'magit-blame-previous-chunk)
+ map)
+ "Keymap for an annotated section.\\{magit-blame-map}")
+
+(defvar magit-blame-buffer-read-only)
+(make-variable-buffer-local 'magit-blame-buffer-read-only)
+
+;;;###autoload
+(define-minor-mode magit-blame-mode
+ "Display blame information inline."
+ :keymap magit-blame-map
+ :lighter " blame"
+ (unless (buffer-file-name)
+ (error "Current buffer has no associated file!"))
+ (when (and (buffer-modified-p)
+ (y-or-n-p (format "save %s first? " (buffer-file-name))))
+ (save-buffer))
+
+ (if magit-blame-mode
+ (progn
+ (setq magit-blame-buffer-read-only buffer-read-only)
+ (magit-blame-file-on (current-buffer))
+ (set-buffer-modified-p nil)
+ (setq buffer-read-only t))
+ (magit-blame-file-off (current-buffer))
+ (set-buffer-modified-p nil)
+ (setq buffer-read-only magit-blame-buffer-read-only)))
+
+(defun magit-blame-file-off (buffer)
+ (save-excursion
+ (save-restriction
+ (with-current-buffer buffer
+ (widen)
+ (mapc (lambda (ov)
+ (if (overlay-get ov :blame)
+ (delete-overlay ov)))
+ (overlays-in (point-min) (point-max)))))))
+
+(defun magit-blame-file-on (buffer)
+ (magit-blame-file-off buffer)
+ (save-excursion
+ (with-current-buffer buffer
+ (save-restriction
+ (with-temp-buffer
+ (magit-git-insert (list "blame" "--porcelain" "--"
+ (file-name-nondirectory
+ (buffer-file-name buffer))))
+ (magit-blame-parse buffer (current-buffer)))))))
+
+(defun magit-blame-locate-commit (pos)
+ "Jump to a commit in the branch history from an annotated blame section."
+ (interactive "d")
+ (let ((overlays (overlays-at pos))
+ sha1)
+ (dolist (ov overlays)
+ (if (overlay-get ov :blame)
+ (setq sha1 (plist-get (nth 3 (overlay-get ov :blame)) :sha1))))
+ (if sha1
+ (magit-show-commit sha1))))
+
+(defun magit-find-next-overlay-change (BEG END PROP)
+ "Return the next position after BEG where an overlay matching a
+property PROP starts or ends. If there are no matching overlay
+boundaries from BEG to END, the return value is nil."
+ (save-excursion
+ (goto-char BEG)
+ (catch 'found
+ (flet ((overlay-change (pos)
+ (if (< BEG END) (next-overlay-change pos)
+ (previous-overlay-change pos)))
+ (within-bounds-p (pos)
+ (if (< BEG END) (< pos END)
+ (> pos END))))
+ (let ((ov-pos BEG))
+ ;; iterate through overlay changes from BEG to END
+ (while (within-bounds-p ov-pos)
+ (let* ((next-ov-pos (overlay-change ov-pos))
+ ;; search for an overlay with a PROP property
+ (next-ov
+ (let ((overlays (overlays-at next-ov-pos)))
+ (while (and overlays
+ (not (overlay-get (car overlays) PROP)))
+ (setq overlays (cdr overlays)))
+ (car overlays))))
+ (if next-ov
+ ;; found the next overlay with prop PROP at next-ov-pos
+ (throw 'found next-ov-pos)
+ ;; no matching overlay found, keep looking
+ (setq ov-pos next-ov-pos)))))))))
+
+(defun magit-blame-next-chunk (pos)
+ "Go to the next blame chunk."
+ (interactive "d")
+ (let ((next-chunk-pos (magit-find-next-overlay-change pos (point-max) :blame)))
+ (when next-chunk-pos
+ (goto-char next-chunk-pos))))
+
+(defun magit-blame-previous-chunk (pos)
+ "Go to the previous blame chunk."
+ (interactive "d")
+ (let ((prev-chunk-pos (magit-find-next-overlay-change pos (point-min) :blame)))
+ (when prev-chunk-pos
+ (goto-char prev-chunk-pos))))
+
+(defcustom magit-time-format-string "%Y-%m-%dT%T%z"
+ "How to format time in magit-blame header."
+ :group 'magit
+ :type 'string)
+
+(defun magit-blame-decode-time (unixtime &optional tz)
+ "Decode UNIXTIME into (HIGH LOW) format.
+
+The second argument TZ can be used to add the timezone in (-)HHMM
+format to UNIXTIME. UNIXTIME should be either a number
+containing seconds since epoch or Emacs's (HIGH LOW
+. IGNORED) format."
+ (when (numberp tz)
+ (unless (numberp unixtime)
+ (setq unixtime (float-time unixtime)))
+ (let* ((ptz (abs tz))
+ (min (+ (* (/ ptz 100) 60)
+ (mod ptz 100))))
+ (setq unixtime (+ (* (if (< tz 0) (- min) min) 60) unixtime))))
+
+ (when (numberp unixtime)
+ (setq unixtime (seconds-to-time unixtime)))
+ unixtime)
+
+(defun magit-blame-format-time-string (format &optional unixtime tz)
+ "Use FORMAT to format the time UNIXTIME, or now if omitted.
+
+UNIXTIME is specified as a number containing seconds since epoch
+or Emacs's (HIGH LOW . IGNORED) format. The optional argument TZ
+can be used to set the time zone. If TZ is a number it is
+treated as a (-)HHMM offset to Universal Time. If TZ is not
+a number and non-nil the time is printed in UTC. If TZ is nil
+the local zime zone is used. The format of the function is
+similar to `format-time-string' except for %Z which is not
+officially supported at the moment."
+ (unless unixtime
+ (setq unixtime (current-time)))
+ (when (numberp tz) ;; TODO add support for %Z
+ (setq format (replace-regexp-in-string "%z" (format "%+05d" tz) format)))
+ (format-time-string format (magit-blame-decode-time unixtime tz) tz))
+
+(defun magit-blame-parse (target-buf blame-buf)
+ "Parse blame-info in buffer BLAME-BUF and decorate TARGET-BUF buffer."
+ (save-match-data
+ (let ((blank (propertize " " 'face 'magit-blame-header))
+ (nl (propertize "\n" 'face 'magit-blame-header))
+ (commit-hash (make-hash-table :test 'equal :size 577))
+ commit commit-info old-line new-line num old-file subject author
+ author-time author-timezone info ov beg end blame)
+ (with-current-buffer blame-buf
+ (goto-char (point-min))
+ ;; search for a ful commit info
+ (while (re-search-forward "^\\([0-9a-f]\\{40\\}\\) \\([0-9]+\\) \\([0-9]+\\) \\([0-9]+\\)$" nil t)
+ (setq commit (match-string-no-properties 1)
+ old-line (string-to-number
+ (match-string-no-properties 2))
+ new-line (string-to-number
+ (match-string-no-properties 3))
+ num (string-to-number
+ (match-string-no-properties 4)))
+ ;; was this commit already seen (and stored in the hash)?
+ (setq commit-info (gethash commit commit-hash))
+ ;; Nope, this is the 1st time, the full commit-info follow.
+ (unless commit-info
+ (re-search-forward "^author \\(.+\\)$")
+ (setq author (match-string-no-properties 1))
+ (re-search-forward "^author-time \\(.+\\)$")
+ (setq author-time (string-to-number
+ (match-string-no-properties 1)))
+ (re-search-forward "^author-tz \\(.+\\)$")
+ (setq author-timezone (string-to-number
+ (match-string-no-properties 1)))
+ (re-search-forward "^summary \\(.+\\)$")
+ (setq subject (match-string-no-properties 1))
+ (re-search-forward "^filename \\(.+\\)$")
+ (setq old-file (match-string-no-properties 1))
+ (setq commit-info (list :sha1 commit :author author
+ :author-time author-time
+ :author-timezone author-timezone
+ :subject subject :file old-file))
+ ;; save it in the hash
+ (puthash commit commit-info commit-hash))
+ ;; add the current blame-block into the list INFO.
+ (setq info (cons (list old-line new-line num commit-info)
+ info))))
+ ;; now do from beginning
+ (setq info (nreverse info))
+ (with-current-buffer target-buf
+ ;; for every blame chunk
+ (dolist (chunk info)
+ (setq commit-info (nth 3 chunk)
+ old-line (nth 0 chunk)
+ new-line (nth 1 chunk)
+ num (nth 2 chunk)
+ commit (plist-get commit-info :sha1)
+ author (plist-get commit-info :author)
+ author-time (plist-get commit-info :author-time)
+ author-timezone (plist-get commit-info :author-timezone)
+ subject (plist-get commit-info :subject))
+
+ (goto-char (point-min))
+ (forward-line (1- new-line))
+
+ (setq beg (line-beginning-position)
+ end (save-excursion
+ (forward-line num)
+ (line-beginning-position)))
+ ;; mark the blame chunk
+ (put-text-property beg end :blame chunk)
+
+ ;; make an overlay with blame info as 'before-string
+ ;; on the current chunk.
+ (setq ov (make-overlay beg end))
+ (overlay-put ov :blame chunk)
+ (setq blame (concat
+ (propertize (substring-no-properties commit 0 8)
+ 'face 'magit-blame-sha1)
+ blank
+ (propertize (format "%-20s" author)
+ 'face 'magit-blame-culprit)
+ blank
+ (propertize (magit-blame-format-time-string
+ magit-time-format-string
+ author-time author-timezone)
+ 'face 'magit-blame-time)
+ blank
+ (propertize subject 'face 'magit-blame-subject)
+ blank nl))
+ (overlay-put ov 'before-string blame))))))
+
+(provide 'magit-blame)
+;;; magit-blame.el ends here
--- /dev/null
+(require 'magit)
+
+(eval-when-compile (require 'cl))
+
+(defvar magit-key-mode-key-maps '()
+ "This will be filled lazily with proper `define-key' built
+ keymaps as they're requested.")
+
+(defvar magit-key-mode-buf-name "*magit-key*"
+ "Name of the buffer.")
+
+(defvar magit-key-mode-current-args '()
+ "Will contain the arguments to be passed to git.")
+
+(defvar magit-key-mode-current-options '()
+ "Will contain the arguments to be passed to git.")
+
+(defvar magit-log-mode-window-conf nil
+ "Will hold the pre-menu configuration of magit.")
+
+(defvar magit-key-mode-groups
+ '((logging
+ (man-page "git-log")
+ (actions
+ ("l" "Short" magit-log)
+ ("L" "Long" magit-log-long)
+ ("h" "Reflog" magit-reflog)
+ ("rl" "Ranged short" magit-log-ranged)
+ ("rL" "Ranged long" magit-log-long-ranged)
+ ("rh" "Ranged reflog" magit-reflog-ranged))
+ (switches
+ ("-m" "Only merge commits" "--merges")
+ ("-f" "First parent" "--first-parent")
+ ("-i" "Case insensitive patterns" "-i")
+ ("-pr" "Pickaxe regex" "--pickaxe-regex")
+ ("-n" "Name only" "--name-only")
+ ("-am" "All match" "--all-match")
+ ("-al" "All" "--all"))
+ (arguments
+ ("=r" "Relative" "--relative=" read-directory-name)
+ ("=c" "Committer" "--committer=" read-from-minibuffer)
+ ("=>" "Since" "--since=" read-from-minibuffer)
+ ("=<" "Before" "--before=" read-from-minibuffer)
+ ("=s" "Pickaxe search" "-S" read-from-minibuffer)
+ ("=a" "Author" "--author=" read-from-minibuffer)
+ ("=g" "Grep" "--grep=" read-from-minibuffer)))
+
+ (running
+ (actions
+ ("!" "Command from root" magit-shell-command)
+ (":" "Git command" magit-git-command)
+ ("g" "git gui" magit-run-git-gui)
+ ("k" "gitk" magit-run-gitk)))
+
+ (fetching
+ (man-page "git-fetch")
+ (actions
+ ("f" "Current" magit-fetch-current)
+ ("a" "All" magit-remote-update)
+ ("o" "Other" magit-fetch))
+ (switches
+ ("-p" "Prune" "--prune")))
+
+ (pushing
+ (man-page "git-push")
+ (actions
+ ("P" "Push" magit-push)
+ ("t" "Push tags" magit-push-tags))
+ (switches
+ ("-f" "Force" "--force")
+ ("-d" "Dry run" "-n")
+ ("-u" "Set upstream" "-u")))
+
+ (pulling
+ (man-page "git-pull")
+ (actions
+ ("F" "Pull" magit-pull))
+ (switches
+ ("-r" "Rebase" "--rebase")))
+
+ (branching
+ (man-page "git-branch")
+ (actions
+ ("v" "Branch manager" magit-branch-manager)
+ ("c" "Create" magit-create-branch)
+ ("r" "Rename" magit-move-branch)
+ ("k" "Delete" magit-delete-branch)
+ ("b" "Checkout" magit-checkout)))
+
+ (remoting
+ (man-page "git-remote")
+ (actions
+ ("v" "Branch manager" magit-branch-manager)
+ ("a" "Add" magit-add-remote)
+ ("r" "Rename" magit-rename-remote)
+ ("k" "Remove" magit-remove-remote)))
+
+ (tagging
+ (man-page "git-tag")
+ (actions
+ ("t" "Lightweight" magit-tag)
+ ("a" "Annotated" magit-annotated-tag))
+ (switches
+ ("-f" "Force" "-f")))
+
+ (stashing
+ (man-page "git-stash")
+ (actions
+ ("z" "Save" magit-stash)
+ ("s" "Snapshot" magit-stash-snapshot))
+ (switches
+ ("-k" "Keep index" "--keep-index")
+ ("-u" "Include untracked files" "--include-untracked")
+ ("-a" "Include all files" "--all")))
+
+ (merging
+ (man-page "git-merge")
+ (actions
+ ("m" "Merge" magit-manual-merge))
+ (switches
+ ("-ff" "Fast-forward only" "--ff-only")
+ ("-nf" "No fast-forward" "--no-ff")
+ ("-sq" "Squash" "--squash"))
+ (arguments
+ ("-st" "Strategy" "--strategy=" read-from-minibuffer)))
+
+ (rewriting
+ (actions
+ ("b" "Begin" magit-rewrite-start)
+ ("s" "Stop" magit-rewrite-stop)
+ ("a" "Abort" magit-rewrite-abort)
+ ("f" "Finish" magit-rewrite-finish)
+ ("*" "Set unused" magit-rewrite-set-unused)
+ ("." "Set used" magit-rewrite-set-used)))
+
+ (submodule
+ (man-page "git-submodule")
+ (actions
+ ("u" "Update" magit-submodule-update)
+ ("b" "Both update and init" magit-submodule-update-init)
+ ("i" "Init" magit-submodule-init)
+ ("s" "Sync" magit-submodule-sync)))
+
+ (bisecting
+ (man-page "git-bisect")
+ (actions
+ ("b" "Bad" magit-bisect-bad)
+ ("g" "Good" magit-bisect-good)
+ ("k" "Skip" magit-bisect-skip)
+ ("l" "Log" magit-bisect-log)
+ ("r" "Reset" magit-bisect-reset)
+ ("s" "Start" magit-bisect-start)
+ ("u" "Run" magit-bisect-run)
+ ("v" "Visualize" magit-bisect-visualize))))
+ "Holds the key, help, function mapping for the log-mode. If you
+ modify this make sure you reset `magit-key-mode-key-maps' to
+ nil.")
+
+(defun magit-key-mode-delete-group (group)
+ "Delete a group from `magit-key-mode-key-maps'."
+ (let ((items (assoc group magit-key-mode-groups)))
+ (when items
+ ;; reset the cache
+ (setq magit-key-mode-key-maps nil)
+ ;; delete the whole group
+ (setq magit-key-mode-groups
+ (delq items magit-key-mode-groups))
+ ;; unbind the defun
+ (magit-key-mode-de-generate group))
+ magit-key-mode-groups))
+
+(defun magit-key-mode-add-group (group)
+ "Add a new group to `magit-key-mode-key-maps'. If there's
+already a group of that name then this will completely remove it
+and put in its place an empty one of the same name."
+ (when (assoc group magit-key-mode-groups)
+ (magit-key-mode-delete-group group))
+ (setq magit-key-mode-groups
+ (cons (list group (list 'actions)) magit-key-mode-groups)))
+
+(defun magit-key-mode-key-defined-p (for-group key)
+ "If KEY is defined as any of switch, argument or action within
+FOR-GROUP then return t"
+ (catch 'result
+ (let ((options (magit-key-mode-options-for-group for-group)))
+ (dolist (type '(actions switches arguments))
+ (when (assoc key (assoc type options))
+ (throw 'result t))))))
+
+(defun magit-key-mode-update-group (for-group thing &rest args)
+ "Abstraction for setting values in `magit-key-mode-key-maps'."
+ (let* ((options (magit-key-mode-options-for-group for-group))
+ (things (assoc thing options))
+ (key (car args)))
+ (if (cdr things)
+ (if (magit-key-mode-key-defined-p for-group key)
+ (error "%s is already defined in the %s group." key for-group)
+ (setcdr (cdr things) (cons args (cddr things))))
+ (setcdr things (list args)))
+ (setq magit-key-mode-key-maps nil)
+ things))
+
+(defun magit-key-mode-insert-argument (for-group key desc arg read-func)
+ "Add a new binding (KEY) in FOR-GROUP which will use READ-FUNC
+to receive input to apply to argument ARG git is run. DESC should
+be a brief description of the binding."
+ (magit-key-mode-update-group for-group 'arguments key desc arg read-func))
+
+(defun magit-key-mode-insert-switch (for-group key desc switch)
+ "Add a new binding (KEY) in FOR-GROUP which will add SWITCH to git's
+command line when it runs. DESC should be a brief description of
+the binding."
+ (magit-key-mode-update-group for-group 'switches key desc switch))
+
+(defun magit-key-mode-insert-action (for-group key desc func)
+ "Add a new binding (KEY) in FOR-GROUP which will run command
+FUNC. DESC should be a brief description of the binding."
+ (magit-key-mode-update-group for-group 'actions key desc func))
+
+(defun magit-key-mode-options-for-group (for-group)
+ "Retrieve the options (switches, commands and arguments) for
+the group FOR-GROUP."
+ (or (cdr (assoc for-group magit-key-mode-groups))
+ (error "Unknown group '%s'" for-group)))
+
+(defun magit-key-mode-help (for-group)
+ "Provide help for a key (which the user is prompted for) within
+FOR-GROUP."
+ (let* ((opts (magit-key-mode-options-for-group for-group))
+ (man-page (cadr (assoc 'man-page opts)))
+ (seq (read-key-sequence
+ (format "Enter command prefix%s: "
+ (if man-page
+ (format ", `?' for man `%s'" man-page)
+ ""))))
+ (actions (cdr (assoc 'actions opts))))
+ (cond
+ ;; if it is an action popup the help for the to-be-run function
+ ((assoc seq actions) (describe-function (nth 2 (assoc seq actions))))
+ ;; if there is "?" show a man page if there is one
+ ((equal seq "?")
+ (if man-page
+ (man man-page)
+ (error "No man page associated with `%s'" for-group)))
+ (t (error "No help associated with `%s'" seq)))))
+
+(defun magit-key-mode-exec-at-point ()
+ "Run action/args/option at point."
+ (interactive)
+ (let* ((key (or (get-text-property (point) 'key-group-executor)
+ (error "Nothing at point to do.")))
+ (def (lookup-key (current-local-map) key)))
+ (call-interactively def)))
+(defun magit-key-mode-jump-to-next-exec ()
+ "Jump to the next action/args/option point."
+ (interactive)
+ (let* ((oldp (point))
+ (old (get-text-property oldp 'key-group-executor))
+ (p (if (= oldp (point-max)) (point-min) (1+ oldp))))
+ (while (let ((new (get-text-property p 'key-group-executor)))
+ (and (not (= p oldp)) (or (not new) (eq new old))))
+ (setq p (if (= p (point-max)) (point-min) (1+ p))))
+ (goto-char p)
+ (skip-chars-forward " ")))
+
+(defun magit-key-mode-build-keymap (for-group)
+ "Construct a normal looking keymap for the key mode to use and
+put it in magit-key-mode-key-maps for fast lookup."
+ (let* ((options (magit-key-mode-options-for-group for-group))
+ (actions (cdr (assoc 'actions options)))
+ (switches (cdr (assoc 'switches options)))
+ (arguments (cdr (assoc 'arguments options)))
+ (map (make-sparse-keymap)))
+ (suppress-keymap map 'nodigits)
+ ;; ret dwim
+ (define-key map (kbd "RET") 'magit-key-mode-exec-at-point)
+ ;; tab jumps to the next "button"
+ (define-key map (kbd "TAB") 'magit-key-mode-jump-to-next-exec)
+
+ ;; all maps should `quit' with `C-g' or `q'
+ (define-key map (kbd "C-g") `(lambda ()
+ (interactive)
+ (magit-key-mode-command nil)))
+ (define-key map (kbd "q") `(lambda ()
+ (interactive)
+ (magit-key-mode-command nil)))
+ ;; run help
+ (define-key map (kbd "?") `(lambda ()
+ (interactive)
+ (magit-key-mode-help ',for-group)))
+
+ (flet ((defkey (k action)
+ (when (and (lookup-key map (car k))
+ (not (numberp (lookup-key map (car k)))))
+ (message "Warning: overriding binding for `%s' in %S"
+ (car k) for-group)
+ (ding)
+ (sit-for 2))
+ (define-key map (car k)
+ `(lambda () (interactive) ,action))))
+ (when actions
+ (dolist (k actions)
+ (defkey k `(magit-key-mode-command ',(nth 2 k)))))
+ (when switches
+ (dolist (k switches)
+ (defkey k `(magit-key-mode-add-option ',for-group ,(nth 2 k)))))
+ (when arguments
+ (dolist (k arguments)
+ (defkey k `(magit-key-mode-add-argument
+ ',for-group ,(nth 2 k) ',(nth 3 k))))))
+
+ (push (cons for-group map) magit-key-mode-key-maps)
+ map))
+
+(defvar magit-key-mode-prefix nil
+ "For internal use. Holds the prefix argument to the command
+that brought up the key-mode window, so it can be used by the
+command that's eventually invoked.")
+
+(defun magit-key-mode-command (func)
+ (let ((args '()))
+ ;; why can't maphash return a list?!
+ (maphash (lambda (k v)
+ (push (concat k (shell-quote-argument v)) args))
+ magit-key-mode-current-args)
+ (let ((magit-custom-options (append args magit-key-mode-current-options))
+ (current-prefix-arg (or current-prefix-arg magit-key-mode-prefix)))
+ (set-window-configuration magit-log-mode-window-conf)
+ (when func
+ (call-interactively func))
+ (magit-key-mode-kill-buffer))))
+
+(defvar magit-key-mode-current-args nil
+ "A hash-table of current argument set (which will eventually
+ make it to the git command-line).")
+
+(defun magit-key-mode-add-argument (for-group arg-name input-func)
+ (let ((input (funcall input-func (concat arg-name ": "))))
+ (puthash arg-name input magit-key-mode-current-args)
+ (magit-key-mode-redraw for-group)))
+
+(defvar magit-key-mode-current-options '()
+ "Current option set (which will eventually make it to the git
+ command-line).")
+
+(defun magit-key-mode-add-option (for-group option-name)
+ "Toggles the appearance of OPTION-NAME in
+`magit-key-mode-current-options'."
+ (if (not (member option-name magit-key-mode-current-options))
+ (add-to-list 'magit-key-mode-current-options option-name)
+ (setq magit-key-mode-current-options
+ (delete option-name magit-key-mode-current-options)))
+ (magit-key-mode-redraw for-group))
+
+(defun magit-key-mode-kill-buffer ()
+ (interactive)
+ (kill-buffer magit-key-mode-buf-name))
+
+(defvar magit-log-mode-window-conf nil
+ "Pre-popup window configuration.")
+
+(defun magit-key-mode (for-group &optional original-opts)
+ "Mode for magit key selection. All commands, switches and
+options can be toggled/actioned with the key combination
+highlighted before the description."
+ (interactive)
+ ;; save the window config to restore it as was (no need to make this
+ ;; buffer local)
+ (setq magit-log-mode-window-conf
+ (current-window-configuration))
+ ;; setup the mode, draw the buffer
+ (let ((buf (get-buffer-create magit-key-mode-buf-name)))
+ (delete-other-windows)
+ (split-window-vertically)
+ (other-window 1)
+ (switch-to-buffer buf)
+ (kill-all-local-variables)
+ (set (make-local-variable
+ 'magit-key-mode-current-options)
+ original-opts)
+ (set (make-local-variable
+ 'magit-key-mode-current-args)
+ (make-hash-table))
+ (set (make-local-variable 'magit-key-mode-prefix) current-prefix-arg)
+ (magit-key-mode-redraw for-group))
+ (message
+ (concat
+ "Type a prefix key to toggle it. Run 'actions' with their prefixes. "
+ "'?' for more help.")))
+
+(defun magit-key-mode-get-key-map (for-group)
+ "Get or build the keymap for FOR-GROUP."
+ (or (cdr (assoc for-group magit-key-mode-key-maps))
+ (magit-key-mode-build-keymap for-group)))
+
+(defun magit-key-mode-redraw (for-group)
+ "(re)draw the magit key buffer."
+ (let ((buffer-read-only nil)
+ (old-point (point))
+ (is-first (zerop (buffer-size)))
+ (actions-p nil))
+ (erase-buffer)
+ (make-local-variable 'font-lock-defaults)
+ (use-local-map (magit-key-mode-get-key-map for-group))
+ (setq actions-p (magit-key-mode-draw for-group))
+ (delete-trailing-whitespace)
+ (setq mode-name "magit-key-mode" major-mode 'magit-key-mode)
+ (if (and is-first actions-p)
+ (progn (goto-char actions-p)
+ (magit-key-mode-jump-to-next-exec))
+ (goto-char old-point)))
+ (setq buffer-read-only t)
+ (fit-window-to-buffer))
+
+(defun magit-key-mode-draw-header (header)
+ "Draw a header with the correct face."
+ (insert (propertize header 'face 'font-lock-keyword-face) "\n"))
+
+(defvar magit-key-mode-args-in-cols nil
+ "When true, draw arguments in columns as with switches and
+ options.")
+
+(defun magit-key-mode-draw-args (args)
+ "Draw the args part of the menu."
+ (magit-key-mode-draw-buttons
+ "Args"
+ args
+ (lambda (x)
+ (format "(%s) %s"
+ (nth 2 x)
+ (propertize (gethash (nth 2 x) magit-key-mode-current-args "")
+ 'face 'widget-field)))
+ (not magit-key-mode-args-in-cols)))
+
+(defun magit-key-mode-draw-switches (switches)
+ "Draw the switches part of the menu."
+ (magit-key-mode-draw-buttons
+ "Switches"
+ switches
+ (lambda (x)
+ (format "(%s)" (let ((s (nth 2 x)))
+ (if (member s magit-key-mode-current-options)
+ (propertize s 'face 'font-lock-warning-face)
+ s))))))
+
+(defun magit-key-mode-draw-actions (actions)
+ "Draw the actions part of the menu."
+ (magit-key-mode-draw-buttons "Actions" actions nil))
+
+(defun magit-key-mode-draw-buttons (section xs maker
+ &optional one-col-each)
+ (when xs
+ (magit-key-mode-draw-header section)
+ (magit-key-mode-draw-in-cols
+ (mapcar (lambda (x)
+ (let* ((head (propertize (car x) 'face 'font-lock-builtin-face))
+ (desc (nth 1 x))
+ (more (and maker (funcall maker x)))
+ (text (format " %s: %s%s%s"
+ head desc (if more " " "") (or more ""))))
+ (propertize text 'key-group-executor (car x))))
+ xs)
+ one-col-each)))
+
+(defun magit-key-mode-draw-in-cols (strings one-col-each)
+ "Given a list of strings, print in columns (using `insert'). If
+ONE-COL-EACH is true then don't columify, but rather, draw each
+item on one line."
+ (let ((longest-act (apply 'max (mapcar 'length strings))))
+ (while strings
+ (let ((str (car strings)))
+ (let ((padding (make-string (- (+ longest-act 3) (length str)) ? )))
+ (insert str)
+ (if (or one-col-each
+ (and (> (+ (length padding) ;
+ (current-column)
+ longest-act)
+ (window-width))
+ (cdr strings)))
+ (insert "\n")
+ (insert padding))))
+ (setq strings (cdr strings))))
+ (insert "\n"))
+
+(defun magit-key-mode-draw (for-group)
+ "Function used to draw actions, switches and parameters.
+
+Returns the point before the actions part, if any."
+ (let* ((options (magit-key-mode-options-for-group for-group))
+ (switches (cdr (assoc 'switches options)))
+ (arguments (cdr (assoc 'arguments options)))
+ (actions (cdr (assoc 'actions options)))
+ (p nil))
+ (magit-key-mode-draw-switches switches)
+ (magit-key-mode-draw-args arguments)
+ (when actions (setq p (point-marker)))
+ (magit-key-mode-draw-actions actions)
+ (insert "\n")
+ p))
+
+(defun magit-key-mode-de-generate (group)
+ "Unbind the function for GROUP."
+ (fmakunbound
+ (intern (concat "magit-key-mode-popup-" (symbol-name group)))))
+
+(defun magit-key-mode-generate (group)
+ "Generate the key-group menu for GROUP"
+ (let ((opts (magit-key-mode-options-for-group group)))
+ (eval
+ `(defun ,(intern (concat "magit-key-mode-popup-" (symbol-name group))) nil
+ ,(concat "Key menu for " (symbol-name group))
+ (interactive)
+ (magit-key-mode (quote ,group))))))
+
+;; create the interactive functions for the key mode popups (which are
+;; applied in the top-level key maps)
+(mapc (lambda (g)
+ (magit-key-mode-generate (car g)))
+ magit-key-mode-groups)
+
+(provide 'magit-key-mode)
--- /dev/null
+(define-package "magit" "1.2.0" "Control Git from Emacs.")
--- /dev/null
+;;; magit-stgit.el --- StGit plug-in for Magit
+
+;; Copyright (C) 2011 Lluis Vilanova
+;;
+;; Magit is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+;;
+;; Magit is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
+;; License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with Magit. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This plug-in provides StGit functionality as a separate component of Magit.
+
+;; Available actions:
+;; - visit: Shows the patch at point in the series (stg show)
+;; - apply: Goes to the patch at point in the series (stg goto)
+;; - discard: Deletes the marked/at point patch in the series (stg delete)
+
+;; Available commands:
+;; - `magit-stgit-refresh': Refresh the marked/at point patch in the series
+;; (stg refresh)
+;; - `magit-stgit-repair': Repair the StGit metadata (stg repair)
+;; - `magit-stgit-rebase': Rebase the whole series (stg rebase)
+
+;; TODO:
+;; - Let the user select which files must be included in a refresh.
+;; - Missing actions for `magit-show-item-or-scroll-up' and
+;; `magit-show-item-or-scroll-down'.
+;; - Marking a patch is slow and refreshes all buffers, which resets their
+;; position (i.e., the buffer is shown from its first line).
+
+;;; Code:
+
+(require 'magit)
+(eval-when-compile
+ (require 'cl))
+
+;;; Customizables:
+
+(defcustom magit-stgit-executable "stg"
+ "The name of the StGit executable."
+ :group 'magit
+ :type 'string)
+
+(defface magit-stgit-applied
+ '((t :inherit magit-diff-add))
+ "Face for an applied stgit patch."
+ :group 'magit-faces)
+
+(defface magit-stgit-current
+ '((t :inherit magit-item-highlight))
+ "Face for the current stgit patch."
+ :group 'magit-faces)
+
+(defface magit-stgit-other
+ '((t :inherit magit-diff-del))
+ "Face for a non-applied stgit patch."
+ :group 'magit-faces)
+
+(defface magit-stgit-marked
+ '((t :inherit magit-item-mark))
+ "Face for a marked stgit patch."
+ :group 'magit-faces)
+
+(defface magit-stgit-empty
+ '((t :inherit magit-item-mark))
+ "Face for an empty stgit patch."
+ :group 'magit-faces)
+
+;;; Common code:
+
+(defvar magit-stgit--enabled nil
+ "Whether this buffer has StGit support.")
+(make-variable-buffer-local 'magit-stgit--enabled)
+
+(defvar magit-stgit-mode)
+
+(defun magit-stgit--enabled ()
+ "Whether this buffer has StGit support enabled."
+ (if (assoc 'magit-stgit--enabled (buffer-local-variables))
+ magit-stgit--enabled
+ (setq magit-stgit--enabled
+ (and magit-stgit-mode
+ (not (null
+ (member (concat (magit-get-current-branch) ".stgit")
+ (mapcar #'(lambda (line)
+ (string-match "^\\*?\s*\\([^\s]*\\)"
+ line)
+ (match-string 1 line))
+ (magit-git-lines "branch")))))))))
+
+(defun magit-stgit--enabled-reset ()
+ "Reset the StGit enabled state."
+ (kill-local-variable 'magit-stgit--enabled))
+
+(defvar magit-stgit--marked-patch nil
+ "The (per-buffer) currently marked patch in an StGit series.")
+(make-variable-buffer-local 'magit-stgit--marked-patch)
+
+;;; Menu:
+
+(easy-menu-define magit-stgit-extension-menu
+ nil
+ "StGit extension menu"
+ '("StGit"
+ :active (magit-stgit--enabled)
+
+ ["Refresh patch" magit-stgit-refresh
+ :help "Refresh the contents of a patch in an StGit series"]
+ ["Repair" magit-stgit-repair
+ :help "Repair StGit metadata if branch was modified with git commands"]
+ ["Rebase series" magit-stgit-rebase
+ :help "Rebase an StGit patch series"]
+ ))
+
+(easy-menu-add-item 'magit-mode-menu
+ '("Extensions")
+ magit-stgit-extension-menu)
+
+;;; Series section:
+
+(defun magit-stgit--wash-patch ()
+ (if (search-forward-regexp "^\\(.\\)\\(.\\) \\([^\s]*\\)\\(\s*# ?\\)\\(.*\\)"
+ (line-end-position) t)
+ (let* ((empty-str "[empty] ")
+ (indent-str (make-string (string-bytes empty-str) ?\ ))
+ (empty (match-string 1))
+ (state (match-string 2))
+ (patch (match-string 3))
+ (descr (match-string 5)))
+ (delete-region (line-beginning-position) (line-end-position))
+ (insert
+ (cond ((string= empty "0")
+ (propertize (concat empty-str " " state " " descr) 'face 'magit-stgit-empty))
+ ((string= magit-stgit--marked-patch patch)
+ (propertize (concat indent-str " " state " " descr) 'face 'magit-stgit-marked))
+ ((string= state "+")
+ (concat indent-str " " (propertize state 'face 'magit-stgit-applied) " " descr))
+ ((string= state ">")
+ (propertize (concat indent-str " " state " " descr) 'face 'magit-stgit-current))
+ ((string= state "-")
+ (concat indent-str " " (propertize state 'face 'magit-stgit-other) " " descr))))
+ (goto-char (line-beginning-position))
+ (magit-with-section patch 'series
+ (magit-set-section-info patch)
+ (goto-char (line-end-position)))
+ (forward-line))
+ (delete-region (line-beginning-position) (1+ (line-end-position))))
+ t)
+
+(defun magit-stgit--wash-series ()
+ (let ((magit-old-top-section nil))
+ (magit-wash-sequence #'magit-stgit--wash-patch)))
+
+(magit-define-inserter series ()
+ (when (executable-find magit-stgit-executable)
+ (magit-insert-section 'series
+ "Series:" 'magit-stgit--wash-series
+ magit-stgit-executable "series" "-a" "-d" "-e")))
+
+;;; Actions:
+
+;; Copy of `magit-refresh-commit-buffer' (version 1.0.0)
+(defun magit-stgit--refresh-patch-buffer (patch)
+ (magit-create-buffer-sections
+ (magit-insert-section nil nil
+ 'magit-wash-commit
+ magit-stgit-executable
+ "show"
+ patch)))
+
+;; Copy of `magit-show-commit' (version 1.0.0)
+(defun magit-stgit--show-patch (patch &optional scroll)
+ (when (magit-section-p patch)
+ (setq patch (magit-section-info patch)))
+ (let ((dir default-directory)
+ (buf (get-buffer-create magit-commit-buffer-name)))
+ (cond ((and (equal magit-currently-shown-commit patch)
+ ;; 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))
+ (scroll
+ (with-selected-window win
+ (funcall scroll))))))
+ (t
+ (setq magit-currently-shown-commit patch)
+ (display-buffer buf)
+ (with-current-buffer buf
+ (set-buffer buf)
+ (goto-char (point-min))
+ (magit-mode-init dir 'magit-commit-mode
+ #'magit-stgit--refresh-patch-buffer patch))))))
+
+(magit-add-action (item info "visit")
+ ((series)
+ (magit-stgit--show-patch info)
+ (pop-to-buffer magit-commit-buffer-name)))
+
+(magit-add-action (item info "apply")
+ ((series)
+ (magit-run magit-stgit-executable "goto" info)))
+
+(magit-add-action (item info "discard")
+ ((series)
+ (let ((patch (or magit-stgit--marked-patch info)))
+ (if (yes-or-no-p (format "Delete patch '%s' in series? " patch))
+ (progn
+ (if (string= magit-stgit--marked-patch patch)
+ (setq magit-stgit--marked-patch nil))
+ (magit-run magit-stgit-executable "delete" patch))))))
+
+(defun magit-stgit--set-marked-patch (patch)
+ (setq magit-stgit--marked-patch
+ (if (string= magit-stgit--marked-patch patch)
+ nil
+ patch)))
+
+(magit-add-action (item info "mark")
+ ((series)
+ (magit-stgit--set-marked-patch info)
+ (magit-refresh-all)))
+
+;;; Commands:
+
+(defun magit-stgit-refresh ()
+ "Refresh the contents of a patch in an StGit series.
+If there is no marked patch in the series, refreshes the current
+patch.
+Otherwise, refreshes the marked patch."
+ (interactive)
+ (if magit-stgit--marked-patch
+ (magit-run magit-stgit-executable "refresh" "-p" magit-stgit--marked-patch)
+ (magit-run magit-stgit-executable "refresh")))
+
+(defun magit-stgit-repair ()
+ "Repair StGit metadata if branch was modified with git commands.
+In the case of Git commits these will be imported as new patches
+into the series."
+ (interactive)
+ (message "Repairing series...")
+ (magit-run magit-stgit-executable "repair")
+ (message ""))
+
+(defun magit-stgit-rebase ()
+ "Rebase an StGit patch series."
+ (interactive)
+ (if (magit-get-current-remote)
+ (progn
+ (if (yes-or-no-p "Update remotes? ")
+ (progn
+ (message "Updating remotes...")
+ (magit-run-git-async "remote" "update")))
+ (magit-run magit-stgit-executable "rebase"
+ (format "remotes/%s/%s"
+ (magit-get-current-remote)
+ (magit-get-current-branch))))))
+
+;;;###autoload
+(define-minor-mode magit-stgit-mode "StGit support for Magit"
+ :lighter " Stg" :require 'magit-stgit
+ (or (derived-mode-p 'magit-mode)
+ (error "This mode only makes sense with magit"))
+ (if magit-stgit-mode
+ (progn
+ (add-hook 'magit-after-insert-stashes-hook 'magit-insert-series nil t))
+ (progn
+ (remove-hook 'magit-after-insert-stashes-hook 'magit-insert-series t)))
+ (when (called-interactively-p 'any)
+ (magit-refresh)))
+
+;;;###autoload
+(defun turn-on-magit-stgit ()
+ "Unconditionally turn on `magit-stgit-mode'."
+ (magit-stgit-mode 1))
+
+(provide 'magit-stgit)
+;;; magit-stgit.el ends here
--- /dev/null
+;;; magit-svn.el --- git-svn plug-in for Magit
+
+;; Copyright (C) 2008 Alex Ott
+;; Copyright (C) 2009 Alexey Voinov
+;; Copyright (C) 2009 John Wiegley
+;; Copyright (C) 2008 Linh Dang
+;; Copyright (C) 2008 Marcin Bachry
+;; Copyright (C) 2008, 2009 Marius Vollmer
+;; Copyright (C) 2010 Yann Hodique
+;;
+;; Magit is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+;;
+;; Magit is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
+;; License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with Magit. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This plug-in provides git-svn functionality as a separate component of Magit
+
+;;; Code:
+
+(require 'magit)
+(eval-when-compile
+ (require 'cl))
+
+;; git svn commands
+
+(defun magit-svn-find-rev (rev &optional branch)
+ (interactive
+ (list (read-string "SVN revision: ")
+ (if current-prefix-arg
+ (read-string "In branch: "))))
+ (let* ((sha (apply 'magit-git-string
+ `("svn"
+ "find-rev"
+ ,(concat "r" rev)
+ ,@(when branch (list branch))))))
+ (if sha
+ (magit-show-commit
+ (magit-with-section sha 'commit
+ (magit-set-section-info sha)
+ sha))
+ (error "Revision %s could not be mapped to a commit" rev))))
+
+(defun magit-svn-create-branch (name)
+ (interactive "sBranch name: ")
+ (magit-run-git "svn" "branch" name))
+
+(defun magit-svn-rebase ()
+ (interactive)
+ (magit-run-git-async "svn" "rebase"))
+
+(defun magit-svn-dcommit ()
+ (interactive)
+ (magit-run-git-async "svn" "dcommit"))
+
+(defun magit-svn-enabled ()
+ (not (null (magit-svn-get-ref-info t))))
+
+(defun magit-svn-expand-braces-in-branches (branch)
+ (if (not (string-match "\\(.+\\){\\(.+,.+\\)}\\(.*\\):\\(.*\\)\\\*" branch))
+ (list branch)
+ (let ((prefix (match-string 1 branch))
+ (suffix (match-string 3 branch))
+ (rhs (match-string 4 branch))
+ (pieces (split-string (match-string 2 branch) ",")))
+ (mapcar (lambda (p) (concat prefix p suffix ":" rhs p)) pieces))))
+
+(defun magit-svn-get-local-ref (url)
+ (let* ((branches (cons (magit-get "svn-remote" "svn" "fetch")
+ (magit-get-all "svn-remote" "svn" "branches")))
+ (branches (apply 'nconc
+ (mapcar 'magit-svn-expand-braces-in-branches
+ branches)))
+ (base-url (magit-get "svn-remote" "svn" "url"))
+ (result nil))
+ (while branches
+ (let* ((pats (split-string (pop branches) ":"))
+ (src (replace-regexp-in-string "\\*" "\\\\(.*\\\\)" (car pats)))
+ (dst (replace-regexp-in-string "\\*" "\\\\1" (cadr pats)))
+ (base-url (replace-regexp-in-string "\\+" "\\\\+" base-url))
+ (base-url (replace-regexp-in-string "//.+@" "//" base-url))
+ (pat1 (concat "^" src "$"))
+ (pat2 (cond ((equal src "") (concat "^" base-url "$"))
+ (t (concat "^" base-url "/" src "$")))))
+ (cond ((string-match pat1 url)
+ (setq result (replace-match dst nil nil url))
+ (setq branches nil))
+ ((string-match pat2 url)
+ (setq result (replace-match dst nil nil url))
+ (setq branches nil)))))
+ result))
+
+(defvar magit-svn-get-ref-info-cache nil
+ "A cache for svn-ref-info.
+As `magit-get-svn-ref-info' might be considered a quite
+expensive operation a cache is taken so that `magit-status'
+doesn't repeatedly call it.")
+
+(defun magit-svn-get-ref-info (&optional use-cache)
+ "Gather details about the current git-svn repository.
+Return nil if there isn't one. Keys of the alist are ref-path,
+trunk-ref-name and local-ref-name.
+If USE-CACHE is non-nil then return the value of `magit-get-svn-ref-info-cache'."
+ (if (and use-cache magit-svn-get-ref-info-cache)
+ magit-svn-get-ref-info-cache
+ (let* ((fetch (magit-get "svn-remote" "svn" "fetch"))
+ (url)
+ (revision))
+ (when fetch
+ (let* ((ref (cadr (split-string fetch ":")))
+ (ref-path (file-name-directory ref))
+ (trunk-ref-name (file-name-nondirectory ref)))
+ (set (make-local-variable
+ 'magit-svn-get-ref-info-cache)
+ (list
+ (cons 'ref-path ref-path)
+ (cons 'trunk-ref-name trunk-ref-name)
+ ;; get the local ref from the log. This is actually
+ ;; the way that git-svn does it.
+ (cons 'local-ref
+ (with-temp-buffer
+ (insert (or (magit-git-string "log" "--first-parent"
+ "--grep" "git-svn" "-1")
+ ""))
+ (goto-char (point-min))
+ (cond ((re-search-forward "git-svn-id: \\(.+/.+?\\)@\\([0-9]+\\)" nil t)
+ (setq url (match-string 1)
+ revision (match-string 2))
+ (magit-svn-get-local-ref url))
+ (t
+ (setq url (magit-get "svn-remote" "svn" "url"))
+ nil))))
+ (cons 'revision revision)
+ (cons 'url url))))))))
+
+(defun magit-svn-get-ref (&optional use-cache)
+ "Get the best guess remote ref for the current git-svn based branch.
+If USE-CACHE is non nil, use the cached information."
+ (let ((info (magit-svn-get-ref-info use-cache)))
+ (cdr (assoc 'local-ref info))))
+
+(magit-define-inserter svn-unpulled (&optional use-cache)
+ (when (magit-svn-enabled)
+ (apply #'magit-git-section
+ 'svn-unpulled "Unpulled commits (SVN):" 'magit-wash-log "log"
+ (append magit-git-log-options
+ (list
+ (format "HEAD..%s" (magit-svn-get-ref use-cache)))))))
+
+(magit-define-inserter svn-unpushed (&optional use-cache)
+ (when (magit-svn-enabled)
+ (apply #'magit-git-section
+ 'svn-unpushed "Unpushed commits (SVN):" 'magit-wash-log "log"
+ (append magit-git-log-options
+ (list
+ (format "%s..HEAD" (magit-svn-get-ref use-cache)))))))
+
+(magit-define-section-jumper svn-unpushed "Unpushed commits (SVN)")
+
+(defun magit-svn-remote-string ()
+ (let ((svn-info (magit-svn-get-ref-info)))
+ (when svn-info
+ (concat (cdr (assoc 'url svn-info))
+ " @ "
+ (cdr (assoc 'revision svn-info))))))
+
+(defun magit-svn-remote-update ()
+ (interactive)
+ (when (magit-svn-enabled)
+ (magit-run-git-async "svn" "fetch")))
+
+(easy-menu-define magit-svn-extension-menu
+ nil
+ "Git SVN extension menu"
+ '("Git SVN"
+ :visible magit-svn-mode
+ ["Create branch" magit-svn-create-branch (magit-svn-enabled)]
+ ["Rebase" magit-svn-rebase (magit-svn-enabled)]
+ ["Fetch" magit-svn-remote-update (magit-svn-enabled)]
+ ["Commit" magit-svn-dcommit (magit-svn-enabled)]))
+
+(easy-menu-add-item 'magit-mode-menu
+ '("Extensions")
+ magit-svn-extension-menu)
+
+;; add the group and its keys
+(progn
+ ;; (re-)create the group
+ (magit-key-mode-add-group 'svn)
+
+ (magit-key-mode-insert-action 'svn "r" "Rebase" 'magit-svn-rebase)
+ (magit-key-mode-insert-action 'svn "c" "DCommit" 'magit-svn-dcommit)
+ (magit-key-mode-insert-action 'svn "f" "Fetch" 'magit-svn-remote-update)
+ (magit-key-mode-insert-action 'svn "s" "Find rev" 'magit-svn-find-rev)
+ (magit-key-mode-insert-action 'svn "B" "Create branch" 'magit-svn-create-branch)
+
+ ;; generate and bind the menu popup function
+ (magit-key-mode-generate 'svn))
+
+(defvar magit-svn-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "N") 'magit-key-mode-popup-svn)
+ map))
+
+;;;###autoload
+(define-minor-mode magit-svn-mode "SVN support for Magit"
+ :lighter " SVN" :require 'magit-svn :keymap 'magit-svn-mode-map
+ (or (derived-mode-p 'magit-mode)
+ (error "This mode only makes sense with magit"))
+ (let ((unpulled-hook (lambda () (magit-insert-svn-unpulled t)))
+ (unpushed-hook (lambda () (magit-insert-svn-unpushed t)))
+ (remote-hook 'magit-svn-remote-string))
+ (if magit-svn-mode
+ (progn
+ (add-hook 'magit-after-insert-unpulled-commits-hook unpulled-hook nil t)
+ (add-hook 'magit-after-insert-unpushed-commits-hook unpushed-hook nil t)
+ (add-hook 'magit-remote-string-hook remote-hook nil t))
+ (progn
+ (remove-hook 'magit-after-insert-unpulled-commits-hook unpulled-hook t)
+ (remove-hook 'magit-after-insert-unpushed-commits-hook unpushed-hook t)
+ (remove-hook 'magit-remote-string-hook remote-hook t)))
+ (when (called-interactively-p 'any)
+ (magit-refresh))))
+
+;;;###autoload
+(defun turn-on-magit-svn ()
+ "Unconditionally turn on `magit-svn-mode'."
+ (magit-svn-mode 1))
+
+(provide 'magit-svn)
+;;; magit-svn.el ends here
--- /dev/null
+;;; magit-topgit.el --- topgit plug-in for Magit
+
+;; Copyright (C) 2010 Nathan Weizenbaum
+;; Copyright (C) 2010 Yann Hodique
+;;
+;; Magit is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+;;
+;; Magit is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
+;; License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with Magit. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This plug-in provides topgit functionality as a separate component of Magit
+
+;;; Code:
+
+(require 'magit)
+(eval-when-compile
+ (require 'cl))
+
+(defcustom magit-topgit-executable "tg"
+ "The name of the TopGit executable."
+ :group 'magit
+ :type 'string)
+
+(defcustom magit-topgit-branch-prefix "t/"
+ "Convention prefix for topic branch creation."
+ :group 'magit
+ :type 'string)
+
+(defface magit-topgit-current
+ '((t :weight bold :inherit magit-branch))
+ "Face for section titles."
+ :group 'magit-faces)
+
+;;; Topic branches (using topgit)
+
+(defun magit-topgit-in-topic-p ()
+ (and (file-exists-p ".topdeps")
+ (executable-find magit-topgit-executable)))
+
+(defun magit-topgit-create-branch (branch parent)
+ (when (zerop (or (string-match magit-topgit-branch-prefix branch) -1))
+ (magit-run* (list magit-topgit-executable "create"
+ branch (magit-rev-to-git parent))
+ nil nil nil t)
+ t))
+
+(defun magit-topgit-pull ()
+ (when (magit-topgit-in-topic-p)
+ (magit-run* (list magit-topgit-executable "update")
+ nil nil nil t)
+ t))
+
+(defun magit-topgit-push ()
+ (when (magit-topgit-in-topic-p)
+ (let* ((branch (or (magit-get-current-branch)
+ (error "Don't push a detached head. That's gross")))
+ (remote (magit-get "topgit" "remote"))
+ (push-remote (if (or current-prefix-arg (not remote))
+ (magit-read-remote (format "Push %s to" branch))
+ remote)))
+ (when (and (not remote)
+ (not current-prefix-arg))
+ (magit-set push-remote "topgit" "remote"))
+ (magit-run magit-topgit-executable "push" "-r" push-remote))
+ t))
+
+(defun magit-topgit-remote-update (&optional remote)
+ (when (magit-topgit-in-topic-p)
+ (let* ((remote (magit-get "topgit" "remote"))
+ (remote-update (if (or current-prefix-arg (not remote))
+ (magit-read-remote)
+ remote)))
+ (if (and (not remote)
+ (not current-prefix-arg))
+ (progn
+ (magit-set remote-update "topgit" "remote")
+ (magit-run magit-topgit-executable "remote"
+ "--populate" remote-update)))
+ (magit-run magit-topgit-executable "remote" remote-update))
+ ;; We return nil anyway, as we also want regular "git remote update" to
+ ;; happen
+ nil))
+
+(defun magit-topgit-parse-flags (flags-string)
+ (let ((flags (string-to-list flags-string))
+ (void-flag ?\ ))
+ (list :current (not (eq (nth 0 flags) void-flag))
+ :empty (not (eq (nth 1 flags) void-flag)))))
+
+(defun magit-topgit-wash-topic ()
+ (let ((fmt "^\\(.\\{7\\}\\)\\s-\\(\\S-+\\)\\s-+\\(.*\\)"))
+ (if (search-forward-regexp fmt (line-end-position) t)
+ (let ((flags (magit-topgit-parse-flags (match-string 1)))
+ (topic (match-string 2)))
+ (goto-char (line-beginning-position))
+ (delete-char 8)
+ (insert "\t")
+ (goto-char (line-beginning-position))
+ (magit-with-section topic 'topic
+ (magit-set-section-info topic)
+ (let ((beg (1+ (line-beginning-position)))
+ (end (line-end-position)))
+ (when (plist-get flags :current)
+ (put-text-property beg end 'face 'magit-topgit-current))
+ (when (plist-get flags :empty)
+ (put-text-property beg end 'face `(:strike-through t :inherit ,(get-text-property beg 'face)))))
+ (forward-line)))
+ (delete-region (line-beginning-position) (1+ (line-end-position))))
+ t))
+
+(defun magit-topgit-wash-topics ()
+ (let ((magit-old-top-section nil))
+ (magit-wash-sequence #'magit-topgit-wash-topic)))
+
+(defun magit-topgit-section (section title washer &rest args)
+ (when (executable-find magit-topgit-executable)
+ (let ((magit-git-executable magit-topgit-executable)
+ (magit-git-standard-options nil))
+ (apply 'magit-git-section section title washer args))))
+
+(magit-define-inserter topics ()
+ (magit-topgit-section 'topics
+ "Topics:" 'magit-topgit-wash-topics
+ "summary"))
+
+(magit-add-action (item info "discard")
+ ((topic)
+ (when (yes-or-no-p "Discard topic? ")
+ (magit-run* (list magit-topgit-executable "delete" "-f" info)
+ nil nil nil t))))
+
+(magit-add-action (item info "visit")
+ ((topic)
+ (magit-checkout info)))
+
+(defun magit-topgit-get-top-bases-color (suffix)
+ (list nil nil))
+
+(defun magit-topgit-get-remote-top-bases-color (suffix)
+ (when (string-match "^\\(?:[^/]+\\)/top-bases" suffix)
+ (list nil nil)))
+
+(defconst magit-topgit-ignored-namespace
+ '("top-bases" magit-topgit-get-top-bases-color))
+
+;;;###autoload
+(define-minor-mode magit-topgit-mode "Topgit support for Magit"
+ :lighter " Topgit" :require 'magit-topgit
+ (or (derived-mode-p 'magit-mode)
+ (error "This mode only makes sense with magit"))
+ (if magit-topgit-mode
+ (progn
+ (add-hook 'magit-after-insert-stashes-hook 'magit-insert-topics nil t)
+ (add-hook 'magit-create-branch-command-hook 'magit-topgit-create-branch nil t)
+ (add-hook 'magit-pull-command-hook 'magit-topgit-pull nil t)
+ (add-hook 'magit-remote-update-command-hook 'magit-topgit-remote-update nil t)
+ (add-hook 'magit-push-command-hook 'magit-topgit-push nil t)
+ ;; hide refs for top-bases namespace in any remote
+ (add-hook 'magit-log-remotes-color-hook
+ 'magit-topgit-get-remote-top-bases-color)
+ ;; hide refs in the top-bases namespace, as they're not meant for the user
+ (add-to-list 'magit-refs-namespaces magit-topgit-ignored-namespace))
+ (progn
+ (remove-hook 'magit-after-insert-stashes-hook 'magit-insert-topics t)
+ (remove-hook 'magit-create-branch-command-hook 'magit-topgit-create-branch t)
+ (remove-hook 'magit-pull-command-hook 'magit-topgit-pull t)
+ (remove-hook 'magit-remote-update-command-hook 'magit-topgit-remote-update t)
+ (remove-hook 'magit-push-command-hook 'magit-topgit-push t)
+ (remove-hook 'magit-log-remotes-color-hook
+ 'magit-topgit-get-remote-top-bases-color)
+ (delete magit-topgit-ignored-namespace magit-refs-namespaces)))
+ (when (called-interactively-p 'any)
+ (magit-refresh)))
+
+;;;###autoload
+(defun turn-on-magit-topgit ()
+ "Unconditionally turn on `magit-topgit-mode'."
+ (magit-topgit-mode 1))
+
+(provide 'magit-topgit)
+;;; magit-topgit.el ends here
--- /dev/null
+;;; magit-wip.el --- git-wip plug-in for Magit
+
+;; Copyright (C) 2012 Jonas Bernoulli
+;; Copyright (C) 2012 Ryan C. Thompson
+
+;; Maintainer: Jonas Bernoulli <jonasNOSPAMbernoul.li>
+
+;; Magit is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+;;
+;; Magit is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
+;; License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with Magit. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This plug-in provides support for special work-in-progress refs.
+
+;; This requires the third-party git command "git wip" which is available
+;; from https://github.com/bartman/git-wip.
+
+;; The global mode `magit-wip-mode' provides highlighting of wip refs in
+;; Magit buffers while the local mode `magit-wip-save-mode' commits to
+;; such a ref when saving a file-visiting buffer.
+
+;; To enable `magit-wip-save-mode' enable `global-magit-wip-save-mode'
+;; and use the Magit extension mechanism to select the repositories in
+;; which you want to use a work-in-progress ref. Usually you also want
+;; to enable `magit-wip-mode'.
+;;
+;; (magit-wip-mode 1)
+;; (global-magit-wip-save-mode 1)
+;;
+;; $ git config --add magit.extension wip-save # or
+;; $ git config --global --add magit.extension wip-save
+
+;; Note that `global-magit-wip-save-mode' is the only mode that uses the
+;; extension mechanism for file-visiting buffers all other global modes
+;; making use of it to turn on local modes in Magit buffers.
+
+;;; Code:
+
+(require 'magit)
+(require 'format-spec)
+
+;;; Magit Wip Mode.
+
+(defface magit-log-head-label-wip
+ '((((class color) (background light))
+ :box t
+ :background "Grey95"
+ :foreground "LightSkyBlue3")
+ (((class color) (background dark))
+ :box t
+ :background "Grey07"
+ :foreground "LightSkyBlue4"))
+ "Face for git-wip labels shown in log buffer."
+ :group 'magit-faces)
+
+(defun magit-log-get-wip-color (suffix)
+ (list (concat "(WIP) " suffix)
+ 'magit-log-head-label-wip))
+
+(defconst magit-wip-refs-namespace
+ '("wip" magit-log-get-wip-color))
+
+;;;###autoload
+(define-minor-mode magit-wip-mode
+ "In Magit log buffers; give wip refs a special appearance."
+ :group 'magit
+ :global t
+ (if magit-wip-mode
+ (add-to-list 'magit-refs-namespaces magit-wip-refs-namespace 'append)
+ (setq magit-refs-namespaces
+ (delete magit-wip-refs-namespace magit-refs-namespaces))))
+
+;;; Magit Wip Save Mode.
+
+(defcustom magit-wip-commit-message "WIP %r"
+ "Commit message for git-wip commits.
+
+The following `format'-like specs are supported:
+%f the full name of the file being saved, and
+%r the name of the file being saved, relative to the repository root
+%g the root of the git repository."
+ :group 'magit
+ :type 'string)
+
+(defcustom magit-wip-echo-area-message "Wrote %f (wip)"
+ "Message shown in the echo area after creating a git-wip commit.
+
+The following `format'-like specs are supported:
+%f the full name of the file being saved, and
+%r the name of the file being saved, relative to the repository root.
+%g the root of the git repository."
+ :group 'magit
+ :type '(choice (const :tag "No message" nil) string))
+
+(defvar magit-wip-save-mode-lighter " Wip")
+
+;;;###autoload
+(define-minor-mode magit-wip-save-mode
+ "Magit support for committing to a work-in-progress ref.
+
+When this minor mode is turned on and a file is saved inside a writable
+git repository then it is also committed to a special work-in-progress
+ref."
+ :lighter magit-wip-save-mode-lighter
+ (if magit-wip-save-mode
+ (add-hook 'after-save-hook 'magit-wip-save-safe t t)
+ (remove-hook 'after-save-hook 'magit-wip-save-safe t)))
+
+;;;###autoload
+(define-globalized-minor-mode global-magit-wip-save-mode
+ magit-wip-save-mode turn-on-magit-wip-save
+ :group 'magit)
+
+(defun turn-on-magit-wip-save ()
+ (when (and (buffer-file-name)
+ (magit-get-top-dir default-directory)
+ (member "wip-save" (magit-get-all "magit.extension")))
+ (if (= (magit-git-exit-code "wip" "-h") 0)
+ (magit-wip-save-mode 1)
+ (message "Git command 'git wip' cannot be found"))))
+
+(defun magit-wip-save-safe ()
+ (condition-case err
+ (magit-wip-save)
+ (error
+ (message "Magit WIP got an error: %S" err))))
+
+(defun magit-wip-save ()
+ (let* ((top-dir (magit-get-top-dir default-directory))
+ (name (file-truename (buffer-file-name)))
+ (spec `((?r . ,(file-relative-name name top-dir))
+ (?f . ,(buffer-file-name))
+ (?g . ,top-dir))))
+ (when (and top-dir (file-writable-p top-dir))
+ (save-excursion ; kludge see https://github.com/magit/magit/issues/441
+ (magit-run-git "wip" "save"
+ (format-spec magit-wip-commit-message spec)
+ "--editor" "--" name))
+ (when magit-wip-echo-area-message
+ (message (format-spec magit-wip-echo-area-message spec))))))
+
+(provide 'magit-wip)
+;;; magit-wip.el ends here
--- /dev/null
+;;; 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 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 <marius.vollmerNOSPAMnokia.com>
+;; Former Maintainer: Phil Jackson <philNOSPAMshellarchive.co.uk>
+;; Maintenance Group: https://github.com/organizations/magit/teams/53130
+;; Currently composed of:
+;; - Phil Jackson
+;; - Peter J Weisberg
+;; - Yann Hodique
+;; - Rémi Vanicat
+;; Version: 1.2.0
+;; 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
+;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
+;; License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with Magit. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; 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
+(eval-and-compile
+ (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)
+ "gitk")
+ "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
+ 'magit-save-buffers-predicate-tree-only
+ "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
+ 'magit-default-tracking-name-remote-plus-branch
+ "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
+completion.
+
+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'
+
+ A'---B'---C'---D'
+ ^
+
+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.
+
+ A---B'---C'---D'
+ ^"
+ :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
+ '((t))
+ "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)
+ map))
+
+(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)
+ map))
+
+(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)
+ map))
+
+(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)
+ map))
+
+(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)
+ map))
+
+(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)
+ map))
+
+(defvar magit-bug-report-url
+ "http://github.com/magit/magit/issues")
+
+(defconst magit-version "1.2.0"
+ "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"
+ "%s\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
+
+(eval-and-compile
+ (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)
+ most-positive-fixnum
+ 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)
+ most-positive-fixnum
+ (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."
+ `(set-buffer-modified-p
+ (prog1 (buffer-modified-p)
+ (let ((buffer-undo-list t)
+ before-change-functions
+ after-change-functions)
+ ,@body)))))
+
+ (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)
+ (magit-refresh-all))
+
+(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)
+ 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)
+ choices)
+ predicate require-match initial-input hist def)))
+ (if (consp (first choices))
+ (or (cdr (assoc selected choices))
+ selected)
+ selected)))
+
+(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)
+ prompt)
+ choices predicate require-match initial-input hist def))
+
+(defun magit-completing-read (prompt choices &optional predicate require-match
+ initial-input hist def)
+ (funcall magit-completing-read-function prompt choices predicate require-match
+ initial-input hist def))
+
+(defun magit-use-region-p ()
+ (if (fboundp 'use-region-p)
+ (use-region-p)
+ (and transient-mark-mode mark-active)))
+
+(defun magit-goto-line (line)
+ "Like `goto-line' but doesn't set the mark."
+ (save-restriction
+ (widen)
+ (goto-char 1)
+ (forward-line (1- line))))
+
+(defun magit-trim-line (str)
+ (if (string= str "")
+ nil
+ (if (equal (elt str (- (length str) 1)) ?\n)
+ (substring str 0 (- (length str) 1))
+ str)))
+
+(defun magit-split-lines (str)
+ (if (string= str "")
+ nil
+ (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
+ cmd
+ nil (list t nil) nil
+ args)))))
+ (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)
+ (with-temp-buffer
+ (insert-file-contents file)
+ (let ((rev (nreverse (split-string (buffer-string) "\n"))))
+ (nreverse (if (equal (car rev) "")
+ (cdr rev)
+ rev))))))
+
+(defun magit-write-file-lines (file lines)
+ (with-temp-buffer
+ (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 "."))
+ "true"))
+
+(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))
+ 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)
+ entry)))
+ value))))
+ (setq result (append result sub)))))
+ dict)
+ result))
+
+(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)
+ (magit-remove-conflicts
+ (apply #'append
+ (mapcar (lambda (dir)
+ (mapcar #'(lambda (repo)
+ (cons (file-name-nondirectory repo)
+ repo))
+ (magit-list-repos* dir 0)))
+ dirs))))
+
+(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)
+ nil)))
+
+(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)))
+ (file-name-as-directory
+ (or (cdr (assoc reply repos))
+ (if (file-directory-p reply)
+ (expand-file-name reply)
+ (error "Not a repository or a directory: %s" reply)))))
+ (file-name-as-directory
+ (read-directory-name "Git repository: "
+ (or (magit-get-top-dir default-directory)
+ 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)
+ modifier))
+ ;; 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))))
+ rev)))
+
+(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]*\\)"
+ magit-current-indentation))))
+ (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)
+ commit))
+
+(defun magit-current-line ()
+ (buffer-substring-no-properties (line-beginning-position)
+ (line-end-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)
+ nil)))
+
+;;; 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))))
+ (t
+ (let ((fmt-ref (magit-format-ref ref)))
+ (when fmt-ref
+ (push (cons fmt-ref
+ (replace-regexp-in-string "^refs/heads/"
+ "" ref))
+ refs))))))))
+ (nreverse refs)))
+
+(defun magit-format-ref (ref)
+ "Convert fully-specified ref REF into its displayable form
+according to `magit-remote-ref-format'"
+ (cond
+ ((null ref)
+ nil)
+ ((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)"
+ "%s")
+ (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))
+ (with-temp-buffer
+ (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)))
+ 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)
+ nil
+ 'require-match
+ nil
+ 'magit-read-file-hist
+ (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 "")
+ nil
+ rev)))
+
+(defun magit-read-rev-range (op &optional def-beg def-end)
+ (let ((beg (magit-read-rev (format "%s start" op)
+ def-beg)))
+ (if (not beg)
+ nil
+ (save-match-data
+ (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 ".")
+ (magit-marked-commit)
+ rev))
+
+(defun magit-rev-range-to-git (range)
+ (or range
+ (error "No revision range specified"))
+ (if (stringp range)
+ 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 ".")
+ "mark"
+ (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)
+ 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
+ (mapcar
+ (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
+ needs-refresh-on-show)
+
+(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)
+ magit-old-top-section))))
+ (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)))
+ s))
+
+(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))
+ ,@body
+ (setf (magit-section-end ,s) (point))
+ (setf (magit-section-children ,s)
+ (nreverse (magit-section-children ,s)))
+ ,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)
+ section))
+
+(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))
+ flag))
+
+(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))
+ (erase-buffer)
+ (let ((magit-old-top-section magit-top-section))
+ (setq magit-top-section nil)
+ ,@body
+ (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)
+ top
+ (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)
+ section)
+ next)
+ (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)))
+ prev))
+
+(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)
+ magit-top-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-title-and-type))
+ (section-type (if (consp section-title-and-type)
+ (cdr section-title-and-type)
+ nil))
+ (section
+ (magit-with-section section-title section-type
+ (if buffer-title
+ (insert (propertize buffer-title 'face 'magit-section-title)
+ "\n"))
+ (setq body-beg (point))
+ (magit-cmd-insert cmd args)
+ (if (not (eq (char-before) ?\n))
+ (insert "\n"))
+ (if washer
+ (save-restriction
+ (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"))
+ section))
+
+(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
+ section-title-and-type
+ buffer-title
+ washer
+ magit-git-executable
+ (append magit-git-standard-options args)))
+
+(defun magit-goto-next-section ()
+ "Go to the next section."
+ (interactive)
+ (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."
+ (interactive)
+ (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."
+ (interactive)
+ (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."
+ (interactive)
+ (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)
+ (magit-goto-next-section))))
+
+(defun magit-goto-previous-sibling-section ()
+ "Go to the previous sibling section."
+ (interactive)
+ (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)
+ (magit-goto-parent-section))))
+
+(defun magit-goto-section (section)
+ (goto-char (magit-section-beginning section))
+ (cond
+ ((and magit-log-auto-more
+ (eq (magit-section-type section) 'longer))
+ (magit-log-show-more-entries)
+ (forward-line -1)
+ (magit-goto-next-section))
+ ((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))
+ (magit-refresh)
+ (let ((inhibit-read-only t)
+ (beg (save-excursion
+ (goto-char (magit-section-beginning section))
+ (forward-line)
+ (point)))
+ (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)))
+ 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."
+ (interactive)
+ (magit-section-hideshow nil))
+
+(defun magit-hide-section ()
+ "Hide current section."
+ (interactive)
+ (magit-section-hideshow t))
+
+(defun magit-collapse-section ()
+ "Hide all subsection of current section."
+ (interactive)
+ (magit-section-hideshow #'magit-section-collapse))
+
+(defun magit-expand-section ()
+ "Show all subsection of current section."
+ (interactive)
+ (magit-section-hideshow #'magit-section-expand))
+
+(defun magit-toggle-file-section ()
+ "Like `magit-toggle-section' but toggle at file granularity."
+ (interactive)
+ (when (eq 'hunk (first (magit-section-context-type (magit-current-section))))
+ (magit-goto-parent-section))
+ (magit-toggle-section))
+
+(defun magit-toggle-section ()
+ "Toggle hidden status of current section."
+ (interactive)
+ (magit-section-hideshow
+ (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."
+ (interactive)
+ (magit-section-hideshow
+ (lambda (s)
+ (cond ((magit-section-any-hidden s)
+ (magit-section-expand-all s))
+ (t
+ (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."
+ (interactive)
+ (magit-section-hideshow
+ (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))
+ (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."
+ (magit-with-refresh
+ (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."
+ (interactive)
+ (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"
+ (interactive)
+ (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 ()
+ ,doc
+ (interactive)
+ (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."
+ `(progn
+ (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)))
+ `(progn
+ (defun ,fun ()
+ ,doc
+ (interactive)
+ (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)))
+ `(progn
+ (defvar ,before nil)
+ (defvar ,after nil)
+ (defun ,fun ,arglist
+ ,doc
+ (run-hooks ',before)
+ ,@body
+ (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)
+ magit-diff-refine-hunk
+ (not (eq magit-diff-refine-hunk 'all)))
+ ;; Refine the current hunk to show fine details, using
+ ;; diff-mode machinery.
+ (save-excursion
+ (goto-char (magit-section-beginning magit-highlighted-section))
+ (diff-refine-hunk))))))
+
+(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)
+ magit-diff-refine-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))
+ (progn
+ (magit-refine-section section)
+ (move-overlay magit-highlight-overlay
+ (magit-section-beginning section)
+ (magit-section-end section)
+ (current-buffer)))
+ (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
+lists.
+
+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.
+
+HEAD is (SECTION INFO &optional OPNAME),
+ 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))
+ t))
+ (let ((prefix (reverse (car clause)))
+ (body (cdr clause)))
+ `((magit-prefix-p ',prefix ,context)
+ (or (progn ,@body)
+ t)))))
+ clauses)
+ ,@(when opname
+ `(((run-hook-with-args-until-success
+ ',(intern (format "magit-%s-action-hook" opname))))
+ ((not ,type)
+ (error "Nothing to %s here" ,opname))
+ (t
+ (error "Can't %s a %s"
+ ,opname
+ (or (get ,type 'magit-description)
+ ,type)))))))))
+
+(defmacro magit-section-action (head &rest clauses)
+ (declare (indent 1))
+ `(magit-with-refresh
+ (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 ()
+ ,(macroexpand
+ ;; 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)
+ ,@clauses))))))
+
+(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)]
+ def-body)))
+ (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))))
+ `(progn
+ (defvar ,hook nil)
+ (defun ,fun ,arglist
+ ,doc
+ ,inter
+ (or (run-hook-with-args-until-success
+ ',hook ,@(remq '&optional (remq '&rest arglist)))
+ ,@instr))
+ (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) "")))
+ (save-excursion
+ (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)
+ comps)
+ (setq comps (nthcdr (+ (length magit-git-standard-options) 1) comps)))
+ (cond ((or (null (cdr comps))
+ (not (member (car comps) '("remote"))))
+ (car comps))
+ (t
+ (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-set-mode-line-process
+ (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
+ (bury-buffer))))
+ (setq buffer-read-only t)
+ (let ((inhibit-read-only t))
+ (setq default-directory dir)
+ (if noerase
+ (goto-char (point-max))
+ (erase-buffer))
+ (insert "$ " (or logline
+ (mapconcat 'identity cmd-and-args " "))
+ "\n")
+ (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)
+ (run-with-timer
+ magit-process-popup-time nil
+ (function
+ (lambda (buf)
+ (with-current-buffer buf
+ (when magit-process
+ (display-buffer (process-buffer magit-process))
+ (goto-char (point-max))))))
+ (current-buffer))))
+ (setq successp t))
+ (input
+ (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))
+ (t
+ (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
+ noerror
+ (error
+ "%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
+ 'magit-display-process))))
+ magit-process-buffer-name))
+ successp)))
+
+(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
+ 'magit-display-process))))))
+ (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
+ (concat
+ (read-string (format "Username for '%s': "
+ (match-string 1 string))
+ nil nil (user-login-name))
+ "\n"))))
+
+(defun magit-process-filter (proc string)
+ (save-current-buffer
+ (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))))
+ (t
+ (insert string))))
+ (set-marker (process-mark proc) (point)))))
+
+(defun magit-run (cmd &rest args)
+ (magit-with-refresh
+ (magit-run* (cons cmd args))))
+
+(defun magit-run-git (&rest args)
+ (magit-with-refresh
+ (magit-run* (append (cons magit-git-executable
+ magit-git-standard-options)
+ args))))
+
+(defun magit-run-git-with-input (input &rest args)
+ (magit-with-refresh
+ (magit-run* (append (cons magit-git-executable
+ magit-git-standard-options)
+ args)
+ 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
+ magit-git-standard-options)
+ args)
+ 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."
+ (interactive)
+ (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"
+ '("Magit"
+ ["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]
+ ("Log"
+ ["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]
+ ("Rewrite"
+ ["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"
+ ["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])
+ "---"
+ ("Extensions")
+ "---"
+ ["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)))
+ pos)
+
+(defun magit-invisible-region-start (pos)
+ (while (and (not (= pos (point-min))) (invisible-p pos))
+ (setq pos (1- (previous-char-property-change pos))))
+ 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
+adjustments.
+
+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))
+ end))))
+ (setq disable-point-adjustment t))
+
+(defun magit-post-command-hook ()
+ (magit-correct-point-after-command)
+ (magit-highlight-section))
+
+(defun magit-mode ()
+ "Review the status of a git repository and act on it.
+
+Please see the manual for a complete description of Magit.
+
+\\{magit-mode-map}"
+ (kill-all-local-variables)
+ (buffer-disable-undo)
+ (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)
+ (magit-refresh-buffer))
+
+(defun magit-indentation-for (dir)
+ (let (result)
+ (dolist (pair magit-highlight-indentation)
+ (if (string-match-p (car pair) dir)
+ (setq result (cdr pair))))
+ result))
+
+(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)
+ default-directory
+ (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)))))
+ (beginning-of-line)
+ (let ((section-line (and old-section
+ (count-lines
+ (magit-section-beginning old-section)
+ (point))))
+ (line-char (- old-point (point))))
+ (if magit-refresh-function
+ (apply magit-refresh-function
+ magit-refresh-args))
+ (magit-refresh-marked-commits-in-buffer)
+ (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))
+ (t
+ (magit-goto-line old-line)))
+ (dolist (w (get-buffer-window-list (current-buffer)))
+ (set-window-point w (point)))
+ (magit-highlight-section))))))
+
+(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
+ (vc-find-file-hook)
+ (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))
+ (unwind-protect
+ (funcall func)
+ (when magit-refresh-needing-buffers
+ (magit-revert-buffers dir)
+ (dolist (b (adjoin status-buffer
+ magit-refresh-needing-buffers))
+ (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."
+ (interactive)
+ (magit-with-refresh
+ (magit-need-refresh)))
+
+(defun magit-refresh-all ()
+ "Refresh all magit buffers to match respective repository states.
+Also revert every unmodified buffer visiting files
+in the corresponding directories."
+ (interactive)
+ (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"))
+ t)
+ nil))
+
+(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
+ "Untracked files:"
+ magit-wash-untracked-files
+ "ls-files" "--others" "-t" "--exclude-standard"
+ ,@(when magit-omit-untracked-dir-contents
+ '("--directory"))))))
+
+;;; 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)))
+ (magit-refresh))
+
+(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))
+ (magit-refresh))
+
+(defun magit-diff-default-hunks ()
+ "Reset context for diff hunks to the default size."
+ (interactive "")
+ (setq magit-diff-context-lines 3)
+ (magit-refresh))
+
+(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)
+ (new
+ (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))
+ (magit-refresh))))
+
+(defun magit-diff-line-file ()
+ (cond ((looking-at "^diff --git ./\\(.*\\) ./\\(.*\\)$")
+ (match-string-no-properties 2))
+ ((looking-at "^diff --cc +\\(.*\\)$")
+ (match-string-no-properties 1))
+ (t
+ nil)))
+
+(defun magit-wash-diffs ()
+ (magit-wash-sequence #'magit-wash-diff-or-other-file))
+
+(defun magit-wash-diff-or-other-file ()
+ (or (magit-wash-diff)
+ (magit-wash-other-file)))
+
+(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"))
+ t)
+ nil))
+
+(defvar magit-hide-diffs nil)
+
+(defvar magit-indentation-level 1)
+
+(defun magit-insert-diff-title (status file file2)
+ (let ((status-text (case status
+ ((unmerged)
+ (format "Unmerged %s" file))
+ ((new)
+ (format "New %s" file))
+ ((deleted)
+ (format "Deleted %s" file))
+ ((renamed)
+ (format "Renamed %s (from %s)"
+ file file2))
+ ((modified)
+ (format "Modified %s" file))
+ ((typechange)
+ (format "Typechange %s" file))
+ (t
+ (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")
+ (beginning-of-line)
+ (point-marker))))
+ (let ((magit-indentation-level (+ magit-indentation-level 1)))
+ (save-restriction
+ (narrow-to-region first-start second-start)
+ (goto-char (point-min))
+ (magit-with-section file 'diff
+ (magit-wash-diff-section)))
+ (save-restriction
+ (narrow-to-region second-start (point-max))
+ (goto-char (point-min))
+ (magit-with-section file 'diff
+ (magit-wash-diff-section))))))
+
+(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))
+ t))
+ ((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)))
+ (point-marker))))
+ (let* ((status (cond
+ ((looking-at "^diff --cc")
+ 'unmerged)
+ ((save-excursion
+ (search-forward-regexp "^new file" end t))
+ 'new)
+ ((save-excursion
+ (search-forward-regexp "^deleted" end t))
+ 'deleted)
+ ((save-excursion
+ (search-forward-regexp "^rename" end t))
+ 'renamed)
+ (t
+ 'modified)))
+ (file2 (cond
+ ((save-excursion
+ (search-forward-regexp "^rename from \\(.*\\)"
+ end t))
+ (match-string-no-properties 1)))))
+ (magit-set-section-info (list status
+ file
+ (or file2 file)
+ magit-current-diff-range))
+ (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))))
+ t)
+ (t
+ nil)))
+
+(defun magit-wash-diff ()
+ (let ((magit-section-hidden-default magit-hide-diffs))
+ (magit-with-section (magit-current-line) 'diff
+ (magit-wash-diff-section))))
+
+(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))
+ (forward-line)
+ (while (not (or (eobp)
+ (looking-at "^diff\\|^@@")))
+ (magit-highlight-line-whitespace)
+ (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))
+ (t
+ (magit-put-line-property 'face 'magit-diff-none))))
+ (forward-line)))
+
+ (when (eq magit-diff-refine-hunk 'all)
+ (save-excursion
+ (goto-char hunk-start-pos)
+ (diff-refine-hunk))))
+ t)
+ (t
+ nil)))
+
+(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))
+ magit-diff-options
+ (list "--" file))))
+ (let ((p (point)))
+ (magit-git-insert args)
+ (if (not (eq (char-before) ?\n))
+ (insert "\n"))
+ (save-restriction
+ (narrow-to-region p (point))
+ (goto-char p)
+ (cond
+ ((eq status 'typechange)
+ (magit-insert-diff-title status file file)
+ (magit-wash-typechange-section file))
+ (t
+ (magit-wash-diff-section)))
+ (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)))))
+ t)
+ 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"))
+ diff))
+
+(defun magit-diff-item-insert-header (diff buf)
+ (let ((beg (save-excursion
+ (goto-char (magit-section-beginning diff))
+ (forward-line)
+ (point)))
+ (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))
+ (forward-line)
+ (point)))
+ (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)
+ buf))
+
+(defun magit-insert-hunk-item-region-patch (hunk reverse beg end buf)
+ (magit-diff-item-insert-header (magit-hunk-item-diff hunk) buf)
+ (save-excursion
+ (goto-char (magit-section-beginning hunk))
+ (magit-insert-current-line buf)
+ (forward-line)
+ (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))))))
+ (forward-line))))
+ (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)
+ (save-excursion
+ (beginning-of-line)
+ (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))))
+ (forward-line)
+ (while (< (line-number-at-pos) line)
+ ;; XXX - deal with combined diffs
+ (if (not (looking-at "-"))
+ (setq target (+ target 1)))
+ (forward-line))
+ target))))
+
+(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))))))
+ (cond
+ ((eq commit 'index)
+ (let ((checkout-string (magit-git-string "checkout-index"
+ "--temp"
+ filename)))
+ (string-match "^\\(.*\\)\t" checkout-string)
+ (with-current-buffer buffer
+ (let ((tmpname (match-string 1 checkout-string)))
+ (magit-with-silent-modifications
+ (insert-file-contents tmpname nil nil nil t))
+ (delete-file tmpname)))))
+ (t
+ (with-current-buffer buffer
+ (magit-with-silent-modifications
+ (magit-git-insert (list "cat-file" "-p"
+ (concat commit ":" filename)))))))
+ (with-current-buffer buffer
+ (let ((buffer-file-name filename))
+ (normal-mode))
+ (goto-char (point-min)))
+ (if select
+ (if prefix
+ (switch-to-buffer buffer)
+ (switch-to-buffer-other-window buffer))
+ 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)))
+ (unwind-protect
+ (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
+ (magit-insert-hunk-item-region-patch
+ 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
+ "diff-files"))))
+
+(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")
+ "HEAD")))
+ (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"
+ base))))))
+
+;;; Logs and Commits
+
+ ; Note: making this a plain defcustom would probably let users break
+ ; the parser too easily
+(defvar magit-git-log-options
+ (list
+ "--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
+ (concat
+ "\\(?:HEAD\\|"
+
+ "\\(?:tag: \\)?"
+
+ ;; optional non-slash sequence at the beginning
+ magit-ref-nonslash-re
+
+ ;; any number of slash-prefixed sequences
+ "\\(?:"
+ "/"
+ magit-ref-nonslash-re
+ "\\)*"
+
+ "/" ;; "must contain at least one /." (rule 2)
+ magit-ref-nonslash-re
+
+ ;; "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
+ (concat
+ "^\\([_\\*|/ -.]+\\)?" ; graph (1)
+ "\\(?:"
+ "\\([0-9a-fA-F]+\\)" ; sha1 (2)
+ "\\(?:" ; refs (3)
+ " "
+ "\\("
+ "("
+ magit-refname-re "\\(?:, " magit-refname-re "\\)*"
+ ")"
+ "\\)"
+ "\\)?"
+ "\\)?"
+ " ?\\(.*\\)$" ; msg (4)
+ ))
+
+(defconst magit-log-longline-re
+ (concat
+ ;; use \0 delimiter (from -z option) to identify commits. this prevents
+ ;; commit messages containing lines like "commit 00000" from polluting the
+ ;; display
+ "\\(?:\\(?:\\`\\|\0\\)"
+ "\\([_\\*|/ -.]+\\)?" ; 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))
+ 'magit-log-head-label-patches))
+
+(defvar magit-log-remotes-color-hook nil)
+
+(defun magit-log-get-remotes-color (suffix)
+ (or
+ (run-hook-with-args-until-success
+ '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)
+ magit-refs-namespaces))))
+ (cond ((null colorizer)
+ (list r 'magit-log-head-label-default))
+ ((symbolp colorizer)
+ (list label colorizer))
+ ((listp colorizer)
+ (funcall (car colorizer)
+ (match-string 2 r)))
+ (t
+ (list r 'magit-log-head-label-default))))))
+ res))))
+
+(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))))
+ refs))))
+ (concat
+ (mapconcat 'identity colored-labels " ")
+ " ")))))
+
+ (concat
+ (if sha1
+ (propertize sha1 'face 'magit-log-sha1)
+ (insert-char ? magit-sha1-abbrev-length))
+ " "
+ (when graph
+ (propertize graph 'face 'magit-log-graph))
+ string-refs
+ (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-create-buffer-sections
+ (magit-with-section 'log nil
+ ,@body
+ (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)
+ (beginning-of-line)
+ (let ((line-re (cond ((eq style 'long) magit-log-longline-re)
+ (t magit-log-oneline-re))))
+ (cond
+ ((looking-at line-re)
+ (let ((chart (match-string 1))
+ (sha1 (match-string 2))
+ (msg (match-string 4))
+ (refs (when (match-string 3)
+ (delq nil
+ (mapcar
+ (lambda (s)
+ (and (not
+ (or (string= s "tag:")
+ (string= s "HEAD"))) ; as of 1.6.6
+ s))
+ (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)
+ (forward-line))
+ (forward-line))))
+ (t
+ (forward-line)))
+ t))
+
+(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)))
+ (cond
+ ((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))
+ magit-current-diff-range))
+ (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)))
+ (t
+ (setq magit-current-diff-range (cons (concat magit-current-diff-range "^")
+ 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)))))
+ (beginning-of-line)
+ (when (looking-at "^diff")
+ (magit-wash-diffs))
+ (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)
+ (save-excursion
+ (goto-char button)
+ (magit-visit-item)))
+ 'follow-link t
+ 'mouse-face 'magit-item-highlight
+ 'face 'magit-log-sha1))
+
+(defun magit-refresh-commit-buffer (commit)
+ (magit-configure-have-abbrev)
+ (magit-configure-have-decorate)
+ (magit-create-buffer-sections
+ (apply #'magit-git-section nil nil
+ 'magit-wash-commit
+ "log"
+ "--max-count=1"
+ "--pretty=medium"
+ `(,@(if magit-have-abbrev (list "--no-abbrev-commit"))
+ ,@(if magit-have-decorate (list "--decorate=full"))
+ "--cc"
+ "-p" ,commit))))
+
+(define-derived-mode magit-commit-mode magit-mode "Magit"
+ "Mode to view a git commit.
+
+\\{magit-commit-mode-map}"
+ :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)))
+ (cond
+ ((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))
+ (scroll
+ (with-selected-window win
+ (funcall scroll))))))
+ (commit
+ (display-buffer buf)
+ (with-current-buffer buf
+ (unless inhibit-history
+ (push (cons default-directory magit-currently-shown-commit)
+ magit-back-navigation-history)
+ (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
+`magit-commit-buffer-name`."
+ (interactive)
+ (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)
+ magit-forward-navigation-history)
+ (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
+`magit-commit-buffer-name`."
+ (interactive)
+ (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)
+ magit-back-navigation-history)
+ (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)
+ (magit-for-all-sections
+ (lambda (section)
+ (when (and (eq (magit-section-type section) 'commit)
+ (equal (magit-section-info section)
+ magit-marked-commit))
+ (move-overlay magit-mark-overlay
+ (magit-section-beginning section)
+ (magit-section-end section)
+ (current-buffer))))))
+
+(defun magit-set-marked-commit (commit)
+ (setq magit-marked-commit commit)
+ (magit-refresh-marked-commits))
+
+(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 ".")
+ branch
+ (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
+ (list
+ (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
+ (list
+ (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
+FULLY-QUALIFIED-NAME is non-nil."
+ (let ((merge (magit-get "branch" local-branch "merge")))
+ (save-match-data
+ (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)
+ "refs/heads/"
+ (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)
+ (cond
+ ((string= "." remote)
+ (concat
+ (when remote-rebase "onto ")
+ "branch "
+ (propertize remote-branch 'face 'magit-branch)))
+ (remote
+ (concat
+ (when remote-rebase "onto ")
+ (propertize remote-branch 'face 'magit-branch)
+ " @ "
+ remote
+ " ("
+ (magit-get "remote" remote "url")
+ ")"))
+ (t
+ (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-create-buffer-sections
+ (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
+ "log"
+ "--max-count=1"
+ "--abbrev-commit"
+ (format "--abbrev=%s" magit-sha1-abbrev-length)
+ "--pretty=oneline"))
+ (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)
+ "MERGE_HEAD"))))
+ (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-stashes)
+ (magit-insert-untracked-files)
+ (magit-insert-pending-changes)
+ (magit-insert-pending-commits)
+ (magit-insert-unpulled-commits remote remote-branch)
+ (let ((staged (or no-commit (magit-anything-staged-p))))
+ (magit-insert-unstaged-changes
+ (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)
+ (yes-or-no-p
+ (format
+ (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.
+
+\\{magit-status-mode-map}"
+ :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."
+ (interactive)
+ (let ((predicate-function (or pred magit-save-some-buffers-predicate))
+ (magit-default-directory default-directory))
+ (if magit-save-some-buffers
+ (save-some-buffers
+ (eq magit-save-some-buffers 'dontask)
+ predicate-function)
+ (when msg
+ (message msg)))))
+
+(defun magit-save-buffers-predicate-all ()
+ "Prompt to save all buffers with unsaved changes"
+ t)
+
+(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)))))
+
+;;;###autoload
+(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
+ (magit-read-top-dir
+ (> (prefix-numeric-value current-prefix-arg)
+ 4))
+ (or (magit-get-top-dir default-directory)
+ (magit-read-top-dir nil)))))
+ (magit-save-some-buffers)
+ (let ((topdir (magit-get-top-dir dir)))
+ (unless topdir
+ (when (y-or-n-p (format "There is no Git repository in %S. Create one? "
+ dir))
+ (magit-init dir)
+ (setq topdir (magit-get-top-dir dir))))
+ (when topdir
+ (let ((buf (or (magit-find-status-buffer topdir)
+ (generate-new-buffer
+ (concat "*magit: "
+ (file-name-nondirectory
+ (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)
+ magit-custom-options)
+ (when (file-exists-p ".git/MERGE_MSG")
+ (magit-log-edit))))
+
+;;; 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))
+ ((untracked)
+ (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)
+ (save-excursion
+ (magit-goto-parent-section)
+ (magit-stage-item)))
+ ((diff diff hunk)
+ (save-excursion
+ (magit-goto-parent-section)
+ (magit-goto-parent-section)
+ (magit-stage-item)))
+ ((hunk)
+ (error "Can't stage this hunk"))
+ ((diff)
+ (error "Can't stage this diff")))))
+
+(defun magit-unstage-item ()
+ "Remove the item at point from the staging area."
+ (interactive)
+ (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)
+ (save-excursion
+ (magit-goto-parent-section)
+ (magit-unstage-item)))
+ ((diff diff hunk)
+ (save-excursion
+ (magit-goto-parent-section)
+ (magit-goto-parent-section)
+ (magit-unstage-item)))
+ ((hunk)
+ (error "Can't unstage this hunk"))
+ ((diff)
+ (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')."
+ (interactive)
+ (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)
+ nil
+ nil
+ default-name)))
+ (when (magit-ref-exists-p (concat "refs/heads/" chosen-name))
+ (error "'%s' already exists." chosen-name))
+ chosen-name)))
+
+(defun magit-maybe-create-local-tracking-branch (rev)
+ "Depending on the users wishes, create a tracking branch for
+rev... maybe."
+ (if (string-match "^\\(?:refs/\\)?remotes/\\([^/]+\\)/\\(.+\\)" rev)
+ (let* ((remote (match-string 1 rev))
+ (branch (match-string 2 rev))
+ (tracker-name (magit-get-tracking-name remote branch)))
+ (when tracker-name
+ (magit-run-git "checkout" "-b" tracker-name rev)
+ t))
+ nil))
+
+(magit-define-command checkout (revision)
+ "Switch 'HEAD' to REVISION and update working tree.
+Fails if working tree or staging area contain uncommitted changes.
+If REVISION is a remote branch, offer to create a local tracking branch.
+\('git checkout [-b] REVISION')."
+ (interactive
+ (list (let ((current-branch (magit-get-current-branch))
+ (default (magit-default-rev)))
+ (magit-read-rev "Switch to"
+ (unless (string= current-branch default)
+ default)
+ (if current-branch
+ (cons (concat "refs/heads/" current-branch "$")
+ magit-uninteresting-refs)
+ magit-uninteresting-refs)))))
+ (if revision
+ (when (not (magit-maybe-create-local-tracking-branch revision))
+ (magit-save-some-buffers)
+ (magit-run-git "checkout" (magit-rev-to-git revision))
+ (magit-update-vc-modeline default-directory))))
+
+(defun magit-read-create-branch-args ()
+ (let* ((cur-branch (magit-get-current-branch))
+ (cur-point (magit-default-rev))
+ (branch (read-string "Create branch: "))
+ (parent (magit-read-rev "Parent"
+ (cond
+ ((eq magit-create-branch-behaviour 'at-point) cur-point)
+ ((eq magit-create-branch-behaviour 'at-head) cur-branch)
+ (t cur-branch)))))
+ (list branch parent)))
+
+(magit-define-command create-branch (branch parent)
+ "Switch 'HEAD' to new BRANCH at revision PARENT and update working tree.
+Fails if working tree or staging area contain uncommitted changes.
+\('git checkout -b BRANCH REVISION')."
+ (interactive (magit-read-create-branch-args))
+ (when (and branch (not (string= branch ""))
+ parent)
+ (magit-save-some-buffers)
+ (magit-run-git "checkout" "-b"
+ branch
+ (append
+ magit-custom-options
+ (magit-rev-to-git parent)))
+ (magit-update-vc-modeline default-directory)))
+
+(defun magit-delete-branch (branch &optional force)
+ "Deletes a branch.
+If the branch is the current one, offers to switch to `master' first.
+With prefix, forces the removal even if it hasn't been merged.
+Works with local or remote branches.
+\('git branch [-d|-D] BRANCH' or 'git push <remote-part-of-BRANCH> :refs/heads/BRANCH')."
+ (interactive (list (magit-read-rev "Branch to delete" (magit-default-rev 'notrim))
+ current-prefix-arg))
+ (let* ((remote (magit-remote-part-of-branch branch))
+ (is-current (string= branch (magit-get-current-branch)))
+ (args (list "branch"
+ (if force "-D" "-d")
+ branch)))
+ (cond
+ (remote
+ (magit-run-git "push" remote (concat ":refs/heads/" (magit-branch-no-remote branch))))
+ (is-current
+ (when (y-or-n-p "Cannot delete current branch. Switch to master first? ")
+ (progn
+ (magit-checkout "master")
+ (apply 'magit-run-git args))
+ (message "The current branch was not deleted.")))
+ (t
+ (apply 'magit-run-git args)))))
+
+(defun magit-move-branch (old new &optional force)
+ "Renames or moves a branch.
+With prefix, forces the move even if NEW already exists.
+\('git branch [-m|-M] OLD NEW')."
+ (interactive (list (magit-read-rev "Old name" (magit-default-rev))
+ (read-string "New name: ")
+ current-prefix-arg))
+ (magit-run-git "branch" (if force
+ "-M"
+ "-m")
+ (magit-rev-to-git old) new))
+
+(defun magit-guess-branch ()
+ (magit-section-case (item info)
+ ((branch)
+ (magit-section-info (magit-current-section)))
+ ((wazzup commit)
+ (magit-section-info (magit-section-parent item)))
+ ((commit) (magit-name-rev (substring info 0 magit-sha1-abbrev-length)))
+ ((wazzup) info)))
+
+;;; Remotes
+
+(defun magit-add-remote (remote url)
+ "Adds a remote and fetches it.
+\('git remote add REMOTE URL')."
+ (interactive (list (read-string "Add remote: ")
+ (read-string "URL: ")))
+ (magit-run-git "remote" "add" "-f" remote url))
+
+(defun magit-remove-remote (remote)
+ "Deletes a remote.
+\('git remote rm REMOTE')."
+ (interactive (list (magit-read-remote "Remote to delete")))
+ (magit-run-git "remote" "rm" remote))
+
+(defun magit-rename-remote (old new)
+ "Renames a remote.
+\('git remote rename OLD NEW')."
+ (interactive (list (magit-read-remote "Old name")
+ (read-string "New name: ")))
+ (magit-run-git "remote" "rename" old new))
+
+(defun magit-guess-remote ()
+ (magit-section-case (item info)
+ ((branch)
+ (magit-section-info (magit-section-parent item)))
+ ((remote)
+ info)
+ (t
+ (if (string= info ".")
+ info
+ (magit-get-current-remote)))))
+
+;;; Merging
+
+(defun magit-merge (revision)
+ "Merge REVISION into the current 'HEAD'; leave changes uncommitted.
+With a prefix-arg, the merge will be squashed.
+\('git merge --no-commit [--squash|--no-ff] REVISION')."
+ (interactive
+ (list (magit-read-rev "Merge" (magit-default-rev))))
+ (if revision
+ (apply 'magit-run-git
+ "merge"
+ (magit-rev-to-git revision)
+ magit-custom-options)))
+
+;;; Rebasing
+
+(defun magit-rebase-info ()
+ "Returns a list indicating the state of an in-progress rebase,
+if any."
+ (let ((git-dir (magit-git-dir)))
+ (cond ((file-exists-p (concat git-dir "rebase-merge"))
+ (list
+ ;; The commit we're rebasing onto, i.e. git rebase -i <onto>
+ (magit-name-rev (car (magit-file-lines (concat git-dir "rebase-merge/onto"))))
+
+ ;; How many commits we've gone through
+ (length (magit-file-lines (concat git-dir "rebase-merge/done")))
+
+ ;; How many commits we have in total, without the comments
+ ;; at the end of git-rebase-todo.backup
+ (let ((todo-lines-with-comments (magit-file-lines (concat git-dir "rebase-merge/git-rebase-todo.backup"))))
+ (loop for i in todo-lines-with-comments
+ until (string= "" i)
+ count i))))
+ ((and (file-exists-p (concat git-dir "rebase-apply"))
+ (file-exists-p (concat git-dir "rebase-apply/onto")))
+ ;; we might be here because a non-interactive rebase failed: the
+ ;; patches didn't apply cleanly
+ (list
+ ;; The commit we're rebasing onto, i.e. git rebase -i <onto>
+ (magit-name-rev (car (magit-file-lines (concat git-dir "rebase-apply/onto"))))
+
+ ;; How many commits we've gone through
+ (- (string-to-number (car (magit-file-lines (concat git-dir "rebase-apply/next")))) 1)
+
+ ;; How many commits we have in total
+ (string-to-number (car (magit-file-lines (concat git-dir "rebase-apply/last"))))
+ ))
+ (t nil))))
+
+(defun magit-rebase-step ()
+ (interactive)
+ (let ((info (magit-rebase-info)))
+ (if (not info)
+ (let* ((current-branch (magit-get-current-branch))
+ (rev (magit-read-rev "Rebase to"
+ (magit-format-ref (magit-remote-branch-for current-branch t))
+ (if current-branch
+ (cons (concat "refs/heads/" current-branch)
+ magit-uninteresting-refs)
+ magit-uninteresting-refs))))
+ (if rev
+ (magit-run-git "rebase" (magit-rev-to-git rev))))
+ (let ((cursor-in-echo-area t)
+ (message-log-max nil))
+ (message "Rebase in progress. [A]bort, [S]kip, or [C]ontinue? ")
+ (let ((reply (read-event)))
+ (case reply
+ ((?A ?a)
+ (magit-run-git-async "rebase" "--abort"))
+ ((?S ?s)
+ (magit-run-git-async "rebase" "--skip"))
+ ((?C ?c)
+ (magit-run-git-async "rebase" "--continue"))))))))
+
+;;; Resetting
+
+(magit-define-command reset-head (revision &optional hard)
+ "Switch 'HEAD' to REVISION, keeping prior working tree and staging area.
+Any differences from REVISION become new changes to be committed.
+With prefix argument, all uncommitted changes in working tree
+and staging area are lost.
+\('git reset [--soft|--hard] REVISION')."
+ (interactive (list (magit-read-rev (format "%s head to"
+ (if current-prefix-arg
+ "Hard reset"
+ "Reset"))
+ (or (magit-default-rev)
+ "HEAD^"))
+ current-prefix-arg))
+ (when revision
+ (magit-run-git "reset" (if hard "--hard" "--soft")
+ (magit-rev-to-git revision))
+ (magit-update-vc-modeline default-directory)))
+
+(magit-define-command reset-head-hard (revision)
+ "Switch 'HEAD' to REVISION, losing all changes.
+Uncomitted changes in both working tree and staging area are lost.
+\('git reset --hard REVISION')."
+ (interactive (list (magit-read-rev (format "Hard reset head to")
+ (or (magit-default-rev)
+ "HEAD"))))
+ (magit-reset-head revision t))
+
+(magit-define-command reset-working-tree (&optional arg)
+ "Revert working tree and clear changes from staging area.
+\('git reset --hard HEAD').
+
+With a prefix arg, also remove untracked files. With two prefix args, remove ignored files as well."
+ (interactive "p")
+ (let ((include-untracked (>= arg 4))
+ (include-ignored (>= arg 16)))
+ (when (yes-or-no-p (format "Discard all uncommitted changes%s%s? "
+ (if include-untracked
+ ", untracked files"
+ "")
+ (if include-ignored
+ ", ignored files"
+ "")))
+ (magit-reset-head-hard "HEAD")
+ (if include-untracked
+ (magit-run-git "clean" "-fd" (if include-ignored
+ "-x"
+ ""))))))
+
+;;; Rewriting
+
+(defun magit-read-rewrite-info ()
+ (when (file-exists-p (concat (magit-git-dir) "magit-rewrite-info"))
+ (with-temp-buffer
+ (insert-file-contents (concat (magit-git-dir) "magit-rewrite-info"))
+ (goto-char (point-min))
+ (read (current-buffer)))))
+
+(defun magit-write-rewrite-info (info)
+ (with-temp-file (concat (magit-git-dir) "magit-rewrite-info")
+ (prin1 info (current-buffer))
+ (princ "\n" (current-buffer))))
+
+(magit-define-inserter pending-commits ()
+ (let* ((info (magit-read-rewrite-info))
+ (pending (cdr (assq 'pending info))))
+ (when pending
+ (magit-with-section 'pending nil
+ (insert (propertize "Pending commits:\n"
+ 'face 'magit-section-title))
+ (dolist (p pending)
+ (let* ((commit (car p))
+ (properties (cdr p))
+ (used (plist-get properties 'used)))
+ (magit-with-section commit 'commit
+ (magit-set-section-info commit)
+ (insert (magit-git-string
+ "log" "--max-count=1"
+ (if used
+ "--pretty=format:. %s"
+ "--pretty=format:* %s")
+ commit "--")
+ "\n")))))
+ (insert "\n"))))
+
+(defun magit-rewrite-set-commit-property (commit prop value)
+ (let* ((info (magit-read-rewrite-info))
+ (pending (cdr (assq 'pending info)))
+ (p (assoc commit pending)))
+ (when p
+ (setf (cdr p) (plist-put (cdr p) prop value))
+ (magit-write-rewrite-info info)
+ (magit-need-refresh))))
+
+(defun magit-rewrite-set-used ()
+ (interactive)
+ (magit-section-action (item info)
+ ((pending commit)
+ (magit-rewrite-set-commit-property info 'used t))))
+
+(defun magit-rewrite-set-unused ()
+ (interactive)
+ (magit-section-action (item info)
+ ((pending commit)
+ (magit-rewrite-set-commit-property info 'used nil))))
+
+(magit-define-inserter pending-changes ()
+ (let* ((info (magit-read-rewrite-info))
+ (orig (cadr (assq 'orig info))))
+ (when orig
+ (let ((magit-hide-diffs t))
+ (magit-git-section 'pending-changes
+ "Pending changes"
+ 'magit-wash-diffs
+ "diff" (magit-diff-U-arg) "-R" orig)))))
+
+(defun magit-rewrite-start (from &optional onto)
+ (interactive (list (magit-read-rev "Rewrite from" (magit-default-rev))))
+ (or (magit-everything-clean-p)
+ (error "You have uncommitted changes"))
+ (or (not (magit-read-rewrite-info))
+ (error "Rewrite in progress"))
+ (let* ((orig (magit-rev-parse "HEAD"))
+ (base
+ (if
+ (or
+ (eq magit-rewrite-inclusive t)
+ (and
+ (eq magit-rewrite-inclusive 'ask)
+ (y-or-n-p "Include selected revision in rewrite? ")))
+ (or
+ (car (magit-commit-parents from))
+ (error "Can't rewrite a parentless commit."))
+ from))
+ (pending (magit-git-lines "rev-list" (concat base ".."))))
+ (magit-write-rewrite-info `((orig ,orig)
+ (pending ,@(mapcar #'list pending))))
+ (magit-run-git "reset" "--hard" base)))
+
+(defun magit-rewrite-stop (&optional noconfirm)
+ (interactive)
+ (let* ((info (magit-read-rewrite-info)))
+ (or info
+ (error "No rewrite in progress"))
+ (when (or noconfirm
+ (yes-or-no-p "Stop rewrite? "))
+ (magit-write-rewrite-info nil)
+ (magit-refresh))))
+
+(defun magit-rewrite-abort ()
+ (interactive)
+ (let* ((info (magit-read-rewrite-info))
+ (orig (cadr (assq 'orig info))))
+ (or info
+ (error "No rewrite in progress"))
+ (or (magit-everything-clean-p)
+ (error "You have uncommitted changes"))
+ (when (yes-or-no-p "Abort rewrite? ")
+ (magit-write-rewrite-info nil)
+ (magit-run-git "reset" "--hard" orig))))
+
+(defun magit-rewrite-finish ()
+ (interactive)
+ (magit-with-refresh
+ (magit-rewrite-finish-step t)))
+
+(defun magit-rewrite-finish-step (first-p)
+ (let ((info (magit-read-rewrite-info)))
+ (or info
+ (error "No rewrite in progress"))
+ (let* ((pending (cdr (assq 'pending info)))
+ (first-unused
+ (let ((rpend (reverse pending)))
+ (while (and rpend (plist-get (cdr (car rpend)) 'used))
+ (setq rpend (cdr rpend)))
+ (car rpend)))
+ (commit (car first-unused)))
+ (cond ((not first-unused)
+ (magit-rewrite-stop t))
+ ((magit-apply-commit commit t (not first-p))
+ (magit-rewrite-set-commit-property commit 'used t)
+ (magit-rewrite-finish-step nil))))))
+
+;;; Updating, pull, and push
+
+(magit-define-command fetch (remote)
+ "Fetch from REMOTE."
+ (interactive (list (magit-read-remote)))
+ (apply 'magit-run-git-async "fetch" remote magit-custom-options))
+
+(magit-define-command fetch-current ()
+ "Run fetch for default remote.
+
+If there is no default remote, ask for one."
+ (interactive)
+ (magit-fetch (or (magit-get-current-remote)
+ (magit-read-remote))))
+
+(magit-define-command remote-update ()
+ "Update all remotes."
+ (interactive)
+ (apply 'magit-run-git-async "remote" "update" magit-custom-options))
+
+(magit-define-command pull ()
+ "Run git pull against the current remote."
+ (interactive)
+ (let* ((branch (magit-get-current-branch))
+ (branch-remote (magit-get-remote branch))
+ (config-branch (and branch (magit-get "branch" branch "merge")))
+ (merge-branch (or (and config-branch (not current-prefix-arg))
+ (magit-read-remote-branch
+ branch-remote (format "Pull from: ")))))
+ (when (and branch (not config-branch))
+ (magit-set branch-remote "branch" branch "remote")
+ (magit-set (format "refs/heads/%s" merge-branch)
+ "branch" branch "merge"))
+ (apply 'magit-run-git-async "pull" "-v" magit-custom-options)))
+
+(eval-when-compile (require 'eshell))
+
+(defun magit-parse-arguments (command)
+ (require 'eshell)
+ (with-temp-buffer
+ (insert command)
+ (mapcar 'eval (eshell-parse-arguments (point-min) (point-max)))))
+
+(defun magit-shell-command (command)
+ "Perform arbitrary shell COMMAND."
+ (interactive "sCommand: ")
+ (let ((args (magit-parse-arguments command))
+ (magit-process-popup-time 0))
+ (magit-run* args nil nil nil t)))
+
+(defvar magit-git-command-history nil)
+
+(defun magit-git-command (command)
+ "Perform arbitrary Git COMMAND.
+
+Similar to `magit-shell-command', but involves slightly less
+typing and automatically refreshes the status buffer."
+ (interactive
+ (list (read-string "Run git like this: " nil 'magit-git-command-history)))
+ (require 'pcomplete)
+ (let ((args (magit-parse-arguments command))
+ (magit-process-popup-time 0))
+ (magit-with-refresh
+ (magit-run* (append (cons magit-git-executable
+ magit-git-standard-options)
+ args)
+ nil nil nil t))))
+
+(magit-define-command push-tags ()
+ "Push tags."
+ (interactive)
+ (magit-run-git-async "push" "--tags"))
+
+(magit-define-command push ()
+ "Push the current branch to a remote repository.
+
+With no prefix argument, ask `magit-get-remote' what remote to
+use for this branch.
+
+With a prefix arg \(e.g., \\[universal-argument] \\[magit-push]), \
+ask user instead.
+
+With \\[universal-argument] \\[universal-argument] as prefix, \
+also prompt user for the remote branch;
+otherwise, try to use the branch.<name>.merge git-config(1)
+option, falling back to something hairy if that is unset."
+ (interactive)
+ (let* ((branch (or (magit-get-current-branch)
+ (error "Don't push a detached head. That's gross")))
+ (branch-remote (magit-get-remote branch))
+ (push-remote (if (or current-prefix-arg
+ (not branch-remote))
+ (magit-read-remote (format "Push %s to remote"
+ branch)
+ branch-remote)
+ branch-remote))
+ (ref-branch (or (and (>= (prefix-numeric-value current-prefix-arg) 16)
+ (magit-read-remote-branch
+ push-remote (format "Push %s as branch" branch)))
+ (magit-get "branch" branch "merge"))))
+ (if (and (not ref-branch)
+ (eq magit-set-upstream-on-push 'refuse))
+ (error "Not pushing since no upstream has been set.")
+ (let ((set-upstream-on-push (and (not ref-branch)
+ (or (eq magit-set-upstream-on-push 'dontask)
+ (and (eq magit-set-upstream-on-push t)
+ (yes-or-no-p "Set upstream while pushing? "))))))
+ (if (and (not branch-remote)
+ (not current-prefix-arg))
+ (magit-set push-remote "branch" branch "remote"))
+ (apply 'magit-run-git-async "push" "-v" push-remote
+ (if ref-branch
+ (format "%s:%s" branch ref-branch)
+ branch)
+ (if set-upstream-on-push
+ (cons "--set-upstream" magit-custom-options)
+ magit-custom-options))
+ ;; Although git will automatically set up the remote,
+ ;; it doesn't set up the branch to merge (at least as of Git 1.6.6.1),
+ ;; so we have to do that manually.
+ (unless ref-branch
+ (magit-set (concat "refs/heads/" branch) "branch" branch "merge"))))))
+
+;;; Log edit mode
+
+(defvar magit-log-edit-buffer-name "*magit-edit-log*"
+ "Buffer name for composing commit messages.")
+
+(defvar magit-log-edit-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "C-c C-c") 'magit-log-edit-commit)
+ (define-key map (kbd "C-x #") 'magit-log-edit-commit)
+ (define-key map (kbd "C-c C-a") 'magit-log-edit-toggle-amending)
+ (define-key map (kbd "C-c C-s") 'magit-log-edit-toggle-signoff)
+ (define-key map (kbd "C-c C-t") 'magit-log-edit-toggle-author)
+ (define-key map (kbd "C-c C-e") 'magit-log-edit-toggle-allow-empty)
+ (define-key map (kbd "M-p") 'log-edit-previous-comment)
+ (define-key map (kbd "M-n") 'log-edit-next-comment)
+ (define-key map (kbd "C-c C-k") 'magit-log-edit-cancel-log-message)
+ (define-key map (kbd "C-c C-]") 'magit-log-edit-cancel-log-message)
+ (define-key map (kbd "C-x C-s") (lambda ()
+ (interactive)
+ (message "Not saved. Use C-c C-c to finalize this commit message.")))
+ map))
+
+(defvar magit-pre-log-edit-window-configuration nil)
+
+(define-derived-mode magit-log-edit-mode text-mode "Magit Log Edit"
+ ;; Recognize changelog-style paragraphs
+ (set (make-local-variable 'paragraph-start)
+ (concat paragraph-start "\\|*\\|(")))
+
+(defun magit-log-edit-cleanup ()
+ (save-excursion
+ (goto-char (point-min))
+ (goto-char (point-min))
+ (if (re-search-forward "[ \t\n]*\\'" nil t)
+ (replace-match "\n" nil nil))))
+
+(defun magit-log-edit-append (str)
+ (with-current-buffer (get-buffer-create magit-log-edit-buffer-name)
+ (goto-char (point-max))
+ (insert str "\n")))
+
+(defconst magit-log-header-end "-- End of Magit header --\n")
+
+(defun magit-log-edit-get-fields ()
+ (let ((buf (get-buffer magit-log-edit-buffer-name))
+ (result nil))
+ (if buf
+ (with-current-buffer buf
+ (goto-char (point-min))
+ (while (looking-at "^\\([A-Za-z0-9-_]+\\): *\\(.+\\)?$")
+ (setq result (acons (intern (downcase (match-string 1)))
+ (read (or (match-string 2) "nil"))
+ result))
+ (forward-line))
+ (if (not (looking-at (regexp-quote magit-log-header-end)))
+ (setq result nil))))
+ (nreverse result)))
+
+(defun magit-log-edit-set-fields (fields)
+ (let ((buf (get-buffer-create magit-log-edit-buffer-name)))
+ (with-current-buffer buf
+ (goto-char (point-min))
+ (if (search-forward-regexp (format "^\\([A-Za-z0-9-_]+:.*\n\\)*%s"
+ (regexp-quote magit-log-header-end))
+ nil t)
+ (delete-region (match-beginning 0) (match-end 0)))
+ (goto-char (point-min))
+ (when fields
+ (while fields
+ (insert (capitalize (symbol-name (caar fields))) ": "
+ (prin1-to-string (cdar fields)) "\n")
+ (setq fields (cdr fields)))
+ (insert magit-log-header-end)))))
+
+(defun magit-log-edit-set-field (name value)
+ (let* ((fields (magit-log-edit-get-fields))
+ (cell (assq name fields)))
+ (cond (cell
+ (if value
+ (rplacd cell value)
+ (setq fields (delq cell fields))))
+ (t
+ (if value
+ (setq fields (append fields (list (cons name value)))))))
+ (magit-log-edit-set-fields fields)))
+
+(defun magit-log-edit-get-field (name)
+ (cdr (assq name (magit-log-edit-get-fields))))
+
+(defun magit-log-edit-toggle-field (name default)
+ "Toggle the log-edit field named NAME.
+If it's currently unset, set it to DEFAULT (t or nil).
+
+Return nil if the field is toggled off, and non-nil if it's
+toggled on. When it's toggled on for the first time, return
+'first."
+ (let* ((fields (magit-log-edit-get-fields))
+ (cell (assq name fields)) yesp)
+ (if cell
+ (progn
+ (setq yesp (equal (cdr cell) "yes"))
+ (rplacd cell (if yesp "no" "yes")))
+ (setq fields (acons name (if default "yes" "no") fields))
+ (setq yesp (if default 'first)))
+ (magit-log-edit-set-fields fields)
+ yesp))
+
+(defun magit-log-edit-toggle-input (name default)
+ "Toggle the log-edit input named NAME.
+If it's currently unset, set it to DEFAULT (a string). If it is
+set remove it.
+
+Return nil if the input is toggled off, and its valud if it's
+toggled on."
+ (let* ((fields (magit-log-edit-get-fields))
+ (cell (assq name fields))
+ result)
+ (if cell
+ (progn
+ (setq fields (assq-delete-all name fields)
+ result (cdr cell)))
+ (setq fields (acons name default fields)))
+ (magit-log-edit-set-fields fields)
+ result))
+
+(defun magit-log-edit-setup-author-env (author)
+ "Set GIT_AUTHOR_* variables from AUTHOR spec.
+If AUTHOR is nil, honor default values from
+environment (potentially empty)."
+ (when author
+ ;; XXX - this is a bit strict, probably.
+ (or (string-match "\\(.*\\) <\\(.*\\)>\\(?:,\\s-*\\(.+\\)\\)?" author)
+ (error "Can't parse author string"))
+ ;; Shucks, setenv destroys the match data.
+ (let ((name (match-string 1 author))
+ (email (match-string 2 author))
+ (date (match-string 3 author)))
+ (make-local-variable 'process-environment)
+ (setenv "GIT_AUTHOR_NAME" name)
+ (setenv "GIT_AUTHOR_EMAIL" email)
+ (if date
+ (setenv "GIT_AUTHOR_DATE" date)))))
+
+(defun magit-log-edit-push-to-comment-ring (comment)
+ (when (or (ring-empty-p log-edit-comment-ring)
+ (not (equal comment (ring-ref log-edit-comment-ring 0))))
+ (ring-insert log-edit-comment-ring comment)))
+
+(defun magit-log-edit-commit ()
+ "Finish edits and create new commit object.
+\('git commit ...')"
+ (interactive)
+ (let* ((fields (magit-log-edit-get-fields))
+ (amend (equal (cdr (assq 'amend fields)) "yes"))
+ (allow-empty (equal (cdr (assq 'allow-empty fields)) "yes"))
+ (commit-all (equal (cdr (assq 'commit-all fields)) "yes"))
+ (sign-off-field (assq 'sign-off fields))
+ (sign-off (if sign-off-field
+ (equal (cdr sign-off-field) "yes")
+ magit-commit-signoff))
+ (tag-rev (cdr (assq 'tag-rev fields)))
+ (tag-name (cdr (assq 'tag-name fields)))
+ (author (cdr (assq 'author fields)))
+ (tag-options (cdr (assq 'tag-options fields))))
+
+ (unless (or (magit-anything-staged-p)
+ allow-empty
+ amend
+ tag-name
+ (file-exists-p (concat (magit-git-dir) "MERGE_HEAD"))
+ (and commit-all
+ (not (magit-everything-clean-p))))
+ (error "Refusing to create empty commit. Maybe you want to amend (%s) or allow-empty (%s)?"
+ (key-description (car (where-is-internal
+ 'magit-log-edit-toggle-amending)))
+ (key-description (car (where-is-internal
+ 'magit-log-edit-toggle-allow-empty)))))
+
+ (magit-log-edit-push-to-comment-ring (buffer-string))
+ (magit-log-edit-setup-author-env author)
+ (magit-log-edit-set-fields nil)
+ (magit-log-edit-cleanup)
+ (if (= (buffer-size) 0)
+ (insert "(Empty description)\n"))
+ (let ((env process-environment)
+ (commit-buf (current-buffer)))
+ (with-current-buffer (magit-find-status-buffer default-directory)
+ (let ((process-environment env))
+ (cond (tag-name
+ (apply #'magit-run-git-with-input commit-buf
+ "tag" (append tag-options (list tag-name "-a" "-F" "-" tag-rev))))
+ (t
+ (apply #'magit-run-async-with-input commit-buf
+ magit-git-executable
+ (append magit-git-standard-options
+ '("commit")
+ magit-custom-options
+ '("-F" "-")
+ (if (and commit-all (not allow-empty)) '("--all") '())
+ (if amend '("--amend") '())
+ (if allow-empty '("--allow-empty"))
+ (if sign-off '("--signoff") '()))))))))
+ ;; shouldn't we kill that buffer altogether?
+ (erase-buffer)
+ (let ((magit-buf magit-buffer-internal))
+ (bury-buffer)
+ (set-buffer magit-buf))
+ (when (file-exists-p (concat (magit-git-dir) "MERGE_MSG"))
+ (delete-file (concat (magit-git-dir) "MERGE_MSG")))
+ ;; potentially the local environment has been altered with settings that
+ ;; were specific to this commit. Let's revert it
+ (kill-local-variable 'process-environment)
+ (magit-update-vc-modeline default-directory)
+ (when magit-pre-log-edit-window-configuration
+ (set-window-configuration magit-pre-log-edit-window-configuration)
+ (setq magit-pre-log-edit-window-configuration nil))))
+
+(defun magit-log-edit-cancel-log-message ()
+ "Abort edits and erase commit message being composed."
+ (interactive)
+ (when (or (not magit-log-edit-confirm-cancellation)
+ (yes-or-no-p
+ "Really cancel editing the log (any changes will be lost)?"))
+ (erase-buffer)
+ (bury-buffer)
+ (when magit-pre-log-edit-window-configuration
+ (set-window-configuration magit-pre-log-edit-window-configuration)
+ (setq magit-pre-log-edit-window-configuration nil))))
+
+(defun magit-log-edit-toggle-amending ()
+ "Toggle whether this will be an amendment to the previous commit.
+\(i.e., whether eventual commit does 'git commit --amend')"
+ (interactive)
+ (when (eq (magit-log-edit-toggle-field 'amend t) 'first)
+ (magit-log-edit-append
+ (magit-trim-line (magit-format-commit "HEAD" "%s%n%n%b")))))
+
+(defun magit-log-edit-toggle-signoff ()
+ "Toggle whether this commit will include a signoff.
+\(i.e., whether eventual commit does 'git commit --signoff')"
+ (interactive)
+ (magit-log-edit-toggle-field 'sign-off (not magit-commit-signoff)))
+
+(defun magit-log-edit-toggle-author ()
+ "Toggle whether this commit will include an author.
+\(i.e., whether eventual commit is run with GIT_AUTHOR_NAME and
+GIT_AUTHOR_EMAIL set)"
+ (interactive)
+ (magit-log-edit-toggle-input 'author (format "%s <%s>"
+ (or (magit-get "user" "name") "Author Name")
+ (or (magit-get "user" "email") "author@email"))))
+
+(defun magit-log-edit-toggle-allow-empty ()
+ "Toggle whether this commit is allowed to be empty.
+This means that the eventual commit does 'git commit --allow-empty'."
+ (interactive)
+ (magit-log-edit-toggle-field 'allow-empty t))
+
+(defun magit-pop-to-log-edit (operation)
+ (let ((dir default-directory)
+ (magit-buf (current-buffer))
+ (buf (get-buffer-create magit-log-edit-buffer-name)))
+ (setq magit-pre-log-edit-window-configuration
+ (current-window-configuration))
+ (pop-to-buffer buf)
+ (setq default-directory dir)
+ (when (file-exists-p (concat (magit-git-dir) "MERGE_MSG"))
+ (insert-file-contents (concat (magit-git-dir) "MERGE_MSG")))
+ (magit-log-edit-mode)
+ (make-local-variable 'magit-buffer-internal)
+ (setq magit-buffer-internal magit-buf)
+ (message "Type C-c C-c to %s (C-c C-k to cancel)." operation)))
+
+(defun magit-log-edit (&optional arg)
+ "Brings up a buffer to allow editing of commit messages.
+
+Giving a simple prefix arg will amend a previous commit, while
+a double prefix arg will allow creating an empty one.
+
+If there is a rebase in progress, offer the user the option to
+continue it.
+
+\\{magit-log-edit-mode-map}"
+ (interactive "P")
+ ;; If repository is dirty there is no point in trying to
+ ;; suggest to continue the rebase. Git will rebuke you and exit with
+ ;; error code, so suggest it only if theres absolutely nothing else
+ ;; to do and rebase is ongoing.
+ (if (and (magit-everything-clean-p)
+ (magit-rebase-info)
+ (y-or-n-p "Rebase in progress. Continue it? "))
+ (magit-run-git-async "rebase" "--continue")
+
+ ;; If there's nothing staged, set commit flag to `nil', thus
+ ;; avoiding unnescessary popping up of the log edit buffer in case
+ ;; when user chose to forgo commiting all unstaged changes
+ (let ((amend-p (= (prefix-numeric-value arg) 4))
+ (empty-p (= (prefix-numeric-value arg) 16)))
+ (when (and magit-commit-all-when-nothing-staged
+ (not (magit-everything-clean-p))
+ (not (magit-anything-staged-p)))
+ (cond ((eq magit-commit-all-when-nothing-staged 'ask-stage)
+ (when (y-or-n-p "Nothing staged. Stage everything now? ")
+ (magit-stage-all)))
+ ((not (magit-log-edit-get-field 'commit-all))
+ (when (or (eq magit-commit-all-when-nothing-staged t)
+ (y-or-n-p
+ "Nothing staged. Commit all unstaged changes? "))
+ (magit-log-edit-set-field 'commit-all "yes")))))
+ (when amend-p
+ (magit-log-edit-toggle-amending))
+ (when empty-p
+ (magit-log-edit-toggle-allow-empty))
+ (let ((author-email (or (getenv "GIT_AUTHOR_EMAIL") ""))
+ (author-name (or (getenv "GIT_AUTHOR_NAME") ""))
+ (author-date (or (getenv "GIT_AUTHOR_DATE") "")))
+ (if (not (string= author-email ""))
+ (magit-log-edit-set-field 'author (format "%s <%s>%s"
+ (if (string= "" author-name) author-email author-name)
+ author-email
+ (if (string= "" author-date) "" (format ", %s" author-date))))))
+ (magit-pop-to-log-edit "commit"))))
+
+(defun magit-add-log ()
+ (interactive)
+ (cond ((magit-rebase-info)
+ (if (y-or-n-p "Rebase in progress. Continue it? ")
+ (magit-run-git-async "rebase" "--continue")))
+ (t
+ (let ((section (magit-current-section)))
+ (let ((fun (if (eq (magit-section-type section) 'hunk)
+ (save-window-excursion
+ (save-excursion
+ (magit-visit-item)
+ (add-log-current-defun)))
+ nil))
+ (file (magit-diff-item-file
+ (cond ((eq (magit-section-type section) 'hunk)
+ (magit-hunk-item-diff section))
+ ((eq (magit-section-type section) 'diff)
+ section)
+ (t
+ (error "No change at point"))))))
+ (magit-log-edit nil)
+ (goto-char (point-min))
+ (cond ((not (search-forward-regexp
+ (format "^\\* %s" (regexp-quote file)) nil t))
+ ;; No entry for file, create it.
+ (goto-char (point-max))
+ (insert (format "\n* %s" file))
+ (if fun
+ (insert (format " (%s)" fun)))
+ (insert ": "))
+ (fun
+ ;; found entry for file, look for fun
+ (let ((limit (or (save-excursion
+ (and (search-forward-regexp "^\\* "
+ nil t)
+ (match-beginning 0)))
+ (point-max))))
+ (cond ((search-forward-regexp (format "(.*\\<%s\\>.*):"
+ (regexp-quote fun))
+ limit t)
+ ;; found it, goto end of current entry
+ (if (search-forward-regexp "^(" limit t)
+ (backward-char 2)
+ (goto-char limit)))
+ (t
+ ;; not found, insert new entry
+ (goto-char limit)
+ (if (bolp)
+ (open-line 1)
+ (newline))
+ (insert (format "(%s): " fun))))))
+ (t
+ ;; found entry for file, look for beginning it
+ (when (looking-at ":")
+ (forward-char 2)))))))))
+
+;;; Tags
+
+(magit-define-command tag (name rev)
+ "Create a new lightweight tag with the given NAME at REV.
+\('git tag NAME')."
+ (interactive
+ (list
+ (read-string "Tag name: ")
+ (magit-read-rev "Place tag on: " (or (magit-default-rev) "HEAD"))))
+ (apply #'magit-run-git "tag" (append magit-custom-options (list name rev))))
+
+(magit-define-command annotated-tag (name rev)
+ "Start composing an annotated tag with the given NAME.
+Tag will point to the current 'HEAD'."
+ (interactive
+ (list
+ (read-string "Tag name: ")
+ (magit-read-rev "Place tag on: " (or (magit-default-rev) "HEAD"))))
+ (magit-log-edit-set-field 'tag-name name)
+ (magit-log-edit-set-field 'tag-rev rev)
+ (magit-log-edit-set-field 'tag-options magit-custom-options)
+ (magit-pop-to-log-edit "tag"))
+
+;;; Stashing
+
+(defun magit-wash-stash ()
+ (if (search-forward-regexp "stash@{\\(.*?\\)}" (line-end-position) t)
+ (let ((stash (match-string-no-properties 0))
+ (name (match-string-no-properties 1)))
+ (delete-region (match-beginning 0) (match-end 0))
+ (goto-char (match-beginning 0))
+ (fixup-whitespace)
+ (goto-char (line-beginning-position))
+ (insert name)
+ (goto-char (line-beginning-position))
+ (magit-with-section stash 'stash
+ (magit-set-section-info stash)
+ (forward-line)))
+ (forward-line))
+ t)
+
+(defun magit-wash-stashes ()
+ (let ((magit-old-top-section nil))
+ (magit-wash-sequence #'magit-wash-stash)))
+
+(magit-define-inserter stashes ()
+ (magit-git-section 'stashes
+ "Stashes:" 'magit-wash-stashes
+ "stash" "list"))
+
+(magit-define-command stash (description)
+ "Create new stash of working tree and staging area named DESCRIPTION.
+Working tree and staging area revert to the current 'HEAD'.
+With prefix argument, changes in staging area are kept.
+\('git stash save [--keep-index] DESCRIPTION')"
+ (interactive "sStash description: ")
+ (apply 'magit-run-git `("stash" "save" ,@magit-custom-options "--" ,description)))
+
+(magit-define-command stash-snapshot ()
+ "Create new stash of working tree and staging area; keep changes in place.
+\('git stash save \"Snapshot...\"; git stash apply stash@{0}')"
+ (interactive)
+ (magit-with-refresh
+ (apply 'magit-run-git `("stash" "save" ,@magit-custom-options
+ ,(format-time-string "Snapshot taken at %Y-%m-%d %H:%M:%S"
+ (current-time))))
+ (magit-run-git "stash" "apply" "stash@{0}")))
+
+(defvar magit-currently-shown-stash nil)
+
+(define-derived-mode magit-stash-mode magit-mode "Magit Stash"
+ "Mode for looking at a git stash.
+
+\\{magit-stash-mode-map}"
+ :group 'magit)
+
+(defvar magit-stash-buffer-name "*magit-stash*"
+ "Buffer name for displaying a stash.")
+
+(defun magit-show-stash (stash &optional scroll)
+ (when (magit-section-p stash)
+ (setq stash (magit-section-info stash)))
+ (let ((dir default-directory)
+ (buf (get-buffer-create magit-stash-buffer-name))
+ (stash-id (magit-git-string "rev-list" "-1" stash)))
+ (cond ((and (equal magit-currently-shown-stash stash-id)
+ (with-current-buffer buf
+ (> (length (buffer-string)) 1)))
+ (let ((win (get-buffer-window buf)))
+ (cond ((not win)
+ (display-buffer buf))
+ (scroll
+ (with-selected-window win
+ (funcall scroll))))))
+ (t
+ (setq magit-currently-shown-stash stash-id)
+ (display-buffer buf)
+ (with-current-buffer buf
+ (set-buffer buf)
+ (goto-char (point-min))
+ (let* ((range (cons (concat stash "^2^") stash))
+ (magit-current-diff-range range)
+ (args (magit-rev-range-to-git range)))
+ (magit-mode-init dir 'magit-diff-mode #'magit-refresh-diff-buffer
+ range args)))))))
+;;; Commits
+
+(defun magit-commit-at-point (&optional nil-ok-p)
+ (let* ((section (magit-current-section))
+ (commit (if (and section
+ (eq (magit-section-type section) 'commit))
+ (magit-section-info section)
+ (get-text-property (point) 'revision))))
+ (if nil-ok-p
+ commit
+ (or commit
+ (error "No commit at point")))))
+
+(defun magit-apply-commit (commit &optional docommit noerase revert)
+ (let* ((parent-id (magit-choose-parent-id commit "cherry-pick"))
+ (success (magit-run* `(,magit-git-executable
+ ,@magit-git-standard-options
+ ,(if revert "revert" "cherry-pick")
+ ,@(if parent-id
+ (list "-m" (number-to-string parent-id)))
+ ,@(if (not docommit) (list "--no-commit"))
+ ,commit)
+ nil noerase)))
+ (when (and (not docommit) success)
+ (cond (revert
+ (magit-log-edit-append
+ (magit-format-commit commit "Reverting \"%s\"")))
+ (t
+ (magit-log-edit-append
+ (magit-format-commit commit "%s%n%n%b"))
+ (magit-log-edit-set-field
+ 'author
+ (magit-format-commit commit "%an <%ae>, %ai")))))
+ success))
+
+(defun magit-apply-item ()
+ (interactive)
+ (magit-section-action (item info "apply")
+ ((pending commit)
+ (magit-apply-commit info)
+ (magit-rewrite-set-commit-property info 'used t))
+ ((commit)
+ (magit-apply-commit info))
+ ((unstaged *)
+ (error "Change is already in your working tree"))
+ ((staged *)
+ (error "Change is already in your working tree"))
+ ((hunk)
+ (magit-apply-hunk-item item))
+ ((diff)
+ (magit-apply-diff-item item))
+ ((stash)
+ (magit-run-git "stash" "apply" info))))
+
+(defun magit-cherry-pick-item ()
+ (interactive)
+ (magit-section-action (item info "cherry-pick")
+ ((pending commit)
+ (magit-apply-commit info t)
+ (magit-rewrite-set-commit-property info 'used t))
+ ((commit)
+ (magit-apply-commit info t))
+ ((stash)
+ (magit-run-git "stash" "pop" info))))
+
+(defmacro magit-with-revert-confirmation (&rest body)
+ `(when (or (not magit-revert-item-confirm)
+ (yes-or-no-p "Really revert this item? "))
+ ,@body))
+
+(defun magit-revert-item ()
+ (interactive)
+ (magit-section-action (item info "revert")
+ ((pending commit)
+ (magit-with-revert-confirmation
+ (magit-apply-commit info nil nil t)
+ (magit-rewrite-set-commit-property info 'used nil)))
+ ((commit)
+ (magit-with-revert-confirmation
+ (magit-apply-commit info nil nil t)))
+ ;; Reverting unstaged changes cannot be undone
+ ((unstaged *)
+ (magit-discard-item))
+ ((hunk)
+ (magit-with-revert-confirmation
+ (magit-apply-hunk-item-reverse item)))
+ ((diff)
+ (magit-with-revert-confirmation
+ (magit-apply-diff-item item "--reverse")))))
+
+(defun magit-log-show-more-entries (&optional arg)
+ "Grow the number of log entries shown.
+
+With no prefix optional ARG, show twice as many log entries.
+With a numerical prefix ARG, add this number to the number of shown log entries.
+With a non numeric prefix ARG, show all entries"
+ (interactive "P")
+ (make-local-variable 'magit-log-cutoff-length)
+ (cond
+ ((numberp arg)
+ (setq magit-log-cutoff-length (+ magit-log-cutoff-length arg)))
+ (arg
+ (setq magit-log-cutoff-length magit-log-infinite-length))
+ (t (setq magit-log-cutoff-length (* magit-log-cutoff-length 2))))
+ (let ((old-point (point)))
+ (magit-refresh)
+ (goto-char old-point)))
+
+(defun magit-refresh-log-buffer (range style args)
+ (magit-configure-have-graph)
+ (magit-configure-have-decorate)
+ (magit-configure-have-abbrev)
+ (setq magit-current-range range)
+ (magit-create-log-buffer-sections
+ (apply #'magit-git-section nil
+ (magit-rev-range-describe range "Commits")
+ (apply-partially 'magit-wash-log style)
+ `("log"
+ ,(format "--max-count=%s" magit-log-cutoff-length)
+ ,"--abbrev-commit"
+ ,(format "--abbrev=%s" magit-sha1-abbrev-length)
+ ,@(cond ((eq style 'long) (list "--stat" "-z"))
+ ((eq style 'oneline) (list "--pretty=oneline"))
+ (t nil))
+ ,@(if magit-have-decorate (list "--decorate=full"))
+ ,@(if magit-have-graph (list "--graph"))
+ ,@args
+ "--"))))
+
+(define-derived-mode magit-log-mode magit-mode "Magit Log"
+ "Mode for looking at git log.
+
+\\{magit-log-mode-map}"
+ :group 'magit)
+
+(defvar magit-log-buffer-name "*magit-log*"
+ "Buffer name for display of log entries.")
+
+(magit-define-command log-ranged ()
+ (interactive)
+ (magit-log t))
+(define-obsolete-function-alias 'magit-display-log-ranged 'magit-log-ranged)
+
+(magit-define-command log (&optional ask-for-range &rest extra-args)
+ (interactive)
+ (let* ((log-range (if ask-for-range
+ (magit-read-rev-range "Log" "HEAD")
+ "HEAD"))
+ (topdir (magit-get-top-dir default-directory))
+ (args (nconc (list (magit-rev-range-to-git log-range))
+ magit-custom-options
+ extra-args)))
+ (magit-buffer-switch magit-log-buffer-name)
+ (magit-mode-init topdir 'magit-log-mode #'magit-refresh-log-buffer log-range
+ 'oneline args)))
+
+(define-obsolete-function-alias 'magit-display-log 'magit-log)
+
+(magit-define-command log-long-ranged ()
+ (interactive)
+ (magit-log-long t))
+
+(magit-define-command log-long (&optional ranged)
+ (interactive)
+ (let* ((range (if ranged
+ (magit-read-rev-range "Long log" "HEAD")
+ "HEAD"))
+ (topdir (magit-get-top-dir default-directory))
+ (args (append (list (magit-rev-range-to-git range))
+ magit-custom-options)))
+ (magit-buffer-switch magit-log-buffer-name)
+ (magit-mode-init topdir 'magit-log-mode #'magit-refresh-log-buffer range
+ 'long args)))
+
+;;; Reflog
+
+(defvar magit-reflog-head nil
+ "The HEAD of the reflog in the current buffer.
+This is only non-nil in reflog buffers.")
+(make-variable-buffer-local 'magit-reflog-head)
+
+(defun magit-refresh-reflog-buffer (head args)
+ (setq magit-reflog-head head)
+ (magit-create-log-buffer-sections
+ (apply #'magit-git-section
+ 'reflog (format "Local history of head %s" head) 'magit-wash-log "log"
+ (append magit-git-log-options
+ (list
+ "--walk-reflogs"
+ (format "--max-count=%s" magit-log-cutoff-length)
+ args)))))
+
+(define-derived-mode magit-reflog-mode magit-log-mode "Magit Reflog"
+ "Mode for looking at git reflog.
+
+\\{magit-reflog-mode-map}"
+ :group 'magit)
+
+(magit-define-command reflog (&optional ask-for-range)
+ (interactive)
+ (let ((at (or (if ask-for-range
+ (magit-read-rev "Reflog of" (or (magit-guess-branch) "HEAD")))
+ "HEAD")))
+ (let* ((topdir (magit-get-top-dir default-directory))
+ (args (magit-rev-to-git at)))
+ (magit-buffer-switch "*magit-reflog*")
+ (magit-mode-init topdir 'magit-reflog-mode
+ #'magit-refresh-reflog-buffer at args))))
+
+(magit-define-command reflog-ranged ()
+ (interactive)
+ (magit-reflog t))
+
+;;; Diffing
+
+(defvar magit-ediff-buffers nil
+ "List of buffers that may be killed by `magit-ediff-restore'.")
+
+(defvar magit-ediff-windows nil
+ "The window configuration that will be restored when Ediff is finished.")
+
+(defun magit-ediff()
+ "View the current DIFF section in ediff."
+ (interactive)
+ (let ((diff (magit-current-section)))
+ (when (magit-section-hidden diff)
+ ;; Range is not set until the first time the diff is visible.
+ ;; This somewhat hackish code makes sure it's been visible at least once.
+ (magit-toggle-section)
+ (magit-toggle-section)
+ (setq diff (magit-current-section)))
+ (if (eq 'hunk (magit-section-type diff))
+ (setq diff (magit-section-parent diff)))
+ (unless (eq 'diff (magit-section-type diff))
+ (error "No diff at this location"))
+ (let* ((type (magit-diff-item-kind diff))
+ (file1 (magit-diff-item-file diff))
+ (file2 (magit-diff-item-file2 diff))
+ (range (magit-diff-item-range diff)))
+ (cond
+ ((memq type '(new deleted typechange))
+ (message "Why ediff a %s file?" type))
+ ((and (eq type 'unmerged)
+ (eq (cdr range) 'working))
+ (magit-interactive-resolve file1))
+ ((consp (car range))
+ (magit-ediff* (magit-show (caar range) file2)
+ (magit-show (cdar range) file2)
+ (magit-show (cdr range) file1)))
+ (t
+ (magit-ediff* (magit-show (car range) file2)
+ (magit-show (cdr range) file1)))))))
+
+(defun magit-ediff* (a b &optional c)
+ (setq magit-ediff-buffers (list a b c))
+ (setq magit-ediff-windows (current-window-configuration))
+ (add-hook 'ediff-quit-hook 'magit-ediff-restore 'append)
+ (if c
+ (ediff-buffers3 a b c)
+ (ediff-buffers a b)))
+
+(defun magit-ediff-restore()
+ "Kill any buffers in `magit-ediff-buffers' that are not visiting files and
+restore the window state that was saved before ediff was called."
+ (dolist (buffer magit-ediff-buffers)
+ (if (and (null (buffer-file-name buffer))
+ (buffer-live-p buffer))
+ (kill-buffer buffer)))
+ (setq magit-ediff-buffers nil)
+ (set-window-configuration magit-ediff-windows)
+ (remove-hook 'ediff-quit-hook 'magit-ediff-restore))
+
+(defun magit-refresh-diff-buffer (range args)
+ (let ((magit-current-diff-range (cond
+ ((stringp range)
+ (cons range 'working))
+ ((null (cdr range))
+ (cons (car range) 'working))
+ (t
+ range))))
+ (setq magit-current-range range)
+ (magit-create-buffer-sections
+ (magit-git-section 'diffbuf
+ (magit-rev-range-describe range "Changes")
+ 'magit-wash-diffs
+ "diff" (magit-diff-U-arg) args "--"))))
+
+(define-derived-mode magit-diff-mode magit-mode "Magit Diff"
+ "Mode for looking at a git diff.
+
+\\{magit-diff-mode-map}"
+ :group 'magit)
+
+(magit-define-command diff (range)
+ (interactive (list (magit-read-rev-range "Diff")))
+ (if range
+ (let* ((dir default-directory)
+ (args (magit-rev-range-to-git range))
+ (buf (get-buffer-create "*magit-diff*")))
+ (display-buffer buf)
+ (with-current-buffer buf
+ (magit-mode-init dir 'magit-diff-mode #'magit-refresh-diff-buffer range args)))))
+
+(magit-define-command diff-working-tree (rev)
+ (interactive (list (magit-read-rev "Diff with" (magit-default-rev))))
+ (magit-diff (or rev "HEAD")))
+
+(defun magit-diff-with-mark ()
+ (interactive)
+ (magit-diff (cons (magit-marked-commit)
+ (magit-commit-at-point))))
+
+;;; Wazzup
+
+(defvar magit-wazzup-head nil
+ "The integration head for the current wazzup buffer.
+This is only non-nil in wazzup buffers.")
+(make-variable-buffer-local 'magit-wazzup-head)
+
+(defvar magit-wazzup-all-p nil
+ "Non-nil if the current wazzup buffer displays excluded branches.
+This is only meaningful in wazzup buffers.")
+(make-variable-buffer-local 'magit-wazzup-all-p)
+
+(defun magit-wazzup-toggle-ignore (branch edit)
+ (let ((ignore-file (concat (magit-git-dir) "info/wazzup-exclude")))
+ (if edit
+ (setq branch (read-string "Branch to ignore for wazzup: " branch)))
+ (let ((ignored (magit-file-lines ignore-file)))
+ (cond ((member branch ignored)
+ (when (or (not edit)
+ (y-or-n-p "Branch %s is already ignored. Unignore? "))
+ (setq ignored (delete branch ignored))))
+ (t
+ (setq ignored (append ignored (list branch)))))
+ (magit-write-file-lines ignore-file ignored)
+ (magit-need-refresh))))
+
+(defun magit-refresh-wazzup-buffer (head all)
+ (setq magit-wazzup-head head)
+ (setq magit-wazzup-all-p all)
+ (let ((branch-desc (or head "(detached) HEAD")))
+ (unless head (setq head "HEAD"))
+ (magit-create-buffer-sections
+ (magit-with-section 'wazzupbuf nil
+ (insert (format "Wazzup, %s\n\n" branch-desc))
+ (let* ((excluded (magit-file-lines (concat (magit-git-dir) "info/wazzup-exclude")))
+ (all-branches (magit-list-interesting-refs))
+ (branches (if all all-branches
+ (delq nil (mapcar
+ (lambda (b)
+ (and (not
+ (member (cdr b) excluded))
+ b))
+ all-branches))))
+ (reported (make-hash-table :test #'equal)))
+ (dolist (branch branches)
+ (let* ((name (car branch))
+ (ref (cdr branch))
+ (hash (magit-rev-parse ref))
+ (reported-branch (gethash hash reported)))
+ (unless (or (and reported-branch
+ (string= (file-name-nondirectory ref)
+ reported-branch))
+ (not (magit-git-string "merge-base" head ref)))
+ (puthash hash (file-name-nondirectory ref) reported)
+ (let* ((n (length (magit-git-lines "log" "--pretty=oneline"
+ (concat head ".." ref))))
+ (section
+ (let ((magit-section-hidden-default t))
+ (magit-git-section
+ (cons ref 'wazzup)
+ (format "%s unmerged commits in %s%s"
+ n name
+ (if (member ref excluded)
+ " (normally ignored)"
+ ""))
+ 'magit-wash-log
+ "log"
+ (format "--max-count=%s" magit-log-cutoff-length)
+ "--abbrev-commit"
+ (format "--abbrev=%s" magit-sha1-abbrev-length)
+ "--graph"
+ "--pretty=oneline"
+ (format "%s..%s" head ref)
+ "--"))))
+ (magit-set-section-info ref section))))))))))
+
+(define-derived-mode magit-wazzup-mode magit-mode "Magit Wazzup"
+ "Mode for looking at commits that could be merged from other branches.
+
+\\{magit-wazzup-mode-map}"
+ :group 'magit)
+
+(defun magit-wazzup (&optional all)
+ (interactive "P")
+ (let ((topdir (magit-get-top-dir default-directory))
+ (current-branch (magit-get-current-branch)))
+ (magit-buffer-switch "*magit-wazzup*")
+ (magit-mode-init topdir 'magit-wazzup-mode
+ #'magit-refresh-wazzup-buffer
+ current-branch all)))
+
+(defun magit-filename (filename)
+ "Return the path of FILENAME relative to its git repository.
+
+If FILENAME is absolute, return a path relative to the git
+repository containing it. Otherwise, return a path relative to
+the current git repository."
+ (let ((topdir (expand-file-name
+ (magit-get-top-dir (or (file-name-directory filename)
+ default-directory))))
+ (file (file-truename filename)))
+ (when (and (not (string= topdir ""))
+ ;; FILE must start with the git repository path
+ (zerop (string-match-p (concat "\\`" topdir) file)))
+ (substring file (length topdir)))))
+
+;; This variable is used to keep track of the current file in the
+;; *magit-log* buffer when this one is dedicated to showing the log of
+;; just 1 file.
+(defvar magit-file-log-file nil)
+(make-variable-buffer-local 'magit-file-log-file)
+
+(defun magit-refresh-file-log-buffer (file range style)
+ "Refresh the current file-log buffer by calling git.
+
+FILE is the path of the file whose log must be displayed.
+
+`magit-current-range' will be set to the value of RANGE.
+
+STYLE controls the display. It is either `'long', `'oneline', or something else.
+ "
+ (magit-configure-have-graph)
+ (magit-configure-have-decorate)
+ (magit-configure-have-abbrev)
+ (setq magit-current-range range)
+ (setq magit-file-log-file file)
+ (magit-create-log-buffer-sections
+ (apply #'magit-git-section nil
+ (magit-rev-range-describe range (format "Commits for file %s" file))
+ (apply-partially 'magit-wash-log style)
+ `("log"
+ ,(format "--max-count=%s" magit-log-cutoff-length)
+ ,"--abbrev-commit"
+ ,(format "--abbrev=%s" magit-sha1-abbrev-length)
+ ,@(cond ((eq style 'long) (list "--stat" "-z"))
+ ((eq style 'oneline) (list "--pretty=oneline"))
+ (t nil))
+ ,@(if magit-have-decorate (list "--decorate=full"))
+ ,@(if magit-have-graph (list "--graph"))
+ "--"
+ ,file))))
+
+(defun magit-file-log (&optional all)
+ "Display the log for the currently visited file or another one.
+
+With a prefix argument or if no file is currently visited, ask
+for the file whose log must be displayed."
+ (interactive "P")
+ (let ((topdir (magit-get-top-dir default-directory))
+ (current-file (magit-filename
+ (if (or current-prefix-arg (not buffer-file-name))
+ (magit-read-file-from-rev (magit-get-current-branch))
+ buffer-file-name)))
+ (range "HEAD"))
+ (magit-buffer-switch "*magit-log*")
+ (magit-mode-init topdir 'magit-log-mode
+ #'magit-refresh-file-log-buffer
+ current-file range 'oneline)))
+
+(defun magit-show-file-revision ()
+ "Open a new buffer showing the current file in the revision at point."
+ (interactive)
+ (flet ((magit-show-file-from-diff (item)
+ (switch-to-buffer-other-window
+ (magit-show (cdr (magit-diff-item-range item))
+ (magit-diff-item-file item)))))
+ (magit-section-action (item info "show")
+ ((commit)
+ (let ((current-file (or magit-file-log-file
+ (magit-read-file-from-rev info))))
+ (switch-to-buffer-other-window
+ (magit-show info current-file))))
+ ((hunk) (magit-show-file-from-diff (magit-hunk-item-diff item)))
+ ((diff) (magit-show-file-from-diff item)))))
+
+;;; Miscellaneous
+
+(defun magit-ignore-modifiable-file (file edit)
+ "Prompt the user for the filename to be added to git ignore.
+\\<minibuffer-local-map>
+The minibuffer's future history (accessible with \\[next-history-element])
+contains predefined values (such as wildcards) that might
+be of interest.
+The history and default value are derived from the filename FILE.
+If EDIT argument is negative, the prompt proposes wildcard by default.
+"
+ (let* ((just-extension (concat "*." (file-name-extension file)))
+ (full-extension (concat (file-name-directory file) just-extension))
+ (just-file (file-name-nondirectory file))
+ ;; change the order in history depending on the negativity of
+ ;; EDIT.
+ (history (if (< (prefix-numeric-value edit) 0)
+ (list full-extension just-extension file just-file)
+ (list file full-extension just-extension just-file))))
+ (read-string
+ (format "File to ignore [%s]: " (car history))
+ nil nil history)))
+
+(defun magit-ignore-file (file edit local)
+ "Add FILE to the list of files to ignore.
+\\<minibuffer-local-map>
+If EDIT is non-`nil', prompt the user for the filename to
+be added to git ignore. In this case, the minibuffer's
+future history (accessible with \\[next-history-element]) contains predefined
+values (such as wildcards) that might be of interest.
+
+If LOCAL is nil, the `.gitignore' file is updated.
+Otherwise, it is `.git/info/exclude'."
+ (let* ((local-ignore-dir (concat (magit-git-dir) "info/"))
+ (ignore-file (if local
+ (concat local-ignore-dir "exclude")
+ ".gitignore")))
+ (if edit
+ (setq file (magit-ignore-modifiable-file file edit)))
+ (if (and local (not (file-exists-p local-ignore-dir)))
+ (make-directory local-ignore-dir t))
+ (with-temp-buffer
+ (when (file-exists-p ignore-file)
+ (insert-file-contents ignore-file))
+ (goto-char (point-max))
+ (unless (bolp)
+ (insert "\n"))
+ (insert file "\n")
+ (write-region nil nil ignore-file))
+ (magit-need-refresh)))
+
+(defun magit-ignore-item ()
+ "Add FILE to the `.gitignore' list of files to ignore.
+\\<minibuffer-local-map>
+With a prefix argument, prompt the user for the filename to
+be added. In this case, the minibuffer's future history
+\(accessible with \\[next-history-element]) contains predefined values (such as
+wildcards) that might be of interest. If prefix argument is
+negative, the prompt proposes wildcard by default."
+ (interactive)
+ (magit-section-action (item info "ignore")
+ ((untracked file)
+ (magit-ignore-file (concat "/" info) current-prefix-arg nil))
+ ((wazzup)
+ (magit-wazzup-toggle-ignore info current-prefix-arg))))
+
+(defun magit-ignore-item-locally ()
+ "Add FILE to the `.git/info/exclude' list of files to ignore.
+\\<minibuffer-local-map>
+With a prefix argument, prompt the user for the filename to
+be added. In this case, the minibuffer's future history
+(accessible with \\[next-history-element]) contains predefined values (such as
+wildcards) that might be of interest. If prefix argument is
+negative, the prompt proposes wildcard by default."
+ (interactive)
+ (magit-section-action (item info "ignore")
+ ((untracked file)
+ (magit-ignore-file (concat "/" info) current-prefix-arg t))))
+
+(defun magit-discard-diff (diff stagedp)
+ (let ((kind (magit-diff-item-kind diff))
+ (file (magit-diff-item-file diff)))
+ (cond ((eq kind 'deleted)
+ (when (yes-or-no-p (format "Resurrect %s? " file))
+ (magit-run-git "reset" "-q" "--" file)
+ (magit-run-git "checkout" "--" file)))
+ ((eq kind 'new)
+ (if (yes-or-no-p (format "Delete %s? " file))
+ (magit-run-git "rm" "-f" "--" file)))
+ (t
+ (if (yes-or-no-p (format "Discard changes to %s? " file))
+ (if stagedp
+ (magit-run-git "checkout" "HEAD" "--" file)
+ (magit-run-git "checkout" "--" file)))))))
+
+(defun magit-discard-item ()
+ (interactive)
+ (magit-section-action (item info "discard")
+ ((untracked file)
+ (when (yes-or-no-p (format "Delete %s? " info))
+ (if (and (file-directory-p info)
+ (not (file-symlink-p info)))
+ (magit-delete-directory info 'recursive)
+ (delete-file info))
+ (magit-refresh-buffer)))
+ ((untracked)
+ (if (yes-or-no-p "Delete all untracked files and directories? ")
+ (magit-run-git "clean" "-df")))
+ ((unstaged diff hunk)
+ (when (yes-or-no-p (if (magit-use-region-p)
+ "Discard changes in region? "
+ "Discard hunk? "))
+ (magit-apply-hunk-item-reverse item)))
+ ((staged diff hunk)
+ (if (magit-file-uptodate-p (magit-diff-item-file
+ (magit-hunk-item-diff item)))
+ (when (yes-or-no-p (if (magit-use-region-p)
+ "Discard changes in region? "
+ "Discard hunk? "))
+ (magit-apply-hunk-item-reverse item "--index"))
+ (error "Can't discard this hunk. Please unstage it first")))
+ ((unstaged diff)
+ (magit-discard-diff item nil))
+ ((staged diff)
+ (if (magit-file-uptodate-p (magit-diff-item-file item))
+ (magit-discard-diff item t)
+ (error "Can't discard staged changes to this file. Please unstage it first")))
+ ((diff diff)
+ (save-excursion
+ (magit-goto-parent-section)
+ (magit-discard-item)))
+ ((diff diff hunk)
+ (save-excursion
+ (magit-goto-parent-section)
+ (magit-goto-parent-section)
+ (magit-discard-item)))
+ ((hunk)
+ (error "Can't discard this hunk"))
+ ((diff)
+ (error "Can't discard this diff"))
+ ((stash)
+ (when (yes-or-no-p "Discard stash? ")
+ (magit-run-git "stash" "drop" info)))
+ ((branch)
+ (when (yes-or-no-p (if current-prefix-arg
+ "Force delete branch?"
+ "Delete branch? "))
+ (magit-delete-branch info current-prefix-arg)))
+ ((remote)
+ (when (yes-or-no-p "Remove remote? ")
+ (magit-remove-remote info)))))
+
+(defun magit-move-item ()
+ (interactive)
+ (magit-section-action (item info "move")
+ ((branch)
+ (call-interactively 'magit-move-branch))
+ ((remote)
+ (call-interactively 'magit-rename-remote))))
+
+(defmacro magit-visiting-file-item (&rest body)
+ `(let ((marker (save-window-excursion
+ (magit-visit-file-item)
+ (set-marker (make-marker) (point)))))
+ (save-excursion
+ (with-current-buffer (marker-buffer marker)
+ (goto-char marker)
+ ,@body))))
+
+(defun magit-add-change-log-entry-no-option (&optional other-window)
+ "Add a change log entry for current change.
+With a prefix argument, edit in other window.
+The name of the change log file is set by variable change-log-default-name."
+ (interactive "P")
+ (if other-window
+ (magit-visiting-file-item (add-change-log-entry-other-window))
+ (magit-visiting-file-item (add-change-log-entry))))
+
+(defun magit-add-change-log-entry-other-window ()
+ (interactive)
+ (magit-visiting-file-item (call-interactively 'add-change-log-entry-other-window)))
+
+(eval-after-load 'dired-x
+ '(defun magit-dired-jump (&optional other-window)
+ "Visit current item.
+With a prefix argument, visit in other window."
+ (interactive "P")
+ (require 'dired-x)
+ (magit-section-action (item info "dired-jump")
+ ((untracked file)
+ (dired-jump other-window (file-truename info)))
+ ((diff)
+ (dired-jump other-window (file-truename (magit-diff-item-file item))))
+ ((hunk)
+ (dired-jump other-window
+ (file-truename (magit-diff-item-file
+ (magit-hunk-item-diff item))))))))
+
+(defun magit-visit-file-item (&optional other-window)
+ "Visit current file associated with item.
+With a prefix argument, visit in other window."
+ (interactive "P")
+ (magit-section-action (item info "visit-file")
+ ((untracked file)
+ (funcall
+ (if other-window 'find-file-other-window 'find-file)
+ info))
+ ((diff)
+ (let ((file (magit-diff-item-file item)))
+ (cond ((not (file-exists-p file))
+ (error "Can't visit deleted file: %s" file))
+ ((file-directory-p file)
+ (magit-status file))
+ (t
+ (funcall
+ (if other-window 'find-file-other-window 'find-file)
+ file)))))
+ ((hunk)
+ (let ((file (magit-diff-item-file (magit-hunk-item-diff item)))
+ (line (magit-hunk-item-target-line item)))
+ (if (not (file-exists-p file))
+ (error "Can't visit deleted file: %s" file))
+ (funcall
+ (if other-window 'find-file-other-window 'find-file)
+ file)
+ (goto-char (point-min))
+ (forward-line (1- line))))))
+
+(defun magit-visit-item (&optional other-window)
+ "Visit current item.
+With a prefix argument, visit in other window."
+ (interactive "P")
+ (magit-section-action (item info "visit")
+ ((untracked file)
+ (call-interactively 'magit-visit-file-item))
+ ((diff)
+ (call-interactively 'magit-visit-file-item))
+ ((hunk)
+ (call-interactively 'magit-visit-file-item))
+ ((commit)
+ (magit-show-commit info nil nil 'select))
+ ((stash)
+ (magit-show-stash info)
+ (pop-to-buffer magit-stash-buffer-name))
+ ((branch)
+ (magit-checkout info))
+ ((longer)
+ (magit-log-show-more-entries ()))))
+
+(defun magit-show-item-or-scroll-up ()
+ (interactive)
+ (magit-section-action (item info)
+ ((commit)
+ (magit-show-commit info #'scroll-up))
+ ((stash)
+ (magit-show-stash info #'scroll-up))
+ (t
+ (scroll-up))))
+
+(defun magit-show-item-or-scroll-down ()
+ (interactive)
+ (magit-section-action (item info)
+ ((commit)
+ (magit-show-commit info #'scroll-down))
+ ((stash)
+ (magit-show-stash info #'scroll-down))
+ (t
+ (scroll-down))))
+
+(defun magit-mark-item (&optional unmark)
+ (interactive "P")
+ (if unmark
+ (magit-set-marked-commit nil)
+ (magit-section-action (item info "mark")
+ ((commit)
+ (magit-set-marked-commit (if (eq magit-marked-commit info)
+ nil
+ info))))))
+
+(defun magit-describe-item ()
+ (interactive)
+ (let ((section (magit-current-section)))
+ (message "Section: %s %s-%s %S %S %S"
+ (magit-section-type section)
+ (magit-section-beginning section)
+ (magit-section-end section)
+ (magit-section-title section)
+ (magit-section-info section)
+ (magit-section-context-type section))))
+
+(defun magit-copy-item-as-kill ()
+ "Copy sha1 of commit at point into kill ring."
+ (interactive)
+ (magit-section-action (item info "copy")
+ ((commit)
+ (kill-new info)
+ (message "%s" info))))
+
+(eval-when-compile (require 'server))
+
+(defun magit-server-running-p ()
+ "Test whether server is running (works with < 23 as well).
+
+Return values:
+ nil the server is definitely not running.
+ t the server seems to be running.
+ something else we cannot determine whether it's running without using
+ commands which may have to wait for a long time."
+ (require 'server)
+ (if (functionp 'server-running-p)
+ (server-running-p)
+ (condition-case nil
+ (if server-use-tcp
+ (with-temp-buffer
+ (insert-file-contents-literally (expand-file-name server-name server-auth-dir))
+ (or (and (looking-at "127\\.0\\.0\\.1:[0-9]+ \\([0-9]+\\)")
+ (assq 'comm
+ (process-attributes
+ (string-to-number (match-string 1))))
+ t)
+ :other))
+ (delete-process
+ (make-network-process
+ :name "server-client-test" :family 'local :server nil :noquery t
+ :service (expand-file-name server-name server-socket-dir)))
+ t)
+ (file-error nil))))
+
+(defun magit-interactive-rebase ()
+ "Start a git rebase -i session, old school-style."
+ (interactive)
+ (unless (magit-server-running-p)
+ (server-start))
+ (let* ((section (get-text-property (point) 'magit-section))
+ (commit (and (member 'commit (magit-section-context-type section))
+ (magit-section-info section)))
+ (old-editor (getenv "GIT_EDITOR")))
+ (setenv "GIT_EDITOR" (concat (locate-file "emacsclient" exec-path)
+ " -s " server-name))
+ (unwind-protect
+ (magit-run-git-async "rebase" "-i"
+ (or (and commit (concat commit "^"))
+ (magit-read-rev "Interactively rebase to" (magit-guess-branch))))
+ (if old-editor
+ (setenv "GIT_EDITOR" old-editor)))))
+
+(define-derived-mode magit-branch-manager-mode magit-mode "Magit Branch"
+ "Magit Branches")
+
+(defun magit-quit-window (&optional kill-buffer)
+ "Bury the buffer and delete its window. With a prefix argument, kill the
+buffer instead."
+ (interactive "P")
+ (quit-window kill-buffer (selected-window)))
+
+(defun magit--branch-name-at-point ()
+ "Get the branch name in the line at point."
+ (let ((branch (magit-section-info (magit-current-section))))
+ (or branch (error "No branch at point"))))
+
+(defun magit--branches-for-remote-repo (remote)
+ "Return a list of remote branch names for REMOTE.
+These are the branch names with the remote name stripped."
+ (remq nil
+ (mapcar (lambda (line)
+ (save-match-data
+ (if (and (not (string-match-p " -> " line))
+ (string-match (concat "^ +" remote "/\\([^ $]+\\)")
+ line))
+ (match-string 1 line))))
+ (magit-git-lines "branch" "-r"))))
+
+(defvar magit-branches-buffer-name "*magit-branches*")
+
+(defun magit--is-branch-at-point-remote ()
+ "Return non-nil if the branch at point is a remote tracking branch"
+ (magit-remote-part-of-branch (magit--branch-name-at-point)))
+
+(defun magit-remote-part-of-branch (branch)
+ (when (string-match-p "^\\(?:refs/\\)?remotes\\/" branch)
+ (loop for remote in (magit-git-lines "remote")
+ when (string-match-p (format "^\\(?:refs/\\)?remotes\\/%s\\/" (regexp-quote remote)) branch) return remote)))
+
+(defun magit-branch-no-remote (branch)
+ (let ((remote (magit-remote-part-of-branch branch)))
+ (if remote
+ (progn
+ ;; This has to match if remote is non-nil
+ (assert (string-match (format "^\\(?:refs/\\)?remotes\\/%s\\/\\(.*\\)" (regexp-quote remote)) branch)
+ 'show-args "Unexpected string-match failure: %s %s")
+ (match-string 1 branch))
+ branch)))
+
+(defun magit-wash-branch-line (&optional remote-name)
+ (looking-at (concat
+ "^\\([ *] \\)" ; 1: current branch marker
+ "\\(.+?\\) +" ; 2: branch name
+
+ "\\(?:"
+
+ "\\([0-9a-fA-F]+\\)" ; 3: sha1
+ " "
+ "\\(?:\\["
+ "\\([^:\n]+?\\)" ; 4: tracking (non-greedy + to avoid matching \n)
+ "\\(?:: \\)?"
+ "\\(?:ahead \\([0-9]+\\)\\)?" ; 5: ahead
+ "\\(?:, \\)?"
+ "\\(?:behind \\([0-9]+\\)\\)?" ; 6: behind
+ "\\] \\)?"
+ "\\(?:.*\\)" ; message
+
+ "\\|" ; or
+
+ "-> " ; the pointer to
+ "\\(.+\\)" ; 7: a ref
+
+ "\\)\n"))
+
+ (let* ((current-string (match-string 1))
+ (branch (match-string 2))
+ (sha1 (match-string 3))
+ (tracking (match-string 4))
+ (ahead (match-string 5))
+ (behind (match-string 6))
+ (other-ref (match-string 7))
+ (current (string-match-p "^\\*" current-string)))
+
+ ; the current line is deleted before being reconstructed
+ (delete-region (point)
+ (line-beginning-position 2))
+
+ (magit-with-section branch 'branch
+ (magit-set-section-info branch)
+ (insert-before-markers
+ ; sha1
+ (propertize (or sha1
+ (make-string magit-sha1-abbrev-length ? ))
+ 'face 'magit-log-sha1)
+ " "
+ ; current marker
+ (if current
+ "# "
+ " ")
+ ; branch name
+ (apply 'propertize (magit-branch-no-remote branch)
+ (if current
+ '(face magit-branch)))
+ ; other ref that this branch is pointing to
+ (if other-ref
+ (concat " -> " (substring other-ref (+ 1 (length remote-name))))
+ "")
+ ; tracking information
+ (if (and tracking
+ (equal (magit-remote-branch-for branch t)
+ (concat "refs/remotes/" tracking)))
+ (concat " ["
+ ; getting rid of the tracking branch name if it is the same as the branch name
+ (let* ((tracking-remote (magit-get "branch" branch "remote"))
+ (tracking-branch (substring tracking (+ 1 (length tracking-remote)))))
+ (propertize (if (string= branch tracking-branch)
+ (concat "@ " tracking-remote)
+ (concat tracking-branch " @ " tracking-remote))
+ 'face 'magit-log-head-label-remote))
+ ; ahead/behind information
+ (if (or ahead
+ behind)
+ ": "
+ "")
+ (if ahead
+ (concat "ahead "
+ (propertize ahead
+ 'face (if current
+ 'magit-branch))
+ (if behind
+ ", "
+ ""))
+ "")
+ (if behind
+ (concat "behind "
+ (propertize behind
+ 'face 'magit-log-head-label-remote))
+ "")
+ "]")
+ "")
+ "\n"))))
+
+(defun magit-wash-remote-branches-group (group)
+ (let* ((remote-name (first group))
+ (url (magit-get "remote" remote-name "url"))
+ (push-url (magit-get "remote" remote-name "pushurl"))
+ (urls (concat url (if push-url
+ (concat ", "push-url)
+ "")))
+ (marker (second group)))
+
+ (magit-with-section (concat "remote:" remote-name) 'remote
+ (magit-set-section-info remote-name)
+ (insert-before-markers (propertize (format "%s (%s):" remote-name urls) 'face 'magit-section-title) "\n")
+ (magit-wash-branches-between-point-and-marker marker remote-name))
+ (insert-before-markers "\n")))
+
+(defun magit-wash-branches-between-point-and-marker (marker &optional remote-name)
+ (save-restriction
+ (narrow-to-region (point) marker)
+ (magit-wash-sequence
+ (if remote-name
+ (apply-partially 'magit-wash-branch-line remote-name)
+ #'magit-wash-branch-line))))
+
+(defun magit-wash-branches ()
+ ; get the names of the remotes
+ (let* ((remotes (magit-git-lines "remote"))
+ ; get the location of remotes in the buffer
+ (markers
+ (append (mapcar (lambda (remote)
+ (save-excursion
+ (when (search-forward-regexp
+ (concat "^ remotes\\/" remote) nil t)
+ (beginning-of-line)
+ (point-marker))))
+ remotes)
+ (list (save-excursion
+ (goto-char (point-max))
+ (point-marker)))))
+ ; list of remote elements to display in the buffer
+ (remote-groups (loop for remote in remotes
+ for end-markers on (cdr markers)
+ for marker = (loop for x in end-markers thereis x)
+ collect (list remote marker))))
+
+ ; actual displaying of information
+ (magit-with-section "local" nil
+ (insert-before-markers (propertize "Local:" 'face 'magit-section-title) "\n")
+ (magit-set-section-info ".")
+ (magit-wash-branches-between-point-and-marker
+ (loop for x in markers thereis x)))
+
+ (insert-before-markers "\n")
+
+ (mapc 'magit-wash-remote-branches-group remote-groups)
+
+ ; make sure markers point to nil so that they can be garbage collected
+ (mapc (lambda (marker)
+ (when marker
+ (set-marker marker nil)))
+ markers)))
+
+(defun magit-refresh-branch-manager ()
+ (magit-create-buffer-sections
+ (magit-git-section "branches" nil 'magit-wash-branches
+ "branch"
+ "-vva"
+ (format "--abbrev=%s" magit-sha1-abbrev-length))))
+
+(magit-define-command branch-manager ()
+ (interactive)
+ (let ((topdir (magit-get-top-dir default-directory)))
+ (magit-buffer-switch magit-branches-buffer-name)
+ (magit-mode-init topdir 'magit-branch-manager-mode #'magit-refresh-branch-manager)))
+
+(defun magit-change-what-branch-tracks ()
+ "Change which remote branch the current branch tracks."
+ (interactive)
+ (if (magit--is-branch-at-point-remote)
+ (error "Cannot modify a remote branch"))
+ (let* ((local-branch (magit--branch-name-at-point))
+ (new-tracked (magit-read-rev "Change tracked branch to"
+ nil
+ (lambda (ref)
+ (not (string-match-p "refs/remotes/"
+ ref)))))
+ new-remote new-branch)
+ (unless (string= (or new-tracked "") "")
+ (cond (;; Match refs that are unknown in the local repository if
+ ;; `magit-remote-ref-format' is set to
+ ;; `name-then-remote'. Can be useful if you want to
+ ;; create a new branch in a remote repository.
+ (string-match "^\\([^ ]+\\) +(\\(.+\\))$" ; 1: branch name; 2: remote name
+ new-tracked)
+ (setq new-remote (match-string 2 new-tracked)
+ new-branch (concat "refs/heads/" (match-string 1 new-tracked))))
+ ((string-match "^\\(?:refs/remotes/\\)?\\([^/]+\\)/\\(.+\\)" ; 1: remote name; 2: branch name
+ new-tracked)
+ (setq new-remote (match-string 1 new-tracked)
+ new-branch (concat "refs/heads/" (match-string 2 new-tracked))))
+ (t (error "Cannot parse the remote and branch name"))))
+ (magit-set new-remote "branch" local-branch "remote")
+ (magit-set new-branch "branch" local-branch "merge")
+ (magit-branch-manager)
+ (if (string= (magit-get-current-branch) local-branch)
+ (magit-refresh-buffer (magit-find-status-buffer default-directory)))))
+
+(defvar magit-ediff-file)
+
+(defun magit-interactive-resolve (file)
+ (require 'ediff)
+ (let ((merge-status (magit-git-string "ls-files" "-u" "--" file))
+ (base-buffer (generate-new-buffer (concat file ".base")))
+ (our-buffer (generate-new-buffer (concat file ".current")))
+ (their-buffer (generate-new-buffer (concat file ".merged")))
+ (windows (current-window-configuration)))
+ (if (null merge-status)
+ (error "Cannot resolve %s" file))
+ (with-current-buffer base-buffer
+ (if (string-match "^[0-9]+ [0-9a-f]+ 1" merge-status)
+ (insert (magit-git-output `("cat-file" "blob" ,(concat ":1:" file))))))
+ (with-current-buffer our-buffer
+ (if (string-match "^[0-9]+ [0-9a-f]+ 2" merge-status)
+ (insert (magit-git-output `("cat-file" "blob" ,(concat ":2:" file)))))
+ (let ((buffer-file-name file))
+ (normal-mode)))
+ (with-current-buffer their-buffer
+ (if (string-match "^[0-9]+ [0-9a-f]+ 3" merge-status)
+ (insert (magit-git-output `("cat-file" "blob" ,(concat ":3:" file)))))
+ (let ((buffer-file-name file))
+ (normal-mode)))
+ ;; We have now created the 3 buffer with ours, theirs and the ancestor files
+ (with-current-buffer (ediff-merge-buffers-with-ancestor our-buffer their-buffer base-buffer)
+ (make-local-variable 'magit-ediff-file)
+ (setq magit-ediff-file file)
+ (make-local-variable 'magit-ediff-windows)
+ (setq magit-ediff-windows windows)
+ (make-local-variable 'ediff-quit-hook)
+ (add-hook 'ediff-quit-hook
+ (lambda ()
+ (let ((buffer-A ediff-buffer-A)
+ (buffer-B ediff-buffer-B)
+ (buffer-C ediff-buffer-C)
+ (buffer-Ancestor ediff-ancestor-buffer)
+ (file magit-ediff-file)
+ (file-buffer)
+ (windows magit-ediff-windows))
+ (ediff-cleanup-mess)
+ (find-file file)
+ (setq file-buffer (current-buffer))
+ (erase-buffer)
+ (insert-buffer-substring buffer-C)
+ (kill-buffer buffer-A)
+ (kill-buffer buffer-B)
+ (kill-buffer buffer-C)
+ (when (bufferp buffer-Ancestor) (kill-buffer buffer-Ancestor))
+ (set-window-configuration windows)
+ (magit-save-some-buffers
+ "Conflict resolution finished; you may save the buffer"
+ (lambda () (eq (current-buffer) file-buffer)))))))))
+
+(defun magit-interactive-resolve-item ()
+ (interactive)
+ (magit-section-action (item info "resolv")
+ ((diff)
+ (magit-interactive-resolve (cadr info)))))
+
+(defun magit-submodule-update (&optional init)
+ "Update the submodule of the current git repository
+
+With a prefix arg, do a submodule update --init"
+ (interactive "P")
+ (let ((default-directory (magit-get-top-dir default-directory)))
+ (apply #'magit-run-git-async "submodule" "update" (if init '("--init") ()))))
+
+(defun magit-submodule-update-init ()
+ "Update and init the submodule of the current git repository."
+ (interactive)
+ (magit-submodule-update t))
+
+(defun magit-submodule-init ()
+ "Initialize the submodules"
+ (interactive)
+ (let ((default-directory (magit-get-top-dir default-directory)))
+ (magit-run-git-async "submodule" "init")))
+
+(defun magit-submodule-sync ()
+ "Synchronizes submodules' remote URL configuration"
+ (interactive)
+ (let ((default-directory (magit-get-top-dir default-directory)))
+ (magit-run-git-async "submodule" "sync")))
+
+(defun magit-run-git-gui ()
+ "Run `git gui' for the current git repository"
+ (interactive)
+ (let* ((default-directory (magit-get-top-dir default-directory)))
+ (magit-start-process "Git Gui" nil magit-git-executable "gui")))
+
+(defun magit-run-gitk ()
+ "Run `gitk --all' for the current git repository"
+ (interactive)
+ (let ((default-directory (magit-get-top-dir default-directory)))
+ (cond
+ ((eq system-type 'windows-nt)
+ ;; Gitk is a shell script, and Windows doesn't know how to
+ ;; "execute" it. The Windows version of Git comes with an
+ ;; implementation of "sh" and everything else it needs, but
+ ;; Windows users might not have added the directory where it's
+ ;; installed to their path
+ (let ((git-bin-dir (file-name-directory magit-gitk-executable))
+ (exec-path exec-path)
+ (process-environment process-environment))
+ (when git-bin-dir
+ ;; Adding it onto the end so that anything the user
+ ;; specified will get tried first. Emacs looks in
+ ;; exec-path; PATH is the environment variable inherited by
+ ;; the process. I need to change both.
+ (setq exec-path (append exec-path (list git-bin-dir)))
+ (push (format "PATH=%s;%s"
+ (getenv "PATH")
+ (replace-regexp-in-string "/" "\\\\" git-bin-dir))
+ process-environment))
+ (magit-start-process "Gitk" nil "sh" magit-gitk-executable "--all")))
+ (t
+ (magit-start-process "Gitk" nil magit-gitk-executable "--all")))))
+
+(defun magit-load-config-extensions ()
+ "Try to load magit extensions that are defined at git config
+layer. This can be added to `magit-mode-hook' for example"
+ (dolist (ext (magit-get-all "magit.extension"))
+ (let ((sym (intern (format "magit-%s-mode" ext))))
+ (when (and (fboundp sym)
+ (not (eq sym 'magit-wip-save-mode)))
+ (funcall sym 1)))))
+
+(provide 'magit)
+
+;; rest of magit core
+(require 'magit-key-mode)
+(require 'magit-bisect)
+
+;;; magit.el ends here
--- /dev/null
+;;; 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 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 <marius.vollmerNOSPAMnokia.com>
+;; Former Maintainer: Phil Jackson <philNOSPAMshellarchive.co.uk>
+;; Maintenance Group: https://github.com/organizations/magit/teams/53130
+;; 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
+;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
+;; License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with Magit. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; 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
+(eval-and-compile
+ (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)
+ "gitk")
+ "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
+ 'magit-save-buffers-predicate-tree-only
+ "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
+ 'magit-default-tracking-name-remote-plus-branch
+ "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
+completion.
+
+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'
+
+ A'---B'---C'---D'
+ ^
+
+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.
+
+ A---B'---C'---D'
+ ^"
+ :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
+ '((t))
+ "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)
+ map))
+
+(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)
+ map))
+
+(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)
+ map))
+
+(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)
+ map))
+
+(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)
+ map))
+
+(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)
+ map))
+
+(defvar magit-bug-report-url
+ "http://github.com/magit/magit/issues")
+
+(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"
+ "%s\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
+
+(eval-and-compile
+ (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)
+ most-positive-fixnum
+ 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)
+ most-positive-fixnum
+ (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."
+ `(set-buffer-modified-p
+ (prog1 (buffer-modified-p)
+ (let ((buffer-undo-list t)
+ before-change-functions
+ after-change-functions)
+ ,@body)))))
+
+ (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)
+ (magit-refresh-all))
+
+(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)
+ 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)
+ choices)
+ predicate require-match initial-input hist def)))
+ (if (consp (first choices))
+ (or (cdr (assoc selected choices))
+ selected)
+ selected)))
+
+(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)
+ prompt)
+ choices predicate require-match initial-input hist def))
+
+(defun magit-completing-read (prompt choices &optional predicate require-match
+ initial-input hist def)
+ (funcall magit-completing-read-function prompt choices predicate require-match
+ initial-input hist def))
+
+(defun magit-use-region-p ()
+ (if (fboundp 'use-region-p)
+ (use-region-p)
+ (and transient-mark-mode mark-active)))
+
+(defun magit-goto-line (line)
+ "Like `goto-line' but doesn't set the mark."
+ (save-restriction
+ (widen)
+ (goto-char 1)
+ (forward-line (1- line))))
+
+(defun magit-trim-line (str)
+ (if (string= str "")
+ nil
+ (if (equal (elt str (- (length str) 1)) ?\n)
+ (substring str 0 (- (length str) 1))
+ str)))
+
+(defun magit-split-lines (str)
+ (if (string= str "")
+ nil
+ (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
+ cmd
+ nil (list t nil) nil
+ args)))))
+ (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)
+ (with-temp-buffer
+ (insert-file-contents file)
+ (let ((rev (nreverse (split-string (buffer-string) "\n"))))
+ (nreverse (if (equal (car rev) "")
+ (cdr rev)
+ rev))))))
+
+(defun magit-write-file-lines (file lines)
+ (with-temp-buffer
+ (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 "."))
+ "true"))
+
+(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))
+ 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)
+ entry)))
+ value))))
+ (setq result (append result sub)))))
+ dict)
+ result))
+
+(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)
+ (magit-remove-conflicts
+ (apply #'append
+ (mapcar (lambda (dir)
+ (mapcar #'(lambda (repo)
+ (cons (file-name-nondirectory repo)
+ repo))
+ (magit-list-repos* dir 0)))
+ dirs))))
+
+(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)
+ nil)))
+
+(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)))
+ (file-name-as-directory
+ (or (cdr (assoc reply repos))
+ (if (file-directory-p reply)
+ (expand-file-name reply)
+ (error "Not a repository or a directory: %s" reply)))))
+ (file-name-as-directory
+ (read-directory-name "Git repository: "
+ (or (magit-get-top-dir default-directory)
+ 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)
+ modifier))
+ ;; 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))))
+ rev)))
+
+(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]*\\)"
+ magit-current-indentation))))
+ (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)
+ commit))
+
+(defun magit-current-line ()
+ (buffer-substring-no-properties (line-beginning-position)
+ (line-end-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)
+ nil)))
+
+;;; 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))))
+ (t
+ (let ((fmt-ref (magit-format-ref ref)))
+ (when fmt-ref
+ (push (cons fmt-ref
+ (replace-regexp-in-string "^refs/heads/"
+ "" ref))
+ refs))))))))
+ (nreverse refs)))
+
+(defun magit-format-ref (ref)
+ "Convert fully-specified ref REF into its displayable form
+according to `magit-remote-ref-format'"
+ (cond
+ ((null ref)
+ nil)
+ ((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)"
+ "%s")
+ (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))
+ (with-temp-buffer
+ (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)))
+ 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)
+ nil
+ 'require-match
+ nil
+ 'magit-read-file-hist
+ (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 "")
+ nil
+ rev)))
+
+(defun magit-read-rev-range (op &optional def-beg def-end)
+ (let ((beg (magit-read-rev (format "%s start" op)
+ def-beg)))
+ (if (not beg)
+ nil
+ (save-match-data
+ (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 ".")
+ (magit-marked-commit)
+ rev))
+
+(defun magit-rev-range-to-git (range)
+ (or range
+ (error "No revision range specified"))
+ (if (stringp range)
+ 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 ".")
+ "mark"
+ (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)
+ 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
+ (mapcar
+ (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
+ needs-refresh-on-show)
+
+(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)
+ magit-old-top-section))))
+ (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)))
+ s))
+
+(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))
+ ,@body
+ (setf (magit-section-end ,s) (point))
+ (setf (magit-section-children ,s)
+ (nreverse (magit-section-children ,s)))
+ ,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)
+ section))
+
+(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))
+ flag))
+
+(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))
+ (erase-buffer)
+ (let ((magit-old-top-section magit-top-section))
+ (setq magit-top-section nil)
+ ,@body
+ (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)
+ top
+ (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)
+ section)
+ next)
+ (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)))
+ prev))
+
+(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)
+ magit-top-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-title-and-type))
+ (section-type (if (consp section-title-and-type)
+ (cdr section-title-and-type)
+ nil))
+ (section
+ (magit-with-section section-title section-type
+ (if buffer-title
+ (insert (propertize buffer-title 'face 'magit-section-title)
+ "\n"))
+ (setq body-beg (point))
+ (magit-cmd-insert cmd args)
+ (if (not (eq (char-before) ?\n))
+ (insert "\n"))
+ (if washer
+ (save-restriction
+ (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"))
+ section))
+
+(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
+ section-title-and-type
+ buffer-title
+ washer
+ magit-git-executable
+ (append magit-git-standard-options args)))
+
+(defun magit-goto-next-section ()
+ "Go to the next section."
+ (interactive)
+ (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."
+ (interactive)
+ (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."
+ (interactive)
+ (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."
+ (interactive)
+ (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)
+ (magit-goto-next-section))))
+
+(defun magit-goto-previous-sibling-section ()
+ "Go to the previous sibling section."
+ (interactive)
+ (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)
+ (magit-goto-parent-section))))
+
+(defun magit-goto-section (section)
+ (goto-char (magit-section-beginning section))
+ (cond
+ ((and magit-log-auto-more
+ (eq (magit-section-type section) 'longer))
+ (magit-log-show-more-entries)
+ (forward-line -1)
+ (magit-goto-next-section))
+ ((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))
+ (magit-refresh)
+ (let ((inhibit-read-only t)
+ (beg (save-excursion
+ (goto-char (magit-section-beginning section))
+ (forward-line)
+ (point)))
+ (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)))
+ 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."
+ (interactive)
+ (magit-section-hideshow nil))
+
+(defun magit-hide-section ()
+ "Hide current section."
+ (interactive)
+ (magit-section-hideshow t))
+
+(defun magit-collapse-section ()
+ "Hide all subsection of current section."
+ (interactive)
+ (magit-section-hideshow #'magit-section-collapse))
+
+(defun magit-expand-section ()
+ "Show all subsection of current section."
+ (interactive)
+ (magit-section-hideshow #'magit-section-expand))
+
+(defun magit-toggle-file-section ()
+ "Like `magit-toggle-section' but toggle at file granularity."
+ (interactive)
+ (when (eq 'hunk (first (magit-section-context-type (magit-current-section))))
+ (magit-goto-parent-section))
+ (magit-toggle-section))
+
+(defun magit-toggle-section ()
+ "Toggle hidden status of current section."
+ (interactive)
+ (magit-section-hideshow
+ (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."
+ (interactive)
+ (magit-section-hideshow
+ (lambda (s)
+ (cond ((magit-section-any-hidden s)
+ (magit-section-expand-all s))
+ (t
+ (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."
+ (interactive)
+ (magit-section-hideshow
+ (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))
+ (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."
+ (magit-with-refresh
+ (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."
+ (interactive)
+ (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"
+ (interactive)
+ (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 ()
+ ,doc
+ (interactive)
+ (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."
+ `(progn
+ (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)))
+ `(progn
+ (defun ,fun ()
+ ,doc
+ (interactive)
+ (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)))
+ `(progn
+ (defvar ,before nil)
+ (defvar ,after nil)
+ (defun ,fun ,arglist
+ ,doc
+ (run-hooks ',before)
+ ,@body
+ (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)
+ magit-diff-refine-hunk
+ (not (eq magit-diff-refine-hunk 'all)))
+ ;; Refine the current hunk to show fine details, using
+ ;; diff-mode machinery.
+ (save-excursion
+ (goto-char (magit-section-beginning magit-highlighted-section))
+ (diff-refine-hunk))))))
+
+(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)
+ magit-diff-refine-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))
+ (progn
+ (magit-refine-section section)
+ (move-overlay magit-highlight-overlay
+ (magit-section-beginning section)
+ (magit-section-end section)
+ (current-buffer)))
+ (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
+lists.
+
+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.
+
+HEAD is (SECTION INFO &optional OPNAME),
+ 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))
+ t))
+ (let ((prefix (reverse (car clause)))
+ (body (cdr clause)))
+ `((magit-prefix-p ',prefix ,context)
+ (or (progn ,@body)
+ t)))))
+ clauses)
+ ,@(when opname
+ `(((run-hook-with-args-until-success
+ ',(intern (format "magit-%s-action-hook" opname))))
+ ((not ,type)
+ (error "Nothing to %s here" ,opname))
+ (t
+ (error "Can't %s a %s"
+ ,opname
+ (or (get ,type 'magit-description)
+ ,type)))))))))
+
+(defmacro magit-section-action (head &rest clauses)
+ (declare (indent 1))
+ `(magit-with-refresh
+ (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 ()
+ ,(macroexpand
+ ;; 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)
+ ,@clauses))))))
+
+(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)]
+ def-body)))
+ (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))))
+ `(progn
+ (defvar ,hook nil)
+ (defun ,fun ,arglist
+ ,doc
+ ,inter
+ (or (run-hook-with-args-until-success
+ ',hook ,@(remq '&optional (remq '&rest arglist)))
+ ,@instr))
+ (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) "")))
+ (save-excursion
+ (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)
+ comps)
+ (setq comps (nthcdr (+ (length magit-git-standard-options) 1) comps)))
+ (cond ((or (null (cdr comps))
+ (not (member (car comps) '("remote"))))
+ (car comps))
+ (t
+ (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-set-mode-line-process
+ (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
+ (bury-buffer))))
+ (setq buffer-read-only t)
+ (let ((inhibit-read-only t))
+ (setq default-directory dir)
+ (if noerase
+ (goto-char (point-max))
+ (erase-buffer))
+ (insert "$ " (or logline
+ (mapconcat 'identity cmd-and-args " "))
+ "\n")
+ (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)
+ (run-with-timer
+ magit-process-popup-time nil
+ (function
+ (lambda (buf)
+ (with-current-buffer buf
+ (when magit-process
+ (display-buffer (process-buffer magit-process))
+ (goto-char (point-max))))))
+ (current-buffer))))
+ (setq successp t))
+ (input
+ (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))
+ (t
+ (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
+ noerror
+ (error
+ "%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
+ 'magit-display-process))))
+ magit-process-buffer-name))
+ successp)))
+
+(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
+ 'magit-display-process))))))
+ (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
+ (concat
+ (read-string (format "Username for '%s': "
+ (match-string 1 string))
+ nil nil (user-login-name))
+ "\n"))))
+
+(defun magit-process-filter (proc string)
+ (save-current-buffer
+ (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))))
+ (t
+ (insert string))))
+ (set-marker (process-mark proc) (point)))))
+
+(defun magit-run (cmd &rest args)
+ (magit-with-refresh
+ (magit-run* (cons cmd args))))
+
+(defun magit-run-git (&rest args)
+ (magit-with-refresh
+ (magit-run* (append (cons magit-git-executable
+ magit-git-standard-options)
+ args))))
+
+(defun magit-run-git-with-input (input &rest args)
+ (magit-with-refresh
+ (magit-run* (append (cons magit-git-executable
+ magit-git-standard-options)
+ args)
+ 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
+ magit-git-standard-options)
+ args)
+ 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."
+ (interactive)
+ (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"
+ '("Magit"
+ ["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]
+ ("Log"
+ ["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]
+ ("Rewrite"
+ ["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"
+ ["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])
+ "---"
+ ("Extensions")
+ "---"
+ ["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)))
+ pos)
+
+(defun magit-invisible-region-start (pos)
+ (while (and (not (= pos (point-min))) (invisible-p pos))
+ (setq pos (1- (previous-char-property-change pos))))
+ 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
+adjustments.
+
+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))
+ end))))
+ (setq disable-point-adjustment t))
+
+(defun magit-post-command-hook ()
+ (magit-correct-point-after-command)
+ (magit-highlight-section))
+
+(defun magit-mode ()
+ "Review the status of a git repository and act on it.
+
+Please see the manual for a complete description of Magit.
+
+\\{magit-mode-map}"
+ (kill-all-local-variables)
+ (buffer-disable-undo)
+ (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)
+ (magit-refresh-buffer))
+
+(defun magit-indentation-for (dir)
+ (let (result)
+ (dolist (pair magit-highlight-indentation)
+ (if (string-match-p (car pair) dir)
+ (setq result (cdr pair))))
+ result))
+
+(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)
+ default-directory
+ (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)))))
+ (beginning-of-line)
+ (let ((section-line (and old-section
+ (count-lines
+ (magit-section-beginning old-section)
+ (point))))
+ (line-char (- old-point (point))))
+ (if magit-refresh-function
+ (apply magit-refresh-function
+ magit-refresh-args))
+ (magit-refresh-marked-commits-in-buffer)
+ (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))
+ (t
+ (magit-goto-line old-line)))
+ (dolist (w (get-buffer-window-list (current-buffer)))
+ (set-window-point w (point)))
+ (magit-highlight-section))))))
+
+(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
+ (vc-find-file-hook)
+ (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))
+ (unwind-protect
+ (funcall func)
+ (when magit-refresh-needing-buffers
+ (magit-revert-buffers dir)
+ (dolist (b (adjoin status-buffer
+ magit-refresh-needing-buffers))
+ (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."
+ (interactive)
+ (magit-with-refresh
+ (magit-need-refresh)))
+
+(defun magit-refresh-all ()
+ "Refresh all magit buffers to match respective repository states.
+Also revert every unmodified buffer visiting files
+in the corresponding directories."
+ (interactive)
+ (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"))
+ t)
+ nil))
+
+(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
+ "Untracked files:"
+ magit-wash-untracked-files
+ "ls-files" "--others" "-t" "--exclude-standard"
+ ,@(when magit-omit-untracked-dir-contents
+ '("--directory"))))))
+
+;;; 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)))
+ (magit-refresh))
+
+(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))
+ (magit-refresh))
+
+(defun magit-diff-default-hunks ()
+ "Reset context for diff hunks to the default size."
+ (interactive "")
+ (setq magit-diff-context-lines 3)
+ (magit-refresh))
+
+(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)
+ (new
+ (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))
+ (magit-refresh))))
+
+(defun magit-diff-line-file ()
+ (cond ((looking-at "^diff --git ./\\(.*\\) ./\\(.*\\)$")
+ (match-string-no-properties 2))
+ ((looking-at "^diff --cc +\\(.*\\)$")
+ (match-string-no-properties 1))
+ (t
+ nil)))
+
+(defun magit-wash-diffs ()
+ (magit-wash-sequence #'magit-wash-diff-or-other-file))
+
+(defun magit-wash-diff-or-other-file ()
+ (or (magit-wash-diff)
+ (magit-wash-other-file)))
+
+(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"))
+ t)
+ nil))
+
+(defvar magit-hide-diffs nil)
+
+(defvar magit-indentation-level 1)
+
+(defun magit-insert-diff-title (status file file2)
+ (let ((status-text (case status
+ ((unmerged)
+ (format "Unmerged %s" file))
+ ((new)
+ (format "New %s" file))
+ ((deleted)
+ (format "Deleted %s" file))
+ ((renamed)
+ (format "Renamed %s (from %s)"
+ file file2))
+ ((modified)
+ (format "Modified %s" file))
+ ((typechange)
+ (format "Typechange %s" file))
+ (t
+ (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")
+ (beginning-of-line)
+ (point-marker))))
+ (let ((magit-indentation-level (+ magit-indentation-level 1)))
+ (save-restriction
+ (narrow-to-region first-start second-start)
+ (goto-char (point-min))
+ (magit-with-section file 'diff
+ (magit-wash-diff-section)))
+ (save-restriction
+ (narrow-to-region second-start (point-max))
+ (goto-char (point-min))
+ (magit-with-section file 'diff
+ (magit-wash-diff-section))))))
+
+(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))
+ t))
+ ((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)))
+ (point-marker))))
+ (let* ((status (cond
+ ((looking-at "^diff --cc")
+ 'unmerged)
+ ((save-excursion
+ (search-forward-regexp "^new file" end t))
+ 'new)
+ ((save-excursion
+ (search-forward-regexp "^deleted" end t))
+ 'deleted)
+ ((save-excursion
+ (search-forward-regexp "^rename" end t))
+ 'renamed)
+ (t
+ 'modified)))
+ (file2 (cond
+ ((save-excursion
+ (search-forward-regexp "^rename from \\(.*\\)"
+ end t))
+ (match-string-no-properties 1)))))
+ (magit-set-section-info (list status
+ file
+ (or file2 file)
+ magit-current-diff-range))
+ (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))))
+ t)
+ (t
+ nil)))
+
+(defun magit-wash-diff ()
+ (let ((magit-section-hidden-default magit-hide-diffs))
+ (magit-with-section (magit-current-line) 'diff
+ (magit-wash-diff-section))))
+
+(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))
+ (forward-line)
+ (while (not (or (eobp)
+ (looking-at "^diff\\|^@@")))
+ (magit-highlight-line-whitespace)
+ (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))
+ (t
+ (magit-put-line-property 'face 'magit-diff-none))))
+ (forward-line)))
+
+ (when (eq magit-diff-refine-hunk 'all)
+ (save-excursion
+ (goto-char hunk-start-pos)
+ (diff-refine-hunk))))
+ t)
+ (t
+ nil)))
+
+(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))
+ magit-diff-options
+ (list "--" file))))
+ (let ((p (point)))
+ (magit-git-insert args)
+ (if (not (eq (char-before) ?\n))
+ (insert "\n"))
+ (save-restriction
+ (narrow-to-region p (point))
+ (goto-char p)
+ (cond
+ ((eq status 'typechange)
+ (magit-insert-diff-title status file file)
+ (magit-wash-typechange-section file))
+ (t
+ (magit-wash-diff-section)))
+ (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)))))
+ t)
+ 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"))
+ diff))
+
+(defun magit-diff-item-insert-header (diff buf)
+ (let ((beg (save-excursion
+ (goto-char (magit-section-beginning diff))
+ (forward-line)
+ (point)))
+ (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))
+ (forward-line)
+ (point)))
+ (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)
+ buf))
+
+(defun magit-insert-hunk-item-region-patch (hunk reverse beg end buf)
+ (magit-diff-item-insert-header (magit-hunk-item-diff hunk) buf)
+ (save-excursion
+ (goto-char (magit-section-beginning hunk))
+ (magit-insert-current-line buf)
+ (forward-line)
+ (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))))))
+ (forward-line))))
+ (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)
+ (save-excursion
+ (beginning-of-line)
+ (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))))
+ (forward-line)
+ (while (< (line-number-at-pos) line)
+ ;; XXX - deal with combined diffs
+ (if (not (looking-at "-"))
+ (setq target (+ target 1)))
+ (forward-line))
+ target))))
+
+(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))))))
+ (cond
+ ((eq commit 'index)
+ (let ((checkout-string (magit-git-string "checkout-index"
+ "--temp"
+ filename)))
+ (string-match "^\\(.*\\)\t" checkout-string)
+ (with-current-buffer buffer
+ (let ((tmpname (match-string 1 checkout-string)))
+ (magit-with-silent-modifications
+ (insert-file-contents tmpname nil nil nil t))
+ (delete-file tmpname)))))
+ (t
+ (with-current-buffer buffer
+ (magit-with-silent-modifications
+ (magit-git-insert (list "cat-file" "-p"
+ (concat commit ":" filename)))))))
+ (with-current-buffer buffer
+ (let ((buffer-file-name filename))
+ (normal-mode))
+ (goto-char (point-min)))
+ (if select
+ (if prefix
+ (switch-to-buffer buffer)
+ (switch-to-buffer-other-window buffer))
+ 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)))
+ (unwind-protect
+ (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
+ (magit-insert-hunk-item-region-patch
+ 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
+ "diff-files"))))
+
+(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")
+ "HEAD")))
+ (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"
+ base))))))
+
+;;; Logs and Commits
+
+ ; Note: making this a plain defcustom would probably let users break
+ ; the parser too easily
+(defvar magit-git-log-options
+ (list
+ "--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
+ (concat
+ "\\(?:HEAD\\|"
+
+ "\\(?:tag: \\)?"
+
+ ;; optional non-slash sequence at the beginning
+ magit-ref-nonslash-re
+
+ ;; any number of slash-prefixed sequences
+ "\\(?:"
+ "/"
+ magit-ref-nonslash-re
+ "\\)*"
+
+ "/" ;; "must contain at least one /." (rule 2)
+ magit-ref-nonslash-re
+
+ ;; "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
+ (concat
+ "^\\([_\\*|/ -.]+\\)?" ; graph (1)
+ "\\(?:"
+ "\\([0-9a-fA-F]+\\)" ; sha1 (2)
+ "\\(?:" ; refs (3)
+ " "
+ "\\("
+ "("
+ magit-refname-re "\\(?:, " magit-refname-re "\\)*"
+ ")"
+ "\\)"
+ "\\)?"
+ "\\)?"
+ " ?\\(.*\\)$" ; msg (4)
+ ))
+
+(defconst magit-log-longline-re
+ (concat
+ ;; use \0 delimiter (from -z option) to identify commits. this prevents
+ ;; commit messages containing lines like "commit 00000" from polluting the
+ ;; display
+ "\\(?:\\(?:\\`\\|\0\\)"
+ "\\([_\\*|/ -.]+\\)?" ; 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))
+ 'magit-log-head-label-patches))
+
+(defvar magit-log-remotes-color-hook nil)
+
+(defun magit-log-get-remotes-color (suffix)
+ (or
+ (run-hook-with-args-until-success
+ '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)
+ magit-refs-namespaces))))
+ (cond ((null colorizer)
+ (list r 'magit-log-head-label-default))
+ ((symbolp colorizer)
+ (list label colorizer))
+ ((listp colorizer)
+ (funcall (car colorizer)
+ (match-string 2 r)))
+ (t
+ (list r 'magit-log-head-label-default))))))
+ res))))
+
+(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))))
+ refs))))
+ (concat
+ (mapconcat 'identity colored-labels " ")
+ " ")))))
+
+ (concat
+ (if sha1
+ (propertize sha1 'face 'magit-log-sha1)
+ (insert-char ? magit-sha1-abbrev-length))
+ " "
+ (when graph
+ (propertize graph 'face 'magit-log-graph))
+ string-refs
+ (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-create-buffer-sections
+ (magit-with-section 'log nil
+ ,@body
+ (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)
+ (beginning-of-line)
+ (let ((line-re (cond ((eq style 'long) magit-log-longline-re)
+ (t magit-log-oneline-re))))
+ (cond
+ ((looking-at line-re)
+ (let ((chart (match-string 1))
+ (sha1 (match-string 2))
+ (msg (match-string 4))
+ (refs (when (match-string 3)
+ (delq nil
+ (mapcar
+ (lambda (s)
+ (and (not
+ (or (string= s "tag:")
+ (string= s "HEAD"))) ; as of 1.6.6
+ s))
+ (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)
+ (forward-line))
+ (forward-line))))
+ (t
+ (forward-line)))
+ t))
+
+(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)))
+ (cond
+ ((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))
+ magit-current-diff-range))
+ (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)))
+ (t
+ (setq magit-current-diff-range (cons (concat magit-current-diff-range "^")
+ 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)))))
+ (beginning-of-line)
+ (when (looking-at "^diff")
+ (magit-wash-diffs))
+ (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)
+ (save-excursion
+ (goto-char button)
+ (magit-visit-item)))
+ 'follow-link t
+ 'mouse-face 'magit-item-highlight
+ 'face 'magit-log-sha1))
+
+(defun magit-refresh-commit-buffer (commit)
+ (magit-configure-have-abbrev)
+ (magit-configure-have-decorate)
+ (magit-create-buffer-sections
+ (apply #'magit-git-section nil nil
+ 'magit-wash-commit
+ "log"
+ "--max-count=1"
+ "--pretty=medium"
+ `(,@(if magit-have-abbrev (list "--no-abbrev-commit"))
+ ,@(if magit-have-decorate (list "--decorate=full"))
+ "--cc"
+ "-p" ,commit))))
+
+(define-derived-mode magit-commit-mode magit-mode "Magit"
+ "Mode to view a git commit.
+
+\\{magit-commit-mode-map}"
+ :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)))
+ (cond
+ ((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))
+ (scroll
+ (with-selected-window win
+ (funcall scroll))))))
+ (commit
+ (display-buffer buf)
+ (with-current-buffer buf
+ (unless inhibit-history
+ (push (cons default-directory magit-currently-shown-commit)
+ magit-back-navigation-history)
+ (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
+`magit-commit-buffer-name`."
+ (interactive)
+ (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)
+ magit-forward-navigation-history)
+ (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
+`magit-commit-buffer-name`."
+ (interactive)
+ (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)
+ magit-back-navigation-history)
+ (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)
+ (magit-for-all-sections
+ (lambda (section)
+ (when (and (eq (magit-section-type section) 'commit)
+ (equal (magit-section-info section)
+ magit-marked-commit))
+ (move-overlay magit-mark-overlay
+ (magit-section-beginning section)
+ (magit-section-end section)
+ (current-buffer))))))
+
+(defun magit-set-marked-commit (commit)
+ (setq magit-marked-commit commit)
+ (magit-refresh-marked-commits))
+
+(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 ".")
+ branch
+ (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
+ (list
+ (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
+ (list
+ (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
+FULLY-QUALIFIED-NAME is non-nil."
+ (let ((merge (magit-get "branch" local-branch "merge")))
+ (save-match-data
+ (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)
+ "refs/heads/"
+ (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)
+ (cond
+ ((string= "." remote)
+ (concat
+ (when remote-rebase "onto ")
+ "branch "
+ (propertize remote-branch 'face 'magit-branch)))
+ (remote
+ (concat
+ (when remote-rebase "onto ")
+ (propertize remote-branch 'face 'magit-branch)
+ " @ "
+ remote
+ " ("
+ (magit-get "remote" remote "url")
+ ")"))
+ (t
+ (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-create-buffer-sections
+ (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
+ "log"
+ "--max-count=1"
+ "--abbrev-commit"
+ (format "--abbrev=%s" magit-sha1-abbrev-length)
+ "--pretty=oneline"))
+ (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)
+ "MERGE_HEAD"))))
+ (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-stashes)
+ (magit-insert-untracked-files)
+ (magit-insert-pending-changes)
+ (magit-insert-pending-commits)
+ (magit-insert-unpulled-commits remote remote-branch)
+ (let ((staged (or no-commit (magit-anything-staged-p))))
+ (magit-insert-unstaged-changes
+ (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)
+ (yes-or-no-p
+ (format
+ (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.
+
+\\{magit-status-mode-map}"
+ :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."
+ (interactive)
+ (let ((predicate-function (or pred magit-save-some-buffers-predicate))
+ (magit-default-directory default-directory))
+ (if magit-save-some-buffers
+ (save-some-buffers
+ (eq magit-save-some-buffers 'dontask)
+ predicate-function)
+ (when msg
+ (message msg)))))
+
+(defun magit-save-buffers-predicate-all ()
+ "Prompt to save all buffers with unsaved changes"
+ t)
+
+(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)))))
+
+;;;###autoload
+(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
+ (magit-read-top-dir
+ (> (prefix-numeric-value current-prefix-arg)
+ 4))
+ (or (magit-get-top-dir default-directory)
+ (magit-read-top-dir nil)))))
+ (magit-save-some-buffers)
+ (let ((topdir (magit-get-top-dir dir)))
+ (unless topdir
+ (when (y-or-n-p (format "There is no Git repository in %S. Create one? "
+ dir))
+ (magit-init dir)
+ (setq topdir (magit-get-top-dir dir))))
+ (when topdir
+ (let ((buf (or (magit-find-status-buffer topdir)
+ (generate-new-buffer
+ (concat "*magit: "
+ (file-name-nondirectory
+ (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)
+ magit-custom-options)
+ (when (file-exists-p ".git/MERGE_MSG")
+ (magit-log-edit))))
+
+;;; 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))
+ ((untracked)
+ (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)
+ (save-excursion
+ (magit-goto-parent-section)
+ (magit-stage-item)))
+ ((diff diff hunk)
+ (save-excursion
+ (magit-goto-parent-section)
+ (magit-goto-parent-section)
+ (magit-stage-item)))
+ ((hunk)
+ (error "Can't stage this hunk"))
+ ((diff)
+ (error "Can't stage this diff")))))
+
+(defun magit-unstage-item ()
+ "Remove the item at point from the staging area."
+ (interactive)
+ (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)
+ (save-excursion
+ (magit-goto-parent-section)
+ (magit-unstage-item)))
+ ((diff diff hunk)
+ (save-excursion
+ (magit-goto-parent-section)
+ (magit-goto-parent-section)
+ (magit-unstage-item)))
+ ((hunk)
+ (error "Can't unstage this hunk"))
+ ((diff)
+ (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')."
+ (interactive)
+ (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)
+ nil
+ nil
+ default-name)))
+ (when (magit-ref-exists-p (concat "refs/heads/" chosen-name))
+ (error "'%s' already exists." chosen-name))
+ chosen-name)))
+
+(defun magit-maybe-create-local-tracking-branch (rev)
+ "Depending on the users wishes, create a tracking branch for
+rev... maybe."
+ (if (string-match "^\\(?:refs/\\)?remotes/\\([^/]+\\)/\\(.+\\)" rev)
+ (let* ((remote (match-string 1 rev))
+ (branch (match-string 2 rev))
+ (tracker-name (magit-get-tracking-name remote branch)))
+ (when tracker-name
+ (magit-run-git "checkout" "-b" tracker-name rev)
+ t))
+ nil))
+
+(magit-define-command checkout (revision)
+ "Switch 'HEAD' to REVISION and update working tree.
+Fails if working tree or staging area contain uncommitted changes.
+If REVISION is a remote branch, offer to create a local tracking branch.
+\('git checkout [-b] REVISION')."
+ (interactive
+ (list (let ((current-branch (magit-get-current-branch))
+ (default (magit-default-rev)))
+ (magit-read-rev "Switch to"
+ (unless (string= current-branch default)
+ default)
+ (if current-branch
+ (cons (concat "refs/heads/" current-branch "$")
+ magit-uninteresting-refs)
+ magit-uninteresting-refs)))))
+ (if revision
+ (when (not (magit-maybe-create-local-tracking-branch revision))
+ (magit-save-some-buffers)
+ (magit-run-git "checkout" (magit-rev-to-git revision))
+ (magit-update-vc-modeline default-directory))))
+
+(defun magit-read-create-branch-args ()
+ (let* ((cur-branch (magit-get-current-branch))
+ (cur-point (magit-default-rev))
+ (branch (read-string "Create branch: "))
+ (parent (magit-read-rev "Parent"
+ (cond
+ ((eq magit-create-branch-behaviour 'at-point) cur-point)
+ ((eq magit-create-branch-behaviour 'at-head) cur-branch)
+ (t cur-branch)))))
+ (list branch parent)))
+
+(magit-define-command create-branch (branch parent)
+ "Switch 'HEAD' to new BRANCH at revision PARENT and update working tree.
+Fails if working tree or staging area contain uncommitted changes.
+\('git checkout -b BRANCH REVISION')."
+ (interactive (magit-read-create-branch-args))
+ (when (and branch (not (string= branch ""))
+ parent)
+ (magit-save-some-buffers)
+ (magit-run-git "checkout" "-b"
+ branch
+ (append
+ magit-custom-options
+ (magit-rev-to-git parent)))
+ (magit-update-vc-modeline default-directory)))
+
+(defun magit-delete-branch (branch &optional force)
+ "Deletes a branch.
+If the branch is the current one, offers to switch to `master' first.
+With prefix, forces the removal even if it hasn't been merged.
+Works with local or remote branches.
+\('git branch [-d|-D] BRANCH' or 'git push <remote-part-of-BRANCH> :refs/heads/BRANCH')."
+ (interactive (list (magit-read-rev "Branch to delete" (magit-default-rev 'notrim))
+ current-prefix-arg))
+ (let* ((remote (magit-remote-part-of-branch branch))
+ (is-current (string= branch (magit-get-current-branch)))
+ (args (list "branch"
+ (if force "-D" "-d")
+ branch)))
+ (cond
+ (remote
+ (magit-run-git "push" remote (concat ":refs/heads/" (magit-branch-no-remote branch))))
+ (is-current
+ (when (y-or-n-p "Cannot delete current branch. Switch to master first? ")
+ (progn
+ (magit-checkout "master")
+ (apply 'magit-run-git args))
+ (message "The current branch was not deleted.")))
+ (t
+ (apply 'magit-run-git args)))))
+
+(defun magit-move-branch (old new &optional force)
+ "Renames or moves a branch.
+With prefix, forces the move even if NEW already exists.
+\('git branch [-m|-M] OLD NEW')."
+ (interactive (list (magit-read-rev "Old name" (magit-default-rev))
+ (read-string "New name: ")
+ current-prefix-arg))
+ (magit-run-git "branch" (if force
+ "-M"
+ "-m")
+ (magit-rev-to-git old) new))
+
+(defun magit-guess-branch ()
+ (magit-section-case (item info)
+ ((branch)
+ (magit-section-info (magit-current-section)))
+ ((wazzup commit)
+ (magit-section-info (magit-section-parent item)))
+ ((commit) (magit-name-rev (substring info 0 magit-sha1-abbrev-length)))
+ ((wazzup) info)))
+
+;;; Remotes
+
+(defun magit-add-remote (remote url)
+ "Adds a remote and fetches it.
+\('git remote add REMOTE URL')."
+ (interactive (list (read-string "Add remote: ")
+ (read-string "URL: ")))
+ (magit-run-git "remote" "add" "-f" remote url))
+
+(defun magit-remove-remote (remote)
+ "Deletes a remote.
+\('git remote rm REMOTE')."
+ (interactive (list (magit-read-remote "Remote to delete")))
+ (magit-run-git "remote" "rm" remote))
+
+(defun magit-rename-remote (old new)
+ "Renames a remote.
+\('git remote rename OLD NEW')."
+ (interactive (list (magit-read-remote "Old name")
+ (read-string "New name: ")))
+ (magit-run-git "remote" "rename" old new))
+
+(defun magit-guess-remote ()
+ (magit-section-case (item info)
+ ((branch)
+ (magit-section-info (magit-section-parent item)))
+ ((remote)
+ info)
+ (t
+ (if (string= info ".")
+ info
+ (magit-get-current-remote)))))
+
+;;; Merging
+
+(defun magit-merge (revision)
+ "Merge REVISION into the current 'HEAD'; leave changes uncommitted.
+With a prefix-arg, the merge will be squashed.
+\('git merge --no-commit [--squash|--no-ff] REVISION')."
+ (interactive
+ (list (magit-read-rev "Merge" (magit-default-rev))))
+ (if revision
+ (apply 'magit-run-git
+ "merge"
+ (magit-rev-to-git revision)
+ magit-custom-options)))
+
+;;; Rebasing
+
+(defun magit-rebase-info ()
+ "Returns a list indicating the state of an in-progress rebase,
+if any."
+ (let ((git-dir (magit-git-dir)))
+ (cond ((file-exists-p (concat git-dir "rebase-merge"))
+ (list
+ ;; The commit we're rebasing onto, i.e. git rebase -i <onto>
+ (magit-name-rev (car (magit-file-lines (concat git-dir "rebase-merge/onto"))))
+
+ ;; How many commits we've gone through
+ (length (magit-file-lines (concat git-dir "rebase-merge/done")))
+
+ ;; How many commits we have in total, without the comments
+ ;; at the end of git-rebase-todo.backup
+ (let ((todo-lines-with-comments (magit-file-lines (concat git-dir "rebase-merge/git-rebase-todo.backup"))))
+ (loop for i in todo-lines-with-comments
+ until (string= "" i)
+ count i))))
+ ((and (file-exists-p (concat git-dir "rebase-apply"))
+ (file-exists-p (concat git-dir "rebase-apply/onto")))
+ ;; we might be here because a non-interactive rebase failed: the
+ ;; patches didn't apply cleanly
+ (list
+ ;; The commit we're rebasing onto, i.e. git rebase -i <onto>
+ (magit-name-rev (car (magit-file-lines (concat git-dir "rebase-apply/onto"))))
+
+ ;; How many commits we've gone through
+ (- (string-to-number (car (magit-file-lines (concat git-dir "rebase-apply/next")))) 1)
+
+ ;; How many commits we have in total
+ (string-to-number (car (magit-file-lines (concat git-dir "rebase-apply/last"))))
+ ))
+ (t nil))))
+
+(defun magit-rebase-step ()
+ (interactive)
+ (let ((info (magit-rebase-info)))
+ (if (not info)
+ (let* ((current-branch (magit-get-current-branch))
+ (rev (magit-read-rev "Rebase to"
+ (magit-format-ref (magit-remote-branch-for current-branch t))
+ (if current-branch
+ (cons (concat "refs/heads/" current-branch)
+ magit-uninteresting-refs)
+ magit-uninteresting-refs))))
+ (if rev
+ (magit-run-git "rebase" (magit-rev-to-git rev))))
+ (let ((cursor-in-echo-area t)
+ (message-log-max nil))
+ (message "Rebase in progress. [A]bort, [S]kip, or [C]ontinue? ")
+ (let ((reply (read-event)))
+ (case reply
+ ((?A ?a)
+ (magit-run-git-async "rebase" "--abort"))
+ ((?S ?s)
+ (magit-run-git-async "rebase" "--skip"))
+ ((?C ?c)
+ (magit-run-git-async "rebase" "--continue"))))))))
+
+;;; Resetting
+
+(magit-define-command reset-head (revision &optional hard)
+ "Switch 'HEAD' to REVISION, keeping prior working tree and staging area.
+Any differences from REVISION become new changes to be committed.
+With prefix argument, all uncommitted changes in working tree
+and staging area are lost.
+\('git reset [--soft|--hard] REVISION')."
+ (interactive (list (magit-read-rev (format "%s head to"
+ (if current-prefix-arg
+ "Hard reset"
+ "Reset"))
+ (or (magit-default-rev)
+ "HEAD^"))
+ current-prefix-arg))
+ (when revision
+ (magit-run-git "reset" (if hard "--hard" "--soft")
+ (magit-rev-to-git revision))
+ (magit-update-vc-modeline default-directory)))
+
+(magit-define-command reset-head-hard (revision)
+ "Switch 'HEAD' to REVISION, losing all changes.
+Uncomitted changes in both working tree and staging area are lost.
+\('git reset --hard REVISION')."
+ (interactive (list (magit-read-rev (format "Hard reset head to")
+ (or (magit-default-rev)
+ "HEAD"))))
+ (magit-reset-head revision t))
+
+(magit-define-command reset-working-tree (&optional arg)
+ "Revert working tree and clear changes from staging area.
+\('git reset --hard HEAD').
+
+With a prefix arg, also remove untracked files. With two prefix args, remove ignored files as well."
+ (interactive "p")
+ (let ((include-untracked (>= arg 4))
+ (include-ignored (>= arg 16)))
+ (when (yes-or-no-p (format "Discard all uncommitted changes%s%s? "
+ (if include-untracked
+ ", untracked files"
+ "")
+ (if include-ignored
+ ", ignored files"
+ "")))
+ (magit-reset-head-hard "HEAD")
+ (if include-untracked
+ (magit-run-git "clean" "-fd" (if include-ignored
+ "-x"
+ ""))))))
+
+;;; Rewriting
+
+(defun magit-read-rewrite-info ()
+ (when (file-exists-p (concat (magit-git-dir) "magit-rewrite-info"))
+ (with-temp-buffer
+ (insert-file-contents (concat (magit-git-dir) "magit-rewrite-info"))
+ (goto-char (point-min))
+ (read (current-buffer)))))
+
+(defun magit-write-rewrite-info (info)
+ (with-temp-file (concat (magit-git-dir) "magit-rewrite-info")
+ (prin1 info (current-buffer))
+ (princ "\n" (current-buffer))))
+
+(magit-define-inserter pending-commits ()
+ (let* ((info (magit-read-rewrite-info))
+ (pending (cdr (assq 'pending info))))
+ (when pending
+ (magit-with-section 'pending nil
+ (insert (propertize "Pending commits:\n"
+ 'face 'magit-section-title))
+ (dolist (p pending)
+ (let* ((commit (car p))
+ (properties (cdr p))
+ (used (plist-get properties 'used)))
+ (magit-with-section commit 'commit
+ (magit-set-section-info commit)
+ (insert (magit-git-string
+ "log" "--max-count=1"
+ (if used
+ "--pretty=format:. %s"
+ "--pretty=format:* %s")
+ commit "--")
+ "\n")))))
+ (insert "\n"))))
+
+(defun magit-rewrite-set-commit-property (commit prop value)
+ (let* ((info (magit-read-rewrite-info))
+ (pending (cdr (assq 'pending info)))
+ (p (assoc commit pending)))
+ (when p
+ (setf (cdr p) (plist-put (cdr p) prop value))
+ (magit-write-rewrite-info info)
+ (magit-need-refresh))))
+
+(defun magit-rewrite-set-used ()
+ (interactive)
+ (magit-section-action (item info)
+ ((pending commit)
+ (magit-rewrite-set-commit-property info 'used t))))
+
+(defun magit-rewrite-set-unused ()
+ (interactive)
+ (magit-section-action (item info)
+ ((pending commit)
+ (magit-rewrite-set-commit-property info 'used nil))))
+
+(magit-define-inserter pending-changes ()
+ (let* ((info (magit-read-rewrite-info))
+ (orig (cadr (assq 'orig info))))
+ (when orig
+ (let ((magit-hide-diffs t))
+ (magit-git-section 'pending-changes
+ "Pending changes"
+ 'magit-wash-diffs
+ "diff" (magit-diff-U-arg) "-R" orig)))))
+
+(defun magit-rewrite-start (from &optional onto)
+ (interactive (list (magit-read-rev "Rewrite from" (magit-default-rev))))
+ (or (magit-everything-clean-p)
+ (error "You have uncommitted changes"))
+ (or (not (magit-read-rewrite-info))
+ (error "Rewrite in progress"))
+ (let* ((orig (magit-rev-parse "HEAD"))
+ (base
+ (if
+ (or
+ (eq magit-rewrite-inclusive t)
+ (and
+ (eq magit-rewrite-inclusive 'ask)
+ (y-or-n-p "Include selected revision in rewrite? ")))
+ (or
+ (car (magit-commit-parents from))
+ (error "Can't rewrite a parentless commit."))
+ from))
+ (pending (magit-git-lines "rev-list" (concat base ".."))))
+ (magit-write-rewrite-info `((orig ,orig)
+ (pending ,@(mapcar #'list pending))))
+ (magit-run-git "reset" "--hard" base)))
+
+(defun magit-rewrite-stop (&optional noconfirm)
+ (interactive)
+ (let* ((info (magit-read-rewrite-info)))
+ (or info
+ (error "No rewrite in progress"))
+ (when (or noconfirm
+ (yes-or-no-p "Stop rewrite? "))
+ (magit-write-rewrite-info nil)
+ (magit-refresh))))
+
+(defun magit-rewrite-abort ()
+ (interactive)
+ (let* ((info (magit-read-rewrite-info))
+ (orig (cadr (assq 'orig info))))
+ (or info
+ (error "No rewrite in progress"))
+ (or (magit-everything-clean-p)
+ (error "You have uncommitted changes"))
+ (when (yes-or-no-p "Abort rewrite? ")
+ (magit-write-rewrite-info nil)
+ (magit-run-git "reset" "--hard" orig))))
+
+(defun magit-rewrite-finish ()
+ (interactive)
+ (magit-with-refresh
+ (magit-rewrite-finish-step t)))
+
+(defun magit-rewrite-finish-step (first-p)
+ (let ((info (magit-read-rewrite-info)))
+ (or info
+ (error "No rewrite in progress"))
+ (let* ((pending (cdr (assq 'pending info)))
+ (first-unused
+ (let ((rpend (reverse pending)))
+ (while (and rpend (plist-get (cdr (car rpend)) 'used))
+ (setq rpend (cdr rpend)))
+ (car rpend)))
+ (commit (car first-unused)))
+ (cond ((not first-unused)
+ (magit-rewrite-stop t))
+ ((magit-apply-commit commit t (not first-p))
+ (magit-rewrite-set-commit-property commit 'used t)
+ (magit-rewrite-finish-step nil))))))
+
+;;; Updating, pull, and push
+
+(magit-define-command fetch (remote)
+ "Fetch from REMOTE."
+ (interactive (list (magit-read-remote)))
+ (apply 'magit-run-git-async "fetch" remote magit-custom-options))
+
+(magit-define-command fetch-current ()
+ "Run fetch for default remote.
+
+If there is no default remote, ask for one."
+ (interactive)
+ (magit-fetch (or (magit-get-current-remote)
+ (magit-read-remote))))
+
+(magit-define-command remote-update ()
+ "Update all remotes."
+ (interactive)
+ (apply 'magit-run-git-async "remote" "update" magit-custom-options))
+
+(magit-define-command pull ()
+ "Run git pull against the current remote."
+ (interactive)
+ (let* ((branch (magit-get-current-branch))
+ (branch-remote (magit-get-remote branch))
+ (config-branch (and branch (magit-get "branch" branch "merge")))
+ (merge-branch (or (and config-branch (not current-prefix-arg))
+ (magit-read-remote-branch
+ branch-remote (format "Pull from: ")))))
+ (when (and branch (not config-branch))
+ (magit-set branch-remote "branch" branch "remote")
+ (magit-set (format "refs/heads/%s" merge-branch)
+ "branch" branch "merge"))
+ (apply 'magit-run-git-async "pull" "-v" magit-custom-options)))
+
+(eval-when-compile (require 'eshell))
+
+(defun magit-parse-arguments (command)
+ (require 'eshell)
+ (with-temp-buffer
+ (insert command)
+ (mapcar 'eval (eshell-parse-arguments (point-min) (point-max)))))
+
+(defun magit-shell-command (command)
+ "Perform arbitrary shell COMMAND."
+ (interactive "sCommand: ")
+ (let ((args (magit-parse-arguments command))
+ (magit-process-popup-time 0))
+ (magit-run* args nil nil nil t)))
+
+(defvar magit-git-command-history nil)
+
+(defun magit-git-command (command)
+ "Perform arbitrary Git COMMAND.
+
+Similar to `magit-shell-command', but involves slightly less
+typing and automatically refreshes the status buffer."
+ (interactive
+ (list (read-string "Run git like this: " nil 'magit-git-command-history)))
+ (require 'pcomplete)
+ (let ((args (magit-parse-arguments command))
+ (magit-process-popup-time 0))
+ (magit-with-refresh
+ (magit-run* (append (cons magit-git-executable
+ magit-git-standard-options)
+ args)
+ nil nil nil t))))
+
+(magit-define-command push-tags ()
+ "Push tags."
+ (interactive)
+ (magit-run-git-async "push" "--tags"))
+
+(magit-define-command push ()
+ "Push the current branch to a remote repository.
+
+With no prefix argument, ask `magit-get-remote' what remote to
+use for this branch.
+
+With a prefix arg \(e.g., \\[universal-argument] \\[magit-push]), \
+ask user instead.
+
+With \\[universal-argument] \\[universal-argument] as prefix, \
+also prompt user for the remote branch;
+otherwise, try to use the branch.<name>.merge git-config(1)
+option, falling back to something hairy if that is unset."
+ (interactive)
+ (let* ((branch (or (magit-get-current-branch)
+ (error "Don't push a detached head. That's gross")))
+ (branch-remote (magit-get-remote branch))
+ (push-remote (if (or current-prefix-arg
+ (not branch-remote))
+ (magit-read-remote (format "Push %s to remote"
+ branch)
+ branch-remote)
+ branch-remote))
+ (ref-branch (or (and (>= (prefix-numeric-value current-prefix-arg) 16)
+ (magit-read-remote-branch
+ push-remote (format "Push %s as branch" branch)))
+ (magit-get "branch" branch "merge"))))
+ (if (and (not ref-branch)
+ (eq magit-set-upstream-on-push 'refuse))
+ (error "Not pushing since no upstream has been set.")
+ (let ((set-upstream-on-push (and (not ref-branch)
+ (or (eq magit-set-upstream-on-push 'dontask)
+ (and (eq magit-set-upstream-on-push t)
+ (yes-or-no-p "Set upstream while pushing? "))))))
+ (if (and (not branch-remote)
+ (not current-prefix-arg))
+ (magit-set push-remote "branch" branch "remote"))
+ (apply 'magit-run-git-async "push" "-v" push-remote
+ (if ref-branch
+ (format "%s:%s" branch ref-branch)
+ branch)
+ (if set-upstream-on-push
+ (cons "--set-upstream" magit-custom-options)
+ magit-custom-options))
+ ;; Although git will automatically set up the remote,
+ ;; it doesn't set up the branch to merge (at least as of Git 1.6.6.1),
+ ;; so we have to do that manually.
+ (unless ref-branch
+ (magit-set (concat "refs/heads/" branch) "branch" branch "merge"))))))
+
+;;; Log edit mode
+
+(defvar magit-log-edit-buffer-name "*magit-edit-log*"
+ "Buffer name for composing commit messages.")
+
+(defvar magit-log-edit-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "C-c C-c") 'magit-log-edit-commit)
+ (define-key map (kbd "C-x #") 'magit-log-edit-commit)
+ (define-key map (kbd "C-c C-a") 'magit-log-edit-toggle-amending)
+ (define-key map (kbd "C-c C-s") 'magit-log-edit-toggle-signoff)
+ (define-key map (kbd "C-c C-t") 'magit-log-edit-toggle-author)
+ (define-key map (kbd "C-c C-e") 'magit-log-edit-toggle-allow-empty)
+ (define-key map (kbd "M-p") 'log-edit-previous-comment)
+ (define-key map (kbd "M-n") 'log-edit-next-comment)
+ (define-key map (kbd "C-c C-k") 'magit-log-edit-cancel-log-message)
+ (define-key map (kbd "C-c C-]") 'magit-log-edit-cancel-log-message)
+ (define-key map (kbd "C-x C-s") (lambda ()
+ (interactive)
+ (message "Not saved. Use C-c C-c to finalize this commit message.")))
+ map))
+
+(defvar magit-pre-log-edit-window-configuration nil)
+
+(define-derived-mode magit-log-edit-mode text-mode "Magit Log Edit"
+ ;; Recognize changelog-style paragraphs
+ (set (make-local-variable 'paragraph-start)
+ (concat paragraph-start "\\|*\\|(")))
+
+(defun magit-log-edit-cleanup ()
+ (save-excursion
+ (goto-char (point-min))
+ (goto-char (point-min))
+ (if (re-search-forward "[ \t\n]*\\'" nil t)
+ (replace-match "\n" nil nil))))
+
+(defun magit-log-edit-append (str)
+ (with-current-buffer (get-buffer-create magit-log-edit-buffer-name)
+ (goto-char (point-max))
+ (insert str "\n")))
+
+(defconst magit-log-header-end "-- End of Magit header --\n")
+
+(defun magit-log-edit-get-fields ()
+ (let ((buf (get-buffer magit-log-edit-buffer-name))
+ (result nil))
+ (if buf
+ (with-current-buffer buf
+ (goto-char (point-min))
+ (while (looking-at "^\\([A-Za-z0-9-_]+\\): *\\(.+\\)?$")
+ (setq result (acons (intern (downcase (match-string 1)))
+ (read (or (match-string 2) "nil"))
+ result))
+ (forward-line))
+ (if (not (looking-at (regexp-quote magit-log-header-end)))
+ (setq result nil))))
+ (nreverse result)))
+
+(defun magit-log-edit-set-fields (fields)
+ (let ((buf (get-buffer-create magit-log-edit-buffer-name)))
+ (with-current-buffer buf
+ (goto-char (point-min))
+ (if (search-forward-regexp (format "^\\([A-Za-z0-9-_]+:.*\n\\)*%s"
+ (regexp-quote magit-log-header-end))
+ nil t)
+ (delete-region (match-beginning 0) (match-end 0)))
+ (goto-char (point-min))
+ (when fields
+ (while fields
+ (insert (capitalize (symbol-name (caar fields))) ": "
+ (prin1-to-string (cdar fields)) "\n")
+ (setq fields (cdr fields)))
+ (insert magit-log-header-end)))))
+
+(defun magit-log-edit-set-field (name value)
+ (let* ((fields (magit-log-edit-get-fields))
+ (cell (assq name fields)))
+ (cond (cell
+ (if value
+ (rplacd cell value)
+ (setq fields (delq cell fields))))
+ (t
+ (if value
+ (setq fields (append fields (list (cons name value)))))))
+ (magit-log-edit-set-fields fields)))
+
+(defun magit-log-edit-get-field (name)
+ (cdr (assq name (magit-log-edit-get-fields))))
+
+(defun magit-log-edit-toggle-field (name default)
+ "Toggle the log-edit field named NAME.
+If it's currently unset, set it to DEFAULT (t or nil).
+
+Return nil if the field is toggled off, and non-nil if it's
+toggled on. When it's toggled on for the first time, return
+'first."
+ (let* ((fields (magit-log-edit-get-fields))
+ (cell (assq name fields)) yesp)
+ (if cell
+ (progn
+ (setq yesp (equal (cdr cell) "yes"))
+ (rplacd cell (if yesp "no" "yes")))
+ (setq fields (acons name (if default "yes" "no") fields))
+ (setq yesp (if default 'first)))
+ (magit-log-edit-set-fields fields)
+ yesp))
+
+(defun magit-log-edit-toggle-input (name default)
+ "Toggle the log-edit input named NAME.
+If it's currently unset, set it to DEFAULT (a string). If it is
+set remove it.
+
+Return nil if the input is toggled off, and its valud if it's
+toggled on."
+ (let* ((fields (magit-log-edit-get-fields))
+ (cell (assq name fields))
+ result)
+ (if cell
+ (progn
+ (setq fields (assq-delete-all name fields)
+ result (cdr cell)))
+ (setq fields (acons name default fields)))
+ (magit-log-edit-set-fields fields)
+ result))
+
+(defun magit-log-edit-setup-author-env (author)
+ "Set GIT_AUTHOR_* variables from AUTHOR spec.
+If AUTHOR is nil, honor default values from
+environment (potentially empty)."
+ (when author
+ ;; XXX - this is a bit strict, probably.
+ (or (string-match "\\(.*\\) <\\(.*\\)>\\(?:,\\s-*\\(.+\\)\\)?" author)
+ (error "Can't parse author string"))
+ ;; Shucks, setenv destroys the match data.
+ (let ((name (match-string 1 author))
+ (email (match-string 2 author))
+ (date (match-string 3 author)))
+ (make-local-variable 'process-environment)
+ (setenv "GIT_AUTHOR_NAME" name)
+ (setenv "GIT_AUTHOR_EMAIL" email)
+ (if date
+ (setenv "GIT_AUTHOR_DATE" date)))))
+
+(defun magit-log-edit-push-to-comment-ring (comment)
+ (when (or (ring-empty-p log-edit-comment-ring)
+ (not (equal comment (ring-ref log-edit-comment-ring 0))))
+ (ring-insert log-edit-comment-ring comment)))
+
+(defun magit-log-edit-commit ()
+ "Finish edits and create new commit object.
+\('git commit ...')"
+ (interactive)
+ (let* ((fields (magit-log-edit-get-fields))
+ (amend (equal (cdr (assq 'amend fields)) "yes"))
+ (allow-empty (equal (cdr (assq 'allow-empty fields)) "yes"))
+ (commit-all (equal (cdr (assq 'commit-all fields)) "yes"))
+ (sign-off-field (assq 'sign-off fields))
+ (sign-off (if sign-off-field
+ (equal (cdr sign-off-field) "yes")
+ magit-commit-signoff))
+ (tag-rev (cdr (assq 'tag-rev fields)))
+ (tag-name (cdr (assq 'tag-name fields)))
+ (author (cdr (assq 'author fields)))
+ (tag-options (cdr (assq 'tag-options fields))))
+
+ (unless (or (magit-anything-staged-p)
+ allow-empty
+ amend
+ tag-name
+ (file-exists-p (concat (magit-git-dir) "MERGE_HEAD"))
+ (and commit-all
+ (not (magit-everything-clean-p))))
+ (error "Refusing to create empty commit. Maybe you want to amend (%s) or allow-empty (%s)?"
+ (key-description (car (where-is-internal
+ 'magit-log-edit-toggle-amending)))
+ (key-description (car (where-is-internal
+ 'magit-log-edit-toggle-allow-empty)))))
+
+ (magit-log-edit-push-to-comment-ring (buffer-string))
+ (magit-log-edit-setup-author-env author)
+ (magit-log-edit-set-fields nil)
+ (magit-log-edit-cleanup)
+ (if (= (buffer-size) 0)
+ (insert "(Empty description)\n"))
+ (let ((env process-environment)
+ (commit-buf (current-buffer)))
+ (with-current-buffer (magit-find-status-buffer default-directory)
+ (let ((process-environment env))
+ (cond (tag-name
+ (apply #'magit-run-git-with-input commit-buf
+ "tag" (append tag-options (list tag-name "-a" "-F" "-" tag-rev))))
+ (t
+ (apply #'magit-run-async-with-input commit-buf
+ magit-git-executable
+ (append magit-git-standard-options
+ '("commit")
+ magit-custom-options
+ '("-F" "-")
+ (if (and commit-all (not allow-empty)) '("--all") '())
+ (if amend '("--amend") '())
+ (if allow-empty '("--allow-empty"))
+ (if sign-off '("--signoff") '()))))))))
+ ;; shouldn't we kill that buffer altogether?
+ (erase-buffer)
+ (let ((magit-buf magit-buffer-internal))
+ (bury-buffer)
+ (set-buffer magit-buf))
+ (when (file-exists-p (concat (magit-git-dir) "MERGE_MSG"))
+ (delete-file (concat (magit-git-dir) "MERGE_MSG")))
+ ;; potentially the local environment has been altered with settings that
+ ;; were specific to this commit. Let's revert it
+ (kill-local-variable 'process-environment)
+ (magit-update-vc-modeline default-directory)
+ (when magit-pre-log-edit-window-configuration
+ (set-window-configuration magit-pre-log-edit-window-configuration)
+ (setq magit-pre-log-edit-window-configuration nil))))
+
+(defun magit-log-edit-cancel-log-message ()
+ "Abort edits and erase commit message being composed."
+ (interactive)
+ (when (or (not magit-log-edit-confirm-cancellation)
+ (yes-or-no-p
+ "Really cancel editing the log (any changes will be lost)?"))
+ (erase-buffer)
+ (bury-buffer)
+ (when magit-pre-log-edit-window-configuration
+ (set-window-configuration magit-pre-log-edit-window-configuration)
+ (setq magit-pre-log-edit-window-configuration nil))))
+
+(defun magit-log-edit-toggle-amending ()
+ "Toggle whether this will be an amendment to the previous commit.
+\(i.e., whether eventual commit does 'git commit --amend')"
+ (interactive)
+ (when (eq (magit-log-edit-toggle-field 'amend t) 'first)
+ (magit-log-edit-append
+ (magit-trim-line (magit-format-commit "HEAD" "%s%n%n%b")))))
+
+(defun magit-log-edit-toggle-signoff ()
+ "Toggle whether this commit will include a signoff.
+\(i.e., whether eventual commit does 'git commit --signoff')"
+ (interactive)
+ (magit-log-edit-toggle-field 'sign-off (not magit-commit-signoff)))
+
+(defun magit-log-edit-toggle-author ()
+ "Toggle whether this commit will include an author.
+\(i.e., whether eventual commit is run with GIT_AUTHOR_NAME and
+GIT_AUTHOR_EMAIL set)"
+ (interactive)
+ (magit-log-edit-toggle-input 'author (format "%s <%s>"
+ (or (magit-get "user" "name") "Author Name")
+ (or (magit-get "user" "email") "author@email"))))
+
+(defun magit-log-edit-toggle-allow-empty ()
+ "Toggle whether this commit is allowed to be empty.
+This means that the eventual commit does 'git commit --allow-empty'."
+ (interactive)
+ (magit-log-edit-toggle-field 'allow-empty t))
+
+(defun magit-pop-to-log-edit (operation)
+ (let ((dir default-directory)
+ (magit-buf (current-buffer))
+ (buf (get-buffer-create magit-log-edit-buffer-name)))
+ (setq magit-pre-log-edit-window-configuration
+ (current-window-configuration))
+ (pop-to-buffer buf)
+ (setq default-directory dir)
+ (when (file-exists-p (concat (magit-git-dir) "MERGE_MSG"))
+ (insert-file-contents (concat (magit-git-dir) "MERGE_MSG")))
+ (magit-log-edit-mode)
+ (make-local-variable 'magit-buffer-internal)
+ (setq magit-buffer-internal magit-buf)
+ (message "Type C-c C-c to %s (C-c C-k to cancel)." operation)))
+
+(defun magit-log-edit (&optional arg)
+ "Brings up a buffer to allow editing of commit messages.
+
+Giving a simple prefix arg will amend a previous commit, while
+a double prefix arg will allow creating an empty one.
+
+If there is a rebase in progress, offer the user the option to
+continue it.
+
+\\{magit-log-edit-mode-map}"
+ (interactive "P")
+ ;; If repository is dirty there is no point in trying to
+ ;; suggest to continue the rebase. Git will rebuke you and exit with
+ ;; error code, so suggest it only if theres absolutely nothing else
+ ;; to do and rebase is ongoing.
+ (if (and (magit-everything-clean-p)
+ (magit-rebase-info)
+ (y-or-n-p "Rebase in progress. Continue it? "))
+ (magit-run-git-async "rebase" "--continue")
+
+ ;; If there's nothing staged, set commit flag to `nil', thus
+ ;; avoiding unnescessary popping up of the log edit buffer in case
+ ;; when user chose to forgo commiting all unstaged changes
+ (let ((amend-p (= (prefix-numeric-value arg) 4))
+ (empty-p (= (prefix-numeric-value arg) 16)))
+ (when (and magit-commit-all-when-nothing-staged
+ (not (magit-everything-clean-p))
+ (not (magit-anything-staged-p)))
+ (cond ((eq magit-commit-all-when-nothing-staged 'ask-stage)
+ (when (y-or-n-p "Nothing staged. Stage everything now? ")
+ (magit-stage-all)))
+ ((not (magit-log-edit-get-field 'commit-all))
+ (when (or (eq magit-commit-all-when-nothing-staged t)
+ (y-or-n-p
+ "Nothing staged. Commit all unstaged changes? "))
+ (magit-log-edit-set-field 'commit-all "yes")))))
+ (when amend-p
+ (magit-log-edit-toggle-amending))
+ (when empty-p
+ (magit-log-edit-toggle-allow-empty))
+ (let ((author-email (or (getenv "GIT_AUTHOR_EMAIL") ""))
+ (author-name (or (getenv "GIT_AUTHOR_NAME") ""))
+ (author-date (or (getenv "GIT_AUTHOR_DATE") "")))
+ (if (not (string= author-email ""))
+ (magit-log-edit-set-field 'author (format "%s <%s>%s"
+ (if (string= "" author-name) author-email author-name)
+ author-email
+ (if (string= "" author-date) "" (format ", %s" author-date))))))
+ (magit-pop-to-log-edit "commit"))))
+
+(defun magit-add-log ()
+ (interactive)
+ (cond ((magit-rebase-info)
+ (if (y-or-n-p "Rebase in progress. Continue it? ")
+ (magit-run-git-async "rebase" "--continue")))
+ (t
+ (let ((section (magit-current-section)))
+ (let ((fun (if (eq (magit-section-type section) 'hunk)
+ (save-window-excursion
+ (save-excursion
+ (magit-visit-item)
+ (add-log-current-defun)))
+ nil))
+ (file (magit-diff-item-file
+ (cond ((eq (magit-section-type section) 'hunk)
+ (magit-hunk-item-diff section))
+ ((eq (magit-section-type section) 'diff)
+ section)
+ (t
+ (error "No change at point"))))))
+ (magit-log-edit nil)
+ (goto-char (point-min))
+ (cond ((not (search-forward-regexp
+ (format "^\\* %s" (regexp-quote file)) nil t))
+ ;; No entry for file, create it.
+ (goto-char (point-max))
+ (insert (format "\n* %s" file))
+ (if fun
+ (insert (format " (%s)" fun)))
+ (insert ": "))
+ (fun
+ ;; found entry for file, look for fun
+ (let ((limit (or (save-excursion
+ (and (search-forward-regexp "^\\* "
+ nil t)
+ (match-beginning 0)))
+ (point-max))))
+ (cond ((search-forward-regexp (format "(.*\\<%s\\>.*):"
+ (regexp-quote fun))
+ limit t)
+ ;; found it, goto end of current entry
+ (if (search-forward-regexp "^(" limit t)
+ (backward-char 2)
+ (goto-char limit)))
+ (t
+ ;; not found, insert new entry
+ (goto-char limit)
+ (if (bolp)
+ (open-line 1)
+ (newline))
+ (insert (format "(%s): " fun))))))
+ (t
+ ;; found entry for file, look for beginning it
+ (when (looking-at ":")
+ (forward-char 2)))))))))
+
+;;; Tags
+
+(magit-define-command tag (name rev)
+ "Create a new lightweight tag with the given NAME at REV.
+\('git tag NAME')."
+ (interactive
+ (list
+ (read-string "Tag name: ")
+ (magit-read-rev "Place tag on: " (or (magit-default-rev) "HEAD"))))
+ (apply #'magit-run-git "tag" (append magit-custom-options (list name rev))))
+
+(magit-define-command annotated-tag (name rev)
+ "Start composing an annotated tag with the given NAME.
+Tag will point to the current 'HEAD'."
+ (interactive
+ (list
+ (read-string "Tag name: ")
+ (magit-read-rev "Place tag on: " (or (magit-default-rev) "HEAD"))))
+ (magit-log-edit-set-field 'tag-name name)
+ (magit-log-edit-set-field 'tag-rev rev)
+ (magit-log-edit-set-field 'tag-options magit-custom-options)
+ (magit-pop-to-log-edit "tag"))
+
+;;; Stashing
+
+(defun magit-wash-stash ()
+ (if (search-forward-regexp "stash@{\\(.*?\\)}" (line-end-position) t)
+ (let ((stash (match-string-no-properties 0))
+ (name (match-string-no-properties 1)))
+ (delete-region (match-beginning 0) (match-end 0))
+ (goto-char (match-beginning 0))
+ (fixup-whitespace)
+ (goto-char (line-beginning-position))
+ (insert name)
+ (goto-char (line-beginning-position))
+ (magit-with-section stash 'stash
+ (magit-set-section-info stash)
+ (forward-line)))
+ (forward-line))
+ t)
+
+(defun magit-wash-stashes ()
+ (let ((magit-old-top-section nil))
+ (magit-wash-sequence #'magit-wash-stash)))
+
+(magit-define-inserter stashes ()
+ (magit-git-section 'stashes
+ "Stashes:" 'magit-wash-stashes
+ "stash" "list"))
+
+(magit-define-command stash (description)
+ "Create new stash of working tree and staging area named DESCRIPTION.
+Working tree and staging area revert to the current 'HEAD'.
+With prefix argument, changes in staging area are kept.
+\('git stash save [--keep-index] DESCRIPTION')"
+ (interactive "sStash description: ")
+ (apply 'magit-run-git `("stash" "save" ,@magit-custom-options "--" ,description)))
+
+(magit-define-command stash-snapshot ()
+ "Create new stash of working tree and staging area; keep changes in place.
+\('git stash save \"Snapshot...\"; git stash apply stash@{0}')"
+ (interactive)
+ (magit-with-refresh
+ (apply 'magit-run-git `("stash" "save" ,@magit-custom-options
+ ,(format-time-string "Snapshot taken at %Y-%m-%d %H:%M:%S"
+ (current-time))))
+ (magit-run-git "stash" "apply" "stash@{0}")))
+
+(defvar magit-currently-shown-stash nil)
+
+(define-derived-mode magit-stash-mode magit-mode "Magit Stash"
+ "Mode for looking at a git stash.
+
+\\{magit-stash-mode-map}"
+ :group 'magit)
+
+(defvar magit-stash-buffer-name "*magit-stash*"
+ "Buffer name for displaying a stash.")
+
+(defun magit-show-stash (stash &optional scroll)
+ (when (magit-section-p stash)
+ (setq stash (magit-section-info stash)))
+ (let ((dir default-directory)
+ (buf (get-buffer-create magit-stash-buffer-name))
+ (stash-id (magit-git-string "rev-list" "-1" stash)))
+ (cond ((and (equal magit-currently-shown-stash stash-id)
+ (with-current-buffer buf
+ (> (length (buffer-string)) 1)))
+ (let ((win (get-buffer-window buf)))
+ (cond ((not win)
+ (display-buffer buf))
+ (scroll
+ (with-selected-window win
+ (funcall scroll))))))
+ (t
+ (setq magit-currently-shown-stash stash-id)
+ (display-buffer buf)
+ (with-current-buffer buf
+ (set-buffer buf)
+ (goto-char (point-min))
+ (let* ((range (cons (concat stash "^2^") stash))
+ (magit-current-diff-range range)
+ (args (magit-rev-range-to-git range)))
+ (magit-mode-init dir 'magit-diff-mode #'magit-refresh-diff-buffer
+ range args)))))))
+;;; Commits
+
+(defun magit-commit-at-point (&optional nil-ok-p)
+ (let* ((section (magit-current-section))
+ (commit (if (and section
+ (eq (magit-section-type section) 'commit))
+ (magit-section-info section)
+ (get-text-property (point) 'revision))))
+ (if nil-ok-p
+ commit
+ (or commit
+ (error "No commit at point")))))
+
+(defun magit-apply-commit (commit &optional docommit noerase revert)
+ (let* ((parent-id (magit-choose-parent-id commit "cherry-pick"))
+ (success (magit-run* `(,magit-git-executable
+ ,@magit-git-standard-options
+ ,(if revert "revert" "cherry-pick")
+ ,@(if parent-id
+ (list "-m" (number-to-string parent-id)))
+ ,@(if (not docommit) (list "--no-commit"))
+ ,commit)
+ nil noerase)))
+ (when (and (not docommit) success)
+ (cond (revert
+ (magit-log-edit-append
+ (magit-format-commit commit "Reverting \"%s\"")))
+ (t
+ (magit-log-edit-append
+ (magit-format-commit commit "%s%n%n%b"))
+ (magit-log-edit-set-field
+ 'author
+ (magit-format-commit commit "%an <%ae>, %ai")))))
+ success))
+
+(defun magit-apply-item ()
+ (interactive)
+ (magit-section-action (item info "apply")
+ ((pending commit)
+ (magit-apply-commit info)
+ (magit-rewrite-set-commit-property info 'used t))
+ ((commit)
+ (magit-apply-commit info))
+ ((unstaged *)
+ (error "Change is already in your working tree"))
+ ((staged *)
+ (error "Change is already in your working tree"))
+ ((hunk)
+ (magit-apply-hunk-item item))
+ ((diff)
+ (magit-apply-diff-item item))
+ ((stash)
+ (magit-run-git "stash" "apply" info))))
+
+(defun magit-cherry-pick-item ()
+ (interactive)
+ (magit-section-action (item info "cherry-pick")
+ ((pending commit)
+ (magit-apply-commit info t)
+ (magit-rewrite-set-commit-property info 'used t))
+ ((commit)
+ (magit-apply-commit info t))
+ ((stash)
+ (magit-run-git "stash" "pop" info))))
+
+(defmacro magit-with-revert-confirmation (&rest body)
+ `(when (or (not magit-revert-item-confirm)
+ (yes-or-no-p "Really revert this item? "))
+ ,@body))
+
+(defun magit-revert-item ()
+ (interactive)
+ (magit-section-action (item info "revert")
+ ((pending commit)
+ (magit-with-revert-confirmation
+ (magit-apply-commit info nil nil t)
+ (magit-rewrite-set-commit-property info 'used nil)))
+ ((commit)
+ (magit-with-revert-confirmation
+ (magit-apply-commit info nil nil t)))
+ ;; Reverting unstaged changes cannot be undone
+ ((unstaged *)
+ (magit-discard-item))
+ ((hunk)
+ (magit-with-revert-confirmation
+ (magit-apply-hunk-item-reverse item)))
+ ((diff)
+ (magit-with-revert-confirmation
+ (magit-apply-diff-item item "--reverse")))))
+
+(defun magit-log-show-more-entries (&optional arg)
+ "Grow the number of log entries shown.
+
+With no prefix optional ARG, show twice as many log entries.
+With a numerical prefix ARG, add this number to the number of shown log entries.
+With a non numeric prefix ARG, show all entries"
+ (interactive "P")
+ (make-local-variable 'magit-log-cutoff-length)
+ (cond
+ ((numberp arg)
+ (setq magit-log-cutoff-length (+ magit-log-cutoff-length arg)))
+ (arg
+ (setq magit-log-cutoff-length magit-log-infinite-length))
+ (t (setq magit-log-cutoff-length (* magit-log-cutoff-length 2))))
+ (let ((old-point (point)))
+ (magit-refresh)
+ (goto-char old-point)))
+
+(defun magit-refresh-log-buffer (range style args)
+ (magit-configure-have-graph)
+ (magit-configure-have-decorate)
+ (magit-configure-have-abbrev)
+ (setq magit-current-range range)
+ (magit-create-log-buffer-sections
+ (apply #'magit-git-section nil
+ (magit-rev-range-describe range "Commits")
+ (apply-partially 'magit-wash-log style)
+ `("log"
+ ,(format "--max-count=%s" magit-log-cutoff-length)
+ ,"--abbrev-commit"
+ ,(format "--abbrev=%s" magit-sha1-abbrev-length)
+ ,@(cond ((eq style 'long) (list "--stat" "-z"))
+ ((eq style 'oneline) (list "--pretty=oneline"))
+ (t nil))
+ ,@(if magit-have-decorate (list "--decorate=full"))
+ ,@(if magit-have-graph (list "--graph"))
+ ,@args
+ "--"))))
+
+(define-derived-mode magit-log-mode magit-mode "Magit Log"
+ "Mode for looking at git log.
+
+\\{magit-log-mode-map}"
+ :group 'magit)
+
+(defvar magit-log-buffer-name "*magit-log*"
+ "Buffer name for display of log entries.")
+
+(magit-define-command log-ranged ()
+ (interactive)
+ (magit-log t))
+(define-obsolete-function-alias 'magit-display-log-ranged 'magit-log-ranged)
+
+(magit-define-command log (&optional ask-for-range &rest extra-args)
+ (interactive)
+ (let* ((log-range (if ask-for-range
+ (magit-read-rev-range "Log" "HEAD")
+ "HEAD"))
+ (topdir (magit-get-top-dir default-directory))
+ (args (nconc (list (magit-rev-range-to-git log-range))
+ magit-custom-options
+ extra-args)))
+ (magit-buffer-switch magit-log-buffer-name)
+ (magit-mode-init topdir 'magit-log-mode #'magit-refresh-log-buffer log-range
+ 'oneline args)))
+
+(define-obsolete-function-alias 'magit-display-log 'magit-log)
+
+(magit-define-command log-long-ranged ()
+ (interactive)
+ (magit-log-long t))
+
+(magit-define-command log-long (&optional ranged)
+ (interactive)
+ (let* ((range (if ranged
+ (magit-read-rev-range "Long log" "HEAD")
+ "HEAD"))
+ (topdir (magit-get-top-dir default-directory))
+ (args (append (list (magit-rev-range-to-git range))
+ magit-custom-options)))
+ (magit-buffer-switch magit-log-buffer-name)
+ (magit-mode-init topdir 'magit-log-mode #'magit-refresh-log-buffer range
+ 'long args)))
+
+;;; Reflog
+
+(defvar magit-reflog-head nil
+ "The HEAD of the reflog in the current buffer.
+This is only non-nil in reflog buffers.")
+(make-variable-buffer-local 'magit-reflog-head)
+
+(defun magit-refresh-reflog-buffer (head args)
+ (setq magit-reflog-head head)
+ (magit-create-log-buffer-sections
+ (apply #'magit-git-section
+ 'reflog (format "Local history of head %s" head) 'magit-wash-log "log"
+ (append magit-git-log-options
+ (list
+ "--walk-reflogs"
+ (format "--max-count=%s" magit-log-cutoff-length)
+ args)))))
+
+(define-derived-mode magit-reflog-mode magit-log-mode "Magit Reflog"
+ "Mode for looking at git reflog.
+
+\\{magit-reflog-mode-map}"
+ :group 'magit)
+
+(magit-define-command reflog (&optional ask-for-range)
+ (interactive)
+ (let ((at (or (if ask-for-range
+ (magit-read-rev "Reflog of" (or (magit-guess-branch) "HEAD")))
+ "HEAD")))
+ (let* ((topdir (magit-get-top-dir default-directory))
+ (args (magit-rev-to-git at)))
+ (magit-buffer-switch "*magit-reflog*")
+ (magit-mode-init topdir 'magit-reflog-mode
+ #'magit-refresh-reflog-buffer at args))))
+
+(magit-define-command reflog-ranged ()
+ (interactive)
+ (magit-reflog t))
+
+;;; Diffing
+
+(defvar magit-ediff-buffers nil
+ "List of buffers that may be killed by `magit-ediff-restore'.")
+
+(defvar magit-ediff-windows nil
+ "The window configuration that will be restored when Ediff is finished.")
+
+(defun magit-ediff()
+ "View the current DIFF section in ediff."
+ (interactive)
+ (let ((diff (magit-current-section)))
+ (when (magit-section-hidden diff)
+ ;; Range is not set until the first time the diff is visible.
+ ;; This somewhat hackish code makes sure it's been visible at least once.
+ (magit-toggle-section)
+ (magit-toggle-section)
+ (setq diff (magit-current-section)))
+ (if (eq 'hunk (magit-section-type diff))
+ (setq diff (magit-section-parent diff)))
+ (unless (eq 'diff (magit-section-type diff))
+ (error "No diff at this location"))
+ (let* ((type (magit-diff-item-kind diff))
+ (file1 (magit-diff-item-file diff))
+ (file2 (magit-diff-item-file2 diff))
+ (range (magit-diff-item-range diff)))
+ (cond
+ ((memq type '(new deleted typechange))
+ (message "Why ediff a %s file?" type))
+ ((and (eq type 'unmerged)
+ (eq (cdr range) 'working))
+ (magit-interactive-resolve file1))
+ ((consp (car range))
+ (magit-ediff* (magit-show (caar range) file2)
+ (magit-show (cdar range) file2)
+ (magit-show (cdr range) file1)))
+ (t
+ (magit-ediff* (magit-show (car range) file2)
+ (magit-show (cdr range) file1)))))))
+
+(defun magit-ediff* (a b &optional c)
+ (setq magit-ediff-buffers (list a b c))
+ (setq magit-ediff-windows (current-window-configuration))
+ (add-hook 'ediff-quit-hook 'magit-ediff-restore 'append)
+ (if c
+ (ediff-buffers3 a b c)
+ (ediff-buffers a b)))
+
+(defun magit-ediff-restore()
+ "Kill any buffers in `magit-ediff-buffers' that are not visiting files and
+restore the window state that was saved before ediff was called."
+ (dolist (buffer magit-ediff-buffers)
+ (if (and (null (buffer-file-name buffer))
+ (buffer-live-p buffer))
+ (kill-buffer buffer)))
+ (setq magit-ediff-buffers nil)
+ (set-window-configuration magit-ediff-windows)
+ (remove-hook 'ediff-quit-hook 'magit-ediff-restore))
+
+(defun magit-refresh-diff-buffer (range args)
+ (let ((magit-current-diff-range (cond
+ ((stringp range)
+ (cons range 'working))
+ ((null (cdr range))
+ (cons (car range) 'working))
+ (t
+ range))))
+ (setq magit-current-range range)
+ (magit-create-buffer-sections
+ (magit-git-section 'diffbuf
+ (magit-rev-range-describe range "Changes")
+ 'magit-wash-diffs
+ "diff" (magit-diff-U-arg) args "--"))))
+
+(define-derived-mode magit-diff-mode magit-mode "Magit Diff"
+ "Mode for looking at a git diff.
+
+\\{magit-diff-mode-map}"
+ :group 'magit)
+
+(magit-define-command diff (range)
+ (interactive (list (magit-read-rev-range "Diff")))
+ (if range
+ (let* ((dir default-directory)
+ (args (magit-rev-range-to-git range))
+ (buf (get-buffer-create "*magit-diff*")))
+ (display-buffer buf)
+ (with-current-buffer buf
+ (magit-mode-init dir 'magit-diff-mode #'magit-refresh-diff-buffer range args)))))
+
+(magit-define-command diff-working-tree (rev)
+ (interactive (list (magit-read-rev "Diff with" (magit-default-rev))))
+ (magit-diff (or rev "HEAD")))
+
+(defun magit-diff-with-mark ()
+ (interactive)
+ (magit-diff (cons (magit-marked-commit)
+ (magit-commit-at-point))))
+
+;;; Wazzup
+
+(defvar magit-wazzup-head nil
+ "The integration head for the current wazzup buffer.
+This is only non-nil in wazzup buffers.")
+(make-variable-buffer-local 'magit-wazzup-head)
+
+(defvar magit-wazzup-all-p nil
+ "Non-nil if the current wazzup buffer displays excluded branches.
+This is only meaningful in wazzup buffers.")
+(make-variable-buffer-local 'magit-wazzup-all-p)
+
+(defun magit-wazzup-toggle-ignore (branch edit)
+ (let ((ignore-file (concat (magit-git-dir) "info/wazzup-exclude")))
+ (if edit
+ (setq branch (read-string "Branch to ignore for wazzup: " branch)))
+ (let ((ignored (magit-file-lines ignore-file)))
+ (cond ((member branch ignored)
+ (when (or (not edit)
+ (y-or-n-p "Branch %s is already ignored. Unignore? "))
+ (setq ignored (delete branch ignored))))
+ (t
+ (setq ignored (append ignored (list branch)))))
+ (magit-write-file-lines ignore-file ignored)
+ (magit-need-refresh))))
+
+(defun magit-refresh-wazzup-buffer (head all)
+ (setq magit-wazzup-head head)
+ (setq magit-wazzup-all-p all)
+ (let ((branch-desc (or head "(detached) HEAD")))
+ (unless head (setq head "HEAD"))
+ (magit-create-buffer-sections
+ (magit-with-section 'wazzupbuf nil
+ (insert (format "Wazzup, %s\n\n" branch-desc))
+ (let* ((excluded (magit-file-lines (concat (magit-git-dir) "info/wazzup-exclude")))
+ (all-branches (magit-list-interesting-refs))
+ (branches (if all all-branches
+ (delq nil (mapcar
+ (lambda (b)
+ (and (not
+ (member (cdr b) excluded))
+ b))
+ all-branches))))
+ (reported (make-hash-table :test #'equal)))
+ (dolist (branch branches)
+ (let* ((name (car branch))
+ (ref (cdr branch))
+ (hash (magit-rev-parse ref))
+ (reported-branch (gethash hash reported)))
+ (unless (or (and reported-branch
+ (string= (file-name-nondirectory ref)
+ reported-branch))
+ (not (magit-git-string "merge-base" head ref)))
+ (puthash hash (file-name-nondirectory ref) reported)
+ (let* ((n (length (magit-git-lines "log" "--pretty=oneline"
+ (concat head ".." ref))))
+ (section
+ (let ((magit-section-hidden-default t))
+ (magit-git-section
+ (cons ref 'wazzup)
+ (format "%s unmerged commits in %s%s"
+ n name
+ (if (member ref excluded)
+ " (normally ignored)"
+ ""))
+ 'magit-wash-log
+ "log"
+ (format "--max-count=%s" magit-log-cutoff-length)
+ "--abbrev-commit"
+ (format "--abbrev=%s" magit-sha1-abbrev-length)
+ "--graph"
+ "--pretty=oneline"
+ (format "%s..%s" head ref)
+ "--"))))
+ (magit-set-section-info ref section))))))))))
+
+(define-derived-mode magit-wazzup-mode magit-mode "Magit Wazzup"
+ "Mode for looking at commits that could be merged from other branches.
+
+\\{magit-wazzup-mode-map}"
+ :group 'magit)
+
+(defun magit-wazzup (&optional all)
+ (interactive "P")
+ (let ((topdir (magit-get-top-dir default-directory))
+ (current-branch (magit-get-current-branch)))
+ (magit-buffer-switch "*magit-wazzup*")
+ (magit-mode-init topdir 'magit-wazzup-mode
+ #'magit-refresh-wazzup-buffer
+ current-branch all)))
+
+(defun magit-filename (filename)
+ "Return the path of FILENAME relative to its git repository.
+
+If FILENAME is absolute, return a path relative to the git
+repository containing it. Otherwise, return a path relative to
+the current git repository."
+ (let ((topdir (expand-file-name
+ (magit-get-top-dir (or (file-name-directory filename)
+ default-directory))))
+ (file (file-truename filename)))
+ (when (and (not (string= topdir ""))
+ ;; FILE must start with the git repository path
+ (zerop (string-match-p (concat "\\`" topdir) file)))
+ (substring file (length topdir)))))
+
+;; This variable is used to keep track of the current file in the
+;; *magit-log* buffer when this one is dedicated to showing the log of
+;; just 1 file.
+(defvar magit-file-log-file nil)
+(make-variable-buffer-local 'magit-file-log-file)
+
+(defun magit-refresh-file-log-buffer (file range style)
+ "Refresh the current file-log buffer by calling git.
+
+FILE is the path of the file whose log must be displayed.
+
+`magit-current-range' will be set to the value of RANGE.
+
+STYLE controls the display. It is either `'long', `'oneline', or something else.
+ "
+ (magit-configure-have-graph)
+ (magit-configure-have-decorate)
+ (magit-configure-have-abbrev)
+ (setq magit-current-range range)
+ (setq magit-file-log-file file)
+ (magit-create-log-buffer-sections
+ (apply #'magit-git-section nil
+ (magit-rev-range-describe range (format "Commits for file %s" file))
+ (apply-partially 'magit-wash-log style)
+ `("log"
+ ,(format "--max-count=%s" magit-log-cutoff-length)
+ ,"--abbrev-commit"
+ ,(format "--abbrev=%s" magit-sha1-abbrev-length)
+ ,@(cond ((eq style 'long) (list "--stat" "-z"))
+ ((eq style 'oneline) (list "--pretty=oneline"))
+ (t nil))
+ ,@(if magit-have-decorate (list "--decorate=full"))
+ ,@(if magit-have-graph (list "--graph"))
+ "--"
+ ,file))))
+
+(defun magit-file-log (&optional all)
+ "Display the log for the currently visited file or another one.
+
+With a prefix argument or if no file is currently visited, ask
+for the file whose log must be displayed."
+ (interactive "P")
+ (let ((topdir (magit-get-top-dir default-directory))
+ (current-file (magit-filename
+ (if (or current-prefix-arg (not buffer-file-name))
+ (magit-read-file-from-rev (magit-get-current-branch))
+ buffer-file-name)))
+ (range "HEAD"))
+ (magit-buffer-switch "*magit-log*")
+ (magit-mode-init topdir 'magit-log-mode
+ #'magit-refresh-file-log-buffer
+ current-file range 'oneline)))
+
+(defun magit-show-file-revision ()
+ "Open a new buffer showing the current file in the revision at point."
+ (interactive)
+ (flet ((magit-show-file-from-diff (item)
+ (switch-to-buffer-other-window
+ (magit-show (cdr (magit-diff-item-range item))
+ (magit-diff-item-file item)))))
+ (magit-section-action (item info "show")
+ ((commit)
+ (let ((current-file (or magit-file-log-file
+ (magit-read-file-from-rev info))))
+ (switch-to-buffer-other-window
+ (magit-show info current-file))))
+ ((hunk) (magit-show-file-from-diff (magit-hunk-item-diff item)))
+ ((diff) (magit-show-file-from-diff item)))))
+
+;;; Miscellaneous
+
+(defun magit-ignore-modifiable-file (file edit)
+ "Prompt the user for the filename to be added to git ignore.
+\\<minibuffer-local-map>
+The minibuffer's future history (accessible with \\[next-history-element])
+contains predefined values (such as wildcards) that might
+be of interest.
+The history and default value are derived from the filename FILE.
+If EDIT argument is negative, the prompt proposes wildcard by default.
+"
+ (let* ((just-extension (concat "*." (file-name-extension file)))
+ (full-extension (concat (file-name-directory file) just-extension))
+ (just-file (file-name-nondirectory file))
+ ;; change the order in history depending on the negativity of
+ ;; EDIT.
+ (history (if (< (prefix-numeric-value edit) 0)
+ (list full-extension just-extension file just-file)
+ (list file full-extension just-extension just-file))))
+ (read-string
+ (format "File to ignore [%s]: " (car history))
+ nil nil history)))
+
+(defun magit-ignore-file (file edit local)
+ "Add FILE to the list of files to ignore.
+\\<minibuffer-local-map>
+If EDIT is non-`nil', prompt the user for the filename to
+be added to git ignore. In this case, the minibuffer's
+future history (accessible with \\[next-history-element]) contains predefined
+values (such as wildcards) that might be of interest.
+
+If LOCAL is nil, the `.gitignore' file is updated.
+Otherwise, it is `.git/info/exclude'."
+ (let* ((local-ignore-dir (concat (magit-git-dir) "info/"))
+ (ignore-file (if local
+ (concat local-ignore-dir "exclude")
+ ".gitignore")))
+ (if edit
+ (setq file (magit-ignore-modifiable-file file edit)))
+ (if (and local (not (file-exists-p local-ignore-dir)))
+ (make-directory local-ignore-dir t))
+ (with-temp-buffer
+ (when (file-exists-p ignore-file)
+ (insert-file-contents ignore-file))
+ (goto-char (point-max))
+ (unless (bolp)
+ (insert "\n"))
+ (insert file "\n")
+ (write-region nil nil ignore-file))
+ (magit-need-refresh)))
+
+(defun magit-ignore-item ()
+ "Add FILE to the `.gitignore' list of files to ignore.
+\\<minibuffer-local-map>
+With a prefix argument, prompt the user for the filename to
+be added. In this case, the minibuffer's future history
+\(accessible with \\[next-history-element]) contains predefined values (such as
+wildcards) that might be of interest. If prefix argument is
+negative, the prompt proposes wildcard by default."
+ (interactive)
+ (magit-section-action (item info "ignore")
+ ((untracked file)
+ (magit-ignore-file (concat "/" info) current-prefix-arg nil))
+ ((wazzup)
+ (magit-wazzup-toggle-ignore info current-prefix-arg))))
+
+(defun magit-ignore-item-locally ()
+ "Add FILE to the `.git/info/exclude' list of files to ignore.
+\\<minibuffer-local-map>
+With a prefix argument, prompt the user for the filename to
+be added. In this case, the minibuffer's future history
+(accessible with \\[next-history-element]) contains predefined values (such as
+wildcards) that might be of interest. If prefix argument is
+negative, the prompt proposes wildcard by default."
+ (interactive)
+ (magit-section-action (item info "ignore")
+ ((untracked file)
+ (magit-ignore-file (concat "/" info) current-prefix-arg t))))
+
+(defun magit-discard-diff (diff stagedp)
+ (let ((kind (magit-diff-item-kind diff))
+ (file (magit-diff-item-file diff)))
+ (cond ((eq kind 'deleted)
+ (when (yes-or-no-p (format "Resurrect %s? " file))
+ (magit-run-git "reset" "-q" "--" file)
+ (magit-run-git "checkout" "--" file)))
+ ((eq kind 'new)
+ (if (yes-or-no-p (format "Delete %s? " file))
+ (magit-run-git "rm" "-f" "--" file)))
+ (t
+ (if (yes-or-no-p (format "Discard changes to %s? " file))
+ (if stagedp
+ (magit-run-git "checkout" "HEAD" "--" file)
+ (magit-run-git "checkout" "--" file)))))))
+
+(defun magit-discard-item ()
+ (interactive)
+ (magit-section-action (item info "discard")
+ ((untracked file)
+ (when (yes-or-no-p (format "Delete %s? " info))
+ (if (and (file-directory-p info)
+ (not (file-symlink-p info)))
+ (magit-delete-directory info 'recursive)
+ (delete-file info))
+ (magit-refresh-buffer)))
+ ((untracked)
+ (if (yes-or-no-p "Delete all untracked files and directories? ")
+ (magit-run-git "clean" "-df")))
+ ((unstaged diff hunk)
+ (when (yes-or-no-p (if (magit-use-region-p)
+ "Discard changes in region? "
+ "Discard hunk? "))
+ (magit-apply-hunk-item-reverse item)))
+ ((staged diff hunk)
+ (if (magit-file-uptodate-p (magit-diff-item-file
+ (magit-hunk-item-diff item)))
+ (when (yes-or-no-p (if (magit-use-region-p)
+ "Discard changes in region? "
+ "Discard hunk? "))
+ (magit-apply-hunk-item-reverse item "--index"))
+ (error "Can't discard this hunk. Please unstage it first")))
+ ((unstaged diff)
+ (magit-discard-diff item nil))
+ ((staged diff)
+ (if (magit-file-uptodate-p (magit-diff-item-file item))
+ (magit-discard-diff item t)
+ (error "Can't discard staged changes to this file. Please unstage it first")))
+ ((diff diff)
+ (save-excursion
+ (magit-goto-parent-section)
+ (magit-discard-item)))
+ ((diff diff hunk)
+ (save-excursion
+ (magit-goto-parent-section)
+ (magit-goto-parent-section)
+ (magit-discard-item)))
+ ((hunk)
+ (error "Can't discard this hunk"))
+ ((diff)
+ (error "Can't discard this diff"))
+ ((stash)
+ (when (yes-or-no-p "Discard stash? ")
+ (magit-run-git "stash" "drop" info)))
+ ((branch)
+ (when (yes-or-no-p (if current-prefix-arg
+ "Force delete branch?"
+ "Delete branch? "))
+ (magit-delete-branch info current-prefix-arg)))
+ ((remote)
+ (when (yes-or-no-p "Remove remote? ")
+ (magit-remove-remote info)))))
+
+(defun magit-move-item ()
+ (interactive)
+ (magit-section-action (item info "move")
+ ((branch)
+ (call-interactively 'magit-move-branch))
+ ((remote)
+ (call-interactively 'magit-rename-remote))))
+
+(defmacro magit-visiting-file-item (&rest body)
+ `(let ((marker (save-window-excursion
+ (magit-visit-file-item)
+ (set-marker (make-marker) (point)))))
+ (save-excursion
+ (with-current-buffer (marker-buffer marker)
+ (goto-char marker)
+ ,@body))))
+
+(defun magit-add-change-log-entry-no-option (&optional other-window)
+ "Add a change log entry for current change.
+With a prefix argument, edit in other window.
+The name of the change log file is set by variable change-log-default-name."
+ (interactive "P")
+ (if other-window
+ (magit-visiting-file-item (add-change-log-entry-other-window))
+ (magit-visiting-file-item (add-change-log-entry))))
+
+(defun magit-add-change-log-entry-other-window ()
+ (interactive)
+ (magit-visiting-file-item (call-interactively 'add-change-log-entry-other-window)))
+
+(eval-after-load 'dired-x
+ '(defun magit-dired-jump (&optional other-window)
+ "Visit current item.
+With a prefix argument, visit in other window."
+ (interactive "P")
+ (require 'dired-x)
+ (magit-section-action (item info "dired-jump")
+ ((untracked file)
+ (dired-jump other-window (file-truename info)))
+ ((diff)
+ (dired-jump other-window (file-truename (magit-diff-item-file item))))
+ ((hunk)
+ (dired-jump other-window
+ (file-truename (magit-diff-item-file
+ (magit-hunk-item-diff item))))))))
+
+(defun magit-visit-file-item (&optional other-window)
+ "Visit current file associated with item.
+With a prefix argument, visit in other window."
+ (interactive "P")
+ (magit-section-action (item info "visit-file")
+ ((untracked file)
+ (funcall
+ (if other-window 'find-file-other-window 'find-file)
+ info))
+ ((diff)
+ (let ((file (magit-diff-item-file item)))
+ (cond ((not (file-exists-p file))
+ (error "Can't visit deleted file: %s" file))
+ ((file-directory-p file)
+ (magit-status file))
+ (t
+ (funcall
+ (if other-window 'find-file-other-window 'find-file)
+ file)))))
+ ((hunk)
+ (let ((file (magit-diff-item-file (magit-hunk-item-diff item)))
+ (line (magit-hunk-item-target-line item)))
+ (if (not (file-exists-p file))
+ (error "Can't visit deleted file: %s" file))
+ (funcall
+ (if other-window 'find-file-other-window 'find-file)
+ file)
+ (goto-char (point-min))
+ (forward-line (1- line))))))
+
+(defun magit-visit-item (&optional other-window)
+ "Visit current item.
+With a prefix argument, visit in other window."
+ (interactive "P")
+ (magit-section-action (item info "visit")
+ ((untracked file)
+ (call-interactively 'magit-visit-file-item))
+ ((diff)
+ (call-interactively 'magit-visit-file-item))
+ ((hunk)
+ (call-interactively 'magit-visit-file-item))
+ ((commit)
+ (magit-show-commit info nil nil 'select))
+ ((stash)
+ (magit-show-stash info)
+ (pop-to-buffer magit-stash-buffer-name))
+ ((branch)
+ (magit-checkout info))
+ ((longer)
+ (magit-log-show-more-entries ()))))
+
+(defun magit-show-item-or-scroll-up ()
+ (interactive)
+ (magit-section-action (item info)
+ ((commit)
+ (magit-show-commit info #'scroll-up))
+ ((stash)
+ (magit-show-stash info #'scroll-up))
+ (t
+ (scroll-up))))
+
+(defun magit-show-item-or-scroll-down ()
+ (interactive)
+ (magit-section-action (item info)
+ ((commit)
+ (magit-show-commit info #'scroll-down))
+ ((stash)
+ (magit-show-stash info #'scroll-down))
+ (t
+ (scroll-down))))
+
+(defun magit-mark-item (&optional unmark)
+ (interactive "P")
+ (if unmark
+ (magit-set-marked-commit nil)
+ (magit-section-action (item info "mark")
+ ((commit)
+ (magit-set-marked-commit (if (eq magit-marked-commit info)
+ nil
+ info))))))
+
+(defun magit-describe-item ()
+ (interactive)
+ (let ((section (magit-current-section)))
+ (message "Section: %s %s-%s %S %S %S"
+ (magit-section-type section)
+ (magit-section-beginning section)
+ (magit-section-end section)
+ (magit-section-title section)
+ (magit-section-info section)
+ (magit-section-context-type section))))
+
+(defun magit-copy-item-as-kill ()
+ "Copy sha1 of commit at point into kill ring."
+ (interactive)
+ (magit-section-action (item info "copy")
+ ((commit)
+ (kill-new info)
+ (message "%s" info))))
+
+(eval-when-compile (require 'server))
+
+(defun magit-server-running-p ()
+ "Test whether server is running (works with < 23 as well).
+
+Return values:
+ nil the server is definitely not running.
+ t the server seems to be running.
+ something else we cannot determine whether it's running without using
+ commands which may have to wait for a long time."
+ (require 'server)
+ (if (functionp 'server-running-p)
+ (server-running-p)
+ (condition-case nil
+ (if server-use-tcp
+ (with-temp-buffer
+ (insert-file-contents-literally (expand-file-name server-name server-auth-dir))
+ (or (and (looking-at "127\\.0\\.0\\.1:[0-9]+ \\([0-9]+\\)")
+ (assq 'comm
+ (process-attributes
+ (string-to-number (match-string 1))))
+ t)
+ :other))
+ (delete-process
+ (make-network-process
+ :name "server-client-test" :family 'local :server nil :noquery t
+ :service (expand-file-name server-name server-socket-dir)))
+ t)
+ (file-error nil))))
+
+(defun magit-interactive-rebase ()
+ "Start a git rebase -i session, old school-style."
+ (interactive)
+ (unless (magit-server-running-p)
+ (server-start))
+ (let* ((section (get-text-property (point) 'magit-section))
+ (commit (and (member 'commit (magit-section-context-type section))
+ (magit-section-info section)))
+ (old-editor (getenv "GIT_EDITOR")))
+ (setenv "GIT_EDITOR" (concat (locate-file "emacsclient" exec-path)
+ " -s " server-name))
+ (unwind-protect
+ (magit-run-git-async "rebase" "-i"
+ (or (and commit (concat commit "^"))
+ (magit-read-rev "Interactively rebase to" (magit-guess-branch))))
+ (if old-editor
+ (setenv "GIT_EDITOR" old-editor)))))
+
+(define-derived-mode magit-branch-manager-mode magit-mode "Magit Branch"
+ "Magit Branches")
+
+(defun magit-quit-window (&optional kill-buffer)
+ "Bury the buffer and delete its window. With a prefix argument, kill the
+buffer instead."
+ (interactive "P")
+ (quit-window kill-buffer (selected-window)))
+
+(defun magit--branch-name-at-point ()
+ "Get the branch name in the line at point."
+ (let ((branch (magit-section-info (magit-current-section))))
+ (or branch (error "No branch at point"))))
+
+(defun magit--branches-for-remote-repo (remote)
+ "Return a list of remote branch names for REMOTE.
+These are the branch names with the remote name stripped."
+ (remq nil
+ (mapcar (lambda (line)
+ (save-match-data
+ (if (and (not (string-match-p " -> " line))
+ (string-match (concat "^ +" remote "/\\([^ $]+\\)")
+ line))
+ (match-string 1 line))))
+ (magit-git-lines "branch" "-r"))))
+
+(defvar magit-branches-buffer-name "*magit-branches*")
+
+(defun magit--is-branch-at-point-remote ()
+ "Return non-nil if the branch at point is a remote tracking branch"
+ (magit-remote-part-of-branch (magit--branch-name-at-point)))
+
+(defun magit-remote-part-of-branch (branch)
+ (when (string-match-p "^\\(?:refs/\\)?remotes\\/" branch)
+ (loop for remote in (magit-git-lines "remote")
+ when (string-match-p (format "^\\(?:refs/\\)?remotes\\/%s\\/" (regexp-quote remote)) branch) return remote)))
+
+(defun magit-branch-no-remote (branch)
+ (let ((remote (magit-remote-part-of-branch branch)))
+ (if remote
+ (progn
+ ;; This has to match if remote is non-nil
+ (assert (string-match (format "^\\(?:refs/\\)?remotes\\/%s\\/\\(.*\\)" (regexp-quote remote)) branch)
+ 'show-args "Unexpected string-match failure: %s %s")
+ (match-string 1 branch))
+ branch)))
+
+(defun magit-wash-branch-line (&optional remote-name)
+ (looking-at (concat
+ "^\\([ *] \\)" ; 1: current branch marker
+ "\\(.+?\\) +" ; 2: branch name
+
+ "\\(?:"
+
+ "\\([0-9a-fA-F]+\\)" ; 3: sha1
+ " "
+ "\\(?:\\["
+ "\\([^:\n]+?\\)" ; 4: tracking (non-greedy + to avoid matching \n)
+ "\\(?:: \\)?"
+ "\\(?:ahead \\([0-9]+\\)\\)?" ; 5: ahead
+ "\\(?:, \\)?"
+ "\\(?:behind \\([0-9]+\\)\\)?" ; 6: behind
+ "\\] \\)?"
+ "\\(?:.*\\)" ; message
+
+ "\\|" ; or
+
+ "-> " ; the pointer to
+ "\\(.+\\)" ; 7: a ref
+
+ "\\)\n"))
+
+ (let* ((current-string (match-string 1))
+ (branch (match-string 2))
+ (sha1 (match-string 3))
+ (tracking (match-string 4))
+ (ahead (match-string 5))
+ (behind (match-string 6))
+ (other-ref (match-string 7))
+ (current (string-match-p "^\\*" current-string)))
+
+ ; the current line is deleted before being reconstructed
+ (delete-region (point)
+ (line-beginning-position 2))
+
+ (magit-with-section branch 'branch
+ (magit-set-section-info branch)
+ (insert-before-markers
+ ; sha1
+ (propertize (or sha1
+ (make-string magit-sha1-abbrev-length ? ))
+ 'face 'magit-log-sha1)
+ " "
+ ; current marker
+ (if current
+ "# "
+ " ")
+ ; branch name
+ (apply 'propertize (magit-branch-no-remote branch)
+ (if current
+ '(face magit-branch)))
+ ; other ref that this branch is pointing to
+ (if other-ref
+ (concat " -> " (substring other-ref (+ 1 (length remote-name))))
+ "")
+ ; tracking information
+ (if (and tracking
+ (equal (magit-remote-branch-for branch t)
+ (concat "refs/remotes/" tracking)))
+ (concat " ["
+ ; getting rid of the tracking branch name if it is the same as the branch name
+ (let* ((tracking-remote (magit-get "branch" branch "remote"))
+ (tracking-branch (substring tracking (+ 1 (length tracking-remote)))))
+ (propertize (if (string= branch tracking-branch)
+ (concat "@ " tracking-remote)
+ (concat tracking-branch " @ " tracking-remote))
+ 'face 'magit-log-head-label-remote))
+ ; ahead/behind information
+ (if (or ahead
+ behind)
+ ": "
+ "")
+ (if ahead
+ (concat "ahead "
+ (propertize ahead
+ 'face (if current
+ 'magit-branch))
+ (if behind
+ ", "
+ ""))
+ "")
+ (if behind
+ (concat "behind "
+ (propertize behind
+ 'face 'magit-log-head-label-remote))
+ "")
+ "]")
+ "")
+ "\n"))))
+
+(defun magit-wash-remote-branches-group (group)
+ (let* ((remote-name (first group))
+ (url (magit-get "remote" remote-name "url"))
+ (push-url (magit-get "remote" remote-name "pushurl"))
+ (urls (concat url (if push-url
+ (concat ", "push-url)
+ "")))
+ (marker (second group)))
+
+ (magit-with-section (concat "remote:" remote-name) 'remote
+ (magit-set-section-info remote-name)
+ (insert-before-markers (propertize (format "%s (%s):" remote-name urls) 'face 'magit-section-title) "\n")
+ (magit-wash-branches-between-point-and-marker marker remote-name))
+ (insert-before-markers "\n")))
+
+(defun magit-wash-branches-between-point-and-marker (marker &optional remote-name)
+ (save-restriction
+ (narrow-to-region (point) marker)
+ (magit-wash-sequence
+ (if remote-name
+ (apply-partially 'magit-wash-branch-line remote-name)
+ #'magit-wash-branch-line))))
+
+(defun magit-wash-branches ()
+ ; get the names of the remotes
+ (let* ((remotes (magit-git-lines "remote"))
+ ; get the location of remotes in the buffer
+ (markers
+ (append (mapcar (lambda (remote)
+ (save-excursion
+ (when (search-forward-regexp
+ (concat "^ remotes\\/" remote) nil t)
+ (beginning-of-line)
+ (point-marker))))
+ remotes)
+ (list (save-excursion
+ (goto-char (point-max))
+ (point-marker)))))
+ ; list of remote elements to display in the buffer
+ (remote-groups (loop for remote in remotes
+ for end-markers on (cdr markers)
+ for marker = (loop for x in end-markers thereis x)
+ collect (list remote marker))))
+
+ ; actual displaying of information
+ (magit-with-section "local" nil
+ (insert-before-markers (propertize "Local:" 'face 'magit-section-title) "\n")
+ (magit-set-section-info ".")
+ (magit-wash-branches-between-point-and-marker
+ (loop for x in markers thereis x)))
+
+ (insert-before-markers "\n")
+
+ (mapc 'magit-wash-remote-branches-group remote-groups)
+
+ ; make sure markers point to nil so that they can be garbage collected
+ (mapc (lambda (marker)
+ (when marker
+ (set-marker marker nil)))
+ markers)))
+
+(defun magit-refresh-branch-manager ()
+ (magit-create-buffer-sections
+ (magit-git-section "branches" nil 'magit-wash-branches
+ "branch"
+ "-vva"
+ (format "--abbrev=%s" magit-sha1-abbrev-length))))
+
+(magit-define-command branch-manager ()
+ (interactive)
+ (let ((topdir (magit-get-top-dir default-directory)))
+ (magit-buffer-switch magit-branches-buffer-name)
+ (magit-mode-init topdir 'magit-branch-manager-mode #'magit-refresh-branch-manager)))
+
+(defun magit-change-what-branch-tracks ()
+ "Change which remote branch the current branch tracks."
+ (interactive)
+ (if (magit--is-branch-at-point-remote)
+ (error "Cannot modify a remote branch"))
+ (let* ((local-branch (magit--branch-name-at-point))
+ (new-tracked (magit-read-rev "Change tracked branch to"
+ nil
+ (lambda (ref)
+ (not (string-match-p "refs/remotes/"
+ ref)))))
+ new-remote new-branch)
+ (unless (string= (or new-tracked "") "")
+ (cond (;; Match refs that are unknown in the local repository if
+ ;; `magit-remote-ref-format' is set to
+ ;; `name-then-remote'. Can be useful if you want to
+ ;; create a new branch in a remote repository.
+ (string-match "^\\([^ ]+\\) +(\\(.+\\))$" ; 1: branch name; 2: remote name
+ new-tracked)
+ (setq new-remote (match-string 2 new-tracked)
+ new-branch (concat "refs/heads/" (match-string 1 new-tracked))))
+ ((string-match "^\\(?:refs/remotes/\\)?\\([^/]+\\)/\\(.+\\)" ; 1: remote name; 2: branch name
+ new-tracked)
+ (setq new-remote (match-string 1 new-tracked)
+ new-branch (concat "refs/heads/" (match-string 2 new-tracked))))
+ (t (error "Cannot parse the remote and branch name"))))
+ (magit-set new-remote "branch" local-branch "remote")
+ (magit-set new-branch "branch" local-branch "merge")
+ (magit-branch-manager)
+ (if (string= (magit-get-current-branch) local-branch)
+ (magit-refresh-buffer (magit-find-status-buffer default-directory)))))
+
+(defvar magit-ediff-file)
+
+(defun magit-interactive-resolve (file)
+ (require 'ediff)
+ (let ((merge-status (magit-git-string "ls-files" "-u" "--" file))
+ (base-buffer (generate-new-buffer (concat file ".base")))
+ (our-buffer (generate-new-buffer (concat file ".current")))
+ (their-buffer (generate-new-buffer (concat file ".merged")))
+ (windows (current-window-configuration)))
+ (if (null merge-status)
+ (error "Cannot resolve %s" file))
+ (with-current-buffer base-buffer
+ (if (string-match "^[0-9]+ [0-9a-f]+ 1" merge-status)
+ (insert (magit-git-output `("cat-file" "blob" ,(concat ":1:" file))))))
+ (with-current-buffer our-buffer
+ (if (string-match "^[0-9]+ [0-9a-f]+ 2" merge-status)
+ (insert (magit-git-output `("cat-file" "blob" ,(concat ":2:" file)))))
+ (let ((buffer-file-name file))
+ (normal-mode)))
+ (with-current-buffer their-buffer
+ (if (string-match "^[0-9]+ [0-9a-f]+ 3" merge-status)
+ (insert (magit-git-output `("cat-file" "blob" ,(concat ":3:" file)))))
+ (let ((buffer-file-name file))
+ (normal-mode)))
+ ;; We have now created the 3 buffer with ours, theirs and the ancestor files
+ (with-current-buffer (ediff-merge-buffers-with-ancestor our-buffer their-buffer base-buffer)
+ (make-local-variable 'magit-ediff-file)
+ (setq magit-ediff-file file)
+ (make-local-variable 'magit-ediff-windows)
+ (setq magit-ediff-windows windows)
+ (make-local-variable 'ediff-quit-hook)
+ (add-hook 'ediff-quit-hook
+ (lambda ()
+ (let ((buffer-A ediff-buffer-A)
+ (buffer-B ediff-buffer-B)
+ (buffer-C ediff-buffer-C)
+ (buffer-Ancestor ediff-ancestor-buffer)
+ (file magit-ediff-file)
+ (file-buffer)
+ (windows magit-ediff-windows))
+ (ediff-cleanup-mess)
+ (find-file file)
+ (setq file-buffer (current-buffer))
+ (erase-buffer)
+ (insert-buffer-substring buffer-C)
+ (kill-buffer buffer-A)
+ (kill-buffer buffer-B)
+ (kill-buffer buffer-C)
+ (when (bufferp buffer-Ancestor) (kill-buffer buffer-Ancestor))
+ (set-window-configuration windows)
+ (magit-save-some-buffers
+ "Conflict resolution finished; you may save the buffer"
+ (lambda () (eq (current-buffer) file-buffer)))))))))
+
+(defun magit-interactive-resolve-item ()
+ (interactive)
+ (magit-section-action (item info "resolv")
+ ((diff)
+ (magit-interactive-resolve (cadr info)))))
+
+(defun magit-submodule-update (&optional init)
+ "Update the submodule of the current git repository
+
+With a prefix arg, do a submodule update --init"
+ (interactive "P")
+ (let ((default-directory (magit-get-top-dir default-directory)))
+ (apply #'magit-run-git-async "submodule" "update" (if init '("--init") ()))))
+
+(defun magit-submodule-update-init ()
+ "Update and init the submodule of the current git repository."
+ (interactive)
+ (magit-submodule-update t))
+
+(defun magit-submodule-init ()
+ "Initialize the submodules"
+ (interactive)
+ (let ((default-directory (magit-get-top-dir default-directory)))
+ (magit-run-git-async "submodule" "init")))
+
+(defun magit-submodule-sync ()
+ "Synchronizes submodules' remote URL configuration"
+ (interactive)
+ (let ((default-directory (magit-get-top-dir default-directory)))
+ (magit-run-git-async "submodule" "sync")))
+
+(defun magit-run-git-gui ()
+ "Run `git gui' for the current git repository"
+ (interactive)
+ (let* ((default-directory (magit-get-top-dir default-directory)))
+ (magit-start-process "Git Gui" nil magit-git-executable "gui")))
+
+(defun magit-run-gitk ()
+ "Run `gitk --all' for the current git repository"
+ (interactive)
+ (let ((default-directory (magit-get-top-dir default-directory)))
+ (cond
+ ((eq system-type 'windows-nt)
+ ;; Gitk is a shell script, and Windows doesn't know how to
+ ;; "execute" it. The Windows version of Git comes with an
+ ;; implementation of "sh" and everything else it needs, but
+ ;; Windows users might not have added the directory where it's
+ ;; installed to their path
+ (let ((git-bin-dir (file-name-directory magit-gitk-executable))
+ (exec-path exec-path)
+ (process-environment process-environment))
+ (when git-bin-dir
+ ;; Adding it onto the end so that anything the user
+ ;; specified will get tried first. Emacs looks in
+ ;; exec-path; PATH is the environment variable inherited by
+ ;; the process. I need to change both.
+ (setq exec-path (append exec-path (list git-bin-dir)))
+ (push (format "PATH=%s;%s"
+ (getenv "PATH")
+ (replace-regexp-in-string "/" "\\\\" git-bin-dir))
+ process-environment))
+ (magit-start-process "Gitk" nil "sh" magit-gitk-executable "--all")))
+ (t
+ (magit-start-process "Gitk" nil magit-gitk-executable "--all")))))
+
+(defun magit-load-config-extensions ()
+ "Try to load magit extensions that are defined at git config
+layer. This can be added to `magit-mode-hook' for example"
+ (dolist (ext (magit-get-all "magit.extension"))
+ (let ((sym (intern (format "magit-%s-mode" ext))))
+ (when (and (fboundp sym)
+ (not (eq sym 'magit-wip-save-mode)))
+ (funcall sym 1)))))
+
+(provide 'magit)
+
+;; rest of magit core
+(require 'magit-key-mode)
+(require 'magit-bisect)
+
+;;; magit.el ends here
--- /dev/null
+This is magit.info, produced by makeinfo version 4.8 from magit.texi.
+
+INFO-DIR-SECTION Emacs
+START-INFO-DIR-ENTRY
+* Magit: (magit). Using Git from Emacs with Magit.
+END-INFO-DIR-ENTRY
+
+ Copyright (C) 2008, 2009, 2010, 2011 Magit contributors. (See the
+header of magit.el for the lengthy list of Magit contributors.)
+
+ Permission is granted to copy, distribute and/or modify this
+ document under the terms of the GNU Free Documentation License,
+ Version 1.2 or any later version published by the Free Software
+ Foundation; with no Invariant Sections, with no Front-Cover Texts,
+ and with no Back-Cover Texts.
+
+\1f
+File: magit.info, Node: Top, Next: Introduction, Up: (dir)
+
+Magit User Manual
+*****************
+
+Magit is an interface to the version control system Git, implemented as
+an extension to Emacs. Magit supports GNU Emacs version 22 or later.
+It may work with other emacsen, but Magit developers do not intend to
+investigate and fix bugs that only appear in unsupported versions.
+Patches to fix bugs in other emacsen or volunteers to maintain
+compatibility are still welcome.
+
+* Menu:
+
+* Introduction::
+* Acknowledgments::
+* Sections::
+* Status::
+* Untracked files::
+* Staging and Committing::
+* History::
+* Reflogs::
+* Commit Buffer::
+* Diffing::
+* Tagging::
+* Resetting::
+* Stashing::
+* Branching::
+* The Branch Manager::
+* Wazzup::
+* Merging::
+* Rebasing::
+* Interactive Rebasing::
+* Rewriting::
+* Pushing and Pulling::
+* Bisecting::
+* Submodules::
+* Using Magit Extensions::
+* Using Git Directly::
+* Customization::
+* Frequently Asked Questions::
+
+\1f
+File: magit.info, Node: Introduction, Next: Acknowledgments, Prev: Top, Up: Top
+
+1 Introduction
+**************
+
+With Magit, you can inspect and modify your Git repositories with
+Emacs. You can review and commit the changes you have made to the
+tracked files, for example, and you can browse the history of past
+changes. There is support for cherry picking, reverting, merging,
+rebasing, and other common Git operations.
+
+ Magit is not a complete interface to Git; it just aims to make the
+most common Git operations convenient. Thus, Magit will likely not
+save you from learning Git itself.
+
+ This manual provides a tour of all Magit features. It does not give
+an introduction to version control in general, or to Git in particular.
+
+ The main entry point to Magit is `M-x magit-status', which will put
+you in Magit's status buffer. You will be using it frequently, so it
+is probably a good idea to bind `magit-status' to a key of your choice.
+
+ In addition to the status buffer, Magit will also create buffers that
+show lists of commits, buffers with diffs, and other kinds of buffers.
+All these buffers are in `magit-mode' and have the same key bindings.
+Not all commands make sense in all contexts, but a given key will
+always do the same thing in all Magit buffers.
+
+ Naturally, Magit runs the `git' command to do most of the work. The
+`*magit-process*' buffer contains the transcript of the most recent
+command. You can switch to it with `$'.
+
+\1f
+File: magit.info, Node: Acknowledgments, Next: Sections, Prev: Introduction, Up: Top
+
+2 Acknowledgments
+*****************
+
+Marius Vollmer started the whole project. Thanks !
+
+ From day one of the first Magit announcement, John Wiegley has
+contributed numerous fixes, UI improvements, and new features. Thanks!
+
+ Linh Dang and Christian Neukirchen also contributed from day one.
+Thanks!
+
+ Phil Hagelberg joined a few days later. Thanks!
+
+ Alex Ott contributed support for git svn. Thanks!
+
+ Marcin Bachry contributed bug fixes and support for decorated logs.
+Thanks!
+
+ Alexey Voinov fixed bugs. Thanks!
+
+ Rémi Vanicat helped with Tramp support. Thanks!
+
+\1f
+File: magit.info, Node: Sections, Next: Status, Prev: Acknowledgments, Up: Top
+
+3 Sections
+**********
+
+All Magit buffers are structured into nested 'sections'. These
+sections can be hidden and shown individually. When a section is
+hidden, only its first line is shown and all its children are
+completely invisible.
+
+ The most fine-grained way to control the visibility of sections is
+the `TAB' key. It will to toggle the current section (the section that
+contains point) between being hidden and being shown.
+
+ Typing `S-TAB' toggles the visibility of the children of the current
+section. When all of them are shown, they will all be hidden.
+Otherwise, when some or all are hidden, they will all be shown.
+
+ The digit keys `1', `2', `3', and `4' control the visibility of
+sections based on levels. Hitting `2', for example, will show sections
+on levels one and two, and will hide sections on level 3. However,
+only sections that are a parent or child of the current section are
+affected.
+
+ For example, when the current section is on level 3 and you hit `1',
+the grand-parent of the current section (which is on level one) will be
+shown, and the parent of the current section (level 2) will be hidden.
+The visibility of no other section will be changed.
+
+ This sounds a bit complicated, but you'll figure it out.
+
+ Using `M-1', `M-2', `M-3', and `M-4' is similar to the unmodified
+digits, but now all sections on the respective level are affected,
+regardless of whether or not they are related to the current section.
+
+ For example, `M-1' will only show the first lines of the top-level
+sections and will hide everything else. Typing `M-4' on the other hand
+will show everything.
+
+ Because of the way the status buffer is set up, some changes to
+section visibility are more common than others. Files are on level 2
+and diff hunks are on level 4. Thus, you can type `2' to collapse the
+diff of the current file, and `M-2' to collapse all files. This
+returns the status buffer to its default setup and is a quick way to
+unclutter it after drilling down into the modified files.
+
+ Because `2' and `M-2' are so common in the status buffer, they are
+bound to additional, more mnemonic keys: `M-h' (hide) and `M-H' (hide
+all). Likewise `4' and `M-4' are also available as `M-s' (show) and
+`M-S' (show all).
+
+ In other buffers than the status buffer, `M-h', `M-H', `M-s', and
+`M-S' might work on different levels than on 2 and 4, but they keep
+their general meaning: `M-H' hides all detail, and `M-S' shows
+everything.
+
+\1f
+File: magit.info, Node: Status, Next: Untracked files, Prev: Sections, Up: Top
+
+4 Status
+********
+
+Running `M-x magit-status' displays the main interface of Magit, the
+status buffer. You can have multiple status buffers active at the same
+time, each associated with its own Git repository.
+
+ When invoking `M-x magit-status' from within a Git repository, it
+will switch to the status buffer of that repository. Otherwise, it
+will prompt for a directory. With a prefix argument, it will always
+prompt.
+
+ You can set `magit-repo-dirs' to customize how `magit-status' asks
+for the repository to work on. When `magit-repo-dirs' is nil,
+`magit-status' will simply ask for a directory.
+
+ If you specify a directory that is not a Git repository, `M-x
+magit-status' will offer to initialize it as one.
+
+ When `magit-repo-dirs' is not nil, it is treated as a list of
+directory names, and `magit-status' will find all Git repositories in
+those directories and offer them for completion. (Magit will only look
+`magit-repo-dirs-depth' levels deep, however.)
+
+ With two prefix arguments, `magit-status' will always prompt for a
+raw directory.
+
+ Thus, you would normally set `magit-repo-dirs' to the places where
+you keep most of your Git repositories and switch between them with
+`C-u M-x magit-status'. If you want to go to a repository outside of
+your normal working areas, or if you want to create a new repository,
+you would use `C-u C-u M-x magit-status'.
+
+ You need to explicitly refresh the status buffer when you have made
+changes to the repository from outside of Emacs. You can type `g' in
+the status buffer itself, or just use `M-x magit-status' instead of
+`C-x b' when switching to it. You also need to refresh the status
+buffer in this way after saving a file in Emacs.
+
+ The header at the top of the status buffer shows a short summary of
+the repository state: where it is located, which branch is checked out,
+etc. Below the header are a number of sections that show details about
+the working tree and the staging area. You can hide and show them as
+described in the previous section.
+
+ The first section shows _Untracked files_, if there are any. See
+*Note Untracked files:: for more details.
+
+ The next two sections show your local changes. They are explained
+fully in the next chapter, *Note Staging and Committing::.
+
+ If the current branch is associated with a remote tracking branch,
+the status buffer shows the differences between the current branch and
+the tracking branch. See *Note Pushing and Pulling:: for more
+information.
+
+ During a history rewriting session, the status buffer shows the
+_Pending changes_ and _Pending commits_ sections. See *Note
+Rewriting:: for more details.
+
+\1f
+File: magit.info, Node: Untracked files, Next: Staging and Committing, Prev: Status, Up: Top
+
+5 Untracked files
+*****************
+
+Untracked files are shown in the _Untracked files_ section.
+
+ You can add an untracked file to the staging area with `s'. If
+point is on the _Untracked files_ section title when you hit `s', all
+untracked files are staged.
+
+ Typing `C-u S' anywhere will also stage all untracked files,
+together with all changes to the tracked files.
+
+ You can instruct Git to ignore them by typing `i'. This will add
+the filename to the `.gitignore' file. Typing `C-u i' will ask you for
+the name of the file to ignore. This is useful to ignore whole
+directories, for example. In this case, the minibuffer's future history
+(accessible with `M-n') contains predefined values (such as wildcards)
+that might be of interest. If prefix argument is negative (for example
+after typing `C-- i'), the prompt proposes wildcard by default. The
+`I' command is similar to `i' but will add the file to
+`.git/info/exclude' instead.
+
+ To delete an untracked file forever, use `k'. If point is on the
+_Untracked files_ section title when you hit `k', all untracked files
+are deleted.
+
+\1f
+File: magit.info, Node: Staging and Committing, Next: History, Prev: Untracked files, Up: Top
+
+6 Staging and Committing
+************************
+
+Comitting with Git is a two step process: first you add the changes you
+want to commit to a 'staging area', and then you commit them to the
+repository. This allows you to only commit a subset of your local
+changes.
+
+ Magit allows you to ignore the staging area if you wish. As long as
+your staging area is unused, Magit will show your uncomitted changes in
+a section named _Changes_.
+
+ When the staging area is in use, Magit uses two sections: _Unstaged
+changes_ and _Staged changes_. The _Staged changes_ section shows the
+changes that will be included in the next commit, while the _Unstaged
+changes_ section shows the changes that will be left out.
+
+ To move an unstaged hunk into the staging area, move point into the
+hunk and type `s'. Likewise, to unstage a hunk, move point into it and
+type `u'. If point is in a diff header when you type `s' or `u', all
+hunks belonging to that diff are moved at the same time.
+
+ If the region is active when you type `s' or `u', only the changes
+in the region are staged or unstaged. (This works line by line: if the
+beginning of a line is in the region it is included in the changes,
+otherwise it is not.)
+
+ To change the size of the hunks, you can type `+' or `-' to increase
+and decrease, respectively. Typing `0' will reset the hunk size to the
+default.
+
+ Typing `C-u s' will ask you for a name of a file to be staged, for
+example to stage files that are hidden.
+
+ To move all hunks of all diffs into the staging area in one go, type
+`S'. To unstage everything, type `U'.
+
+ Typing `C-u S' will stage all untracked files in addition to the
+changes to tracked files.
+
+ You can discard uncommitted changes by moving point into a hunk and
+typing `k'. The changes to discard are selected as with `s' and `u'.
+
+ Before committing, you should write a short description of the
+changes.
+
+ Type `c' to pop up a buffer where you can write your change
+description. Once you are happy with the description, type `C-c C-c'
+in that buffer to perform the commit.
+
+ If you want to write changes in a `ChangeLog' file, you can use `C-x
+4 a' on a diff hunk.
+
+ Typing `c' when the staging area is unused is a special situation.
+Normally, the next commit would be empty, but you can configure Magit
+to do something more useful by customizing the
+`magit-commit-all-when-nothing-staged' variable. One choice is to
+instruct the subsequent `C-c C-c' to commit all changes. Another
+choice is stage everything at the time of hitting `c'.
+
+ You can type `C-c C-a' in the buffer with the change description to
+toggle a flag that determines whether the next commit will _amend_ the
+current commit in HEAD.
+
+ Typing `C-c C-s' will toggle the `--signoff' option. The default is
+determined by the `magit-commit-signoff' customization variable.
+
+ Typing `C-c C-e' will toggle the `--allow-empty' option. This
+allows you to make commits that serve as notes, without including any
+changes.
+
+ Typing `C-c C-t' will toggle the option to specify the name and
+email address for the commit's author. The default is determined by
+the `user.name' and `user.email' git configuration settings.
+
+ If you change your mind and don't want to go ahead with your commit
+while you are in the `*magit-log-edit*' buffer, you can just switch to
+another buffer, continue editing there, staging and unstaging things
+until you are happy, and then return to the `*magit-log-edit*' buffer,
+maybe via `C-x b', or by hitting `c' again in a Magit buffer.
+
+ If you want to erase the `*magit-log-edit*' buffer and bury it, you
+can hit `C-c C-k' in it.
+
+ Typing `C' will also pop up the change description buffer, but in
+addition, it will try to insert a ChangeLog-style entry for the change
+that point is in.
+
+\1f
+File: magit.info, Node: History, Next: Reflogs, Prev: Staging and Committing, Up: Top
+
+7 History
+*********
+
+To show the repository history of your current head, type `l l'. A new
+buffer will be shown that displays the history in a terse form. The
+first paragraph of each commit message is displayed, next to a
+representation of the relationships between commits.
+
+ To show the repository history between two branches or between any
+two points of the history, type `l r l'. You will be prompted to enter
+references for starting point and ending point of the history range; you
+can use auto-completion to specify them. A typical use case for ranged
+history log display would be `l r l master RET new-feature RET' that
+will display commits on the new-feature branch that are not in master;
+these commits can then be inspected and cherry-picked, for example.
+
+ More thorough filtering can be done by supplying `l' with one or
+more suffix arguments, as displayed in its popup. `=g' ('Grep') for
+example, limits the output to commits of which the log message matches
+a specific string/regex.
+
+ Typing `l L' (or `l C-u L') will show the log in a more verbose form.
+
+ Magit will show only `magit-log-cutoff-length' entries. `e' will
+show twice as many entries. `C-u e' will show all entries, and given a
+numeric prefix argument, `e' will add this number of entries.
+
+ You can move point to a commit and then cause various things to
+happen with it. (The following commands work in any list of commits,
+such as the one shown in the _Unpushed commits_ section.)
+
+ Typing `RET' will pop up more information about the current commit
+and move point into the new buffer. *Note Commit Buffer::. Typing
+`SPC' and `DEL' will also show the information, but will scroll the new
+buffer up or down (respectively) when typed again.
+
+ Typing `a' will apply the current commit to your current branch.
+This is useful when you are browsing the history of some other branch
+and you want to `cherry-pick' some changes from it. A typical
+situation is applying selected bug fixes from the development version
+of a program to a release branch. The cherry-picked changes will not
+be committed automatically; you need to do that explicitly.
+
+ Typing `A' will cherry-pick the current commit and will also commit
+the changes automatically when there have not been any conflicts.
+
+ Typing `v' will revert the current commit. Thus, it will apply the
+changes made by that commit in reverse. This is obviously useful to
+cleanly undo changes that turned out to be wrong. As with `a', you
+need to commit the changes explicitly.
+
+ Typing `C-w' will copy the sha1 of the current commit into the kill
+ring.
+
+ Typing `=' will show the differences from the current commit to the
+"marked" commit.
+
+ You can mark the current commit by typing `.'. When the current
+commit is already marked, typing `.' will unmark it. To unmark the
+marked commit no matter where point is, use `C-u .'.
+
+ Some commands, such as `=', will use the current commit and the
+marked commit as implicit arguments. Other commands will offer the
+marked commit as a default when prompting for their arguments.
+
+\1f
+File: magit.info, Node: Reflogs, Next: Commit Buffer, Prev: History, Up: Top
+
+8 Reflogs
+*********
+
+You can use `l h' and `l H' to browse your _reflog_, the local history
+of changes made to your repository heads. Typing `H' will ask for a
+head, while `l h' will show the reflog of `HEAD'.
+
+ The resulting buffer is just like the buffer produced by `l l' and
+`l L' that shows the commit history.
+
+\1f
+File: magit.info, Node: Commit Buffer, Next: Diffing, Prev: Reflogs, Up: Top
+
+9 Commit Buffer
+***************
+
+When you view a commit (perhaps by selecting it in the log buffer,
+*Note History::), the "commit buffer" is displayed, showing you
+information about the commit and letting you interact with it.
+
+ By placing your cursor within the diff or hunk and typing `a', you
+can apply the same patch to your working copy. This is useful when you
+want to copy a change from another branch, but don't necessarily want
+to cherry-pick the whole commit.
+
+ By typing `v' you can apply the patch in reverse, removing all the
+lines that were added and adding all the lines that were removed. This
+is a convenient way to remove a change after determining that it
+introduced a bug.
+
+ If the commit message refers to any other commits in the repository
+by their unique hash, the hash will be highlighted and you will be able
+to visit the referenced commit either by clicking on it or by moving
+your cursor onto it and pressing `RET'.
+
+ The commit buffer maintains a history of the commits it has shown.
+After visiting a referenced commit you can type `C-c C-b' to get back
+to where you came from. To go forward in the history, type `C-c C-f'.
+There are also `[back]' and `[forward]' buttons at the bottom of the
+buffer.
+
+\1f
+File: magit.info, Node: Diffing, Next: Tagging, Prev: Commit Buffer, Up: Top
+
+10 Diffing
+**********
+
+Magit typically shows diffs in the "unified" format.
+
+ In any buffer that shows a diff, you can type `e' anywhere within
+the diff to show the two versions of the file in Ediff. If the diff is
+of a file in the status buffer that needs to be merged, you will be
+able to use Ediff as an interactive merge tool. Otherwise, Ediff will
+simply show the two versions of the file.
+
+ To show the changes from your working tree to another revision, type
+`d'. To show the changes between two arbitrary revisions, type `D'.
+
+ You can use `a' within the diff output to apply the changes to your
+working tree. As usual when point is in a diff header for a file, all
+changes for that file are applied, and when it is in a hunk, only that
+hunk is. When the region is active, the applied changes are restricted
+to that region.
+
+ Typing `v' will apply the selected changes in reverse.
+
+\1f
+File: magit.info, Node: Tagging, Next: Resetting, Prev: Diffing, Up: Top
+
+11 Tagging
+**********
+
+Typing `t t' will make a lighweight tag. Typing `t a' will make an
+annotated tag. It will put you in the normal `*magit-log-edit' buffer
+for writing commit messages, but typing `C-c C-c' in it will make the
+tag instead. This is controlled by the `Tag' field that will be added
+to the `*magit-log-edit*' buffer. You can edit it, if you like.
+
+\1f
+File: magit.info, Node: Resetting, Next: Stashing, Prev: Tagging, Up: Top
+
+12 Resetting
+************
+
+Once you have added a commit to your local repository, you can not
+change that commit anymore in any way. But you can reset your current
+head to an earlier commit and start over.
+
+ If you have published your history already, rewriting it in this way
+can be confusing and should be avoided. However, rewriting your local
+history is fine and it is often cleaner to fix mistakes this way than
+by reverting commits (with `v', for example).
+
+ Typing `x' will ask for a revision and reset your current head to
+it. No changes will be made to your working tree and staging area.
+Thus, the _Staged changes_ section in the status buffer will show the
+changes that you have removed from your commit history. You can commit
+the changes again as if you had just made them, thus rewriting history.
+
+ Typing `x' while point is in a line that describes a commit will
+offer this commit as the default revision to reset to. Thus, you can
+move point to one of the commits in the _Unpushed commits_ section and
+hit `x RET' to reset your current head to it.
+
+ Type `X' to reset your working tree and staging area to the most
+recently committed state. This will discard your local modifications,
+so be careful.
+
+ You can give a prefix to `x' if you want to reset both the current
+head and your working tree to a given commit. This is the same as
+first using an unprefixed `x' to reset only the head, and then using
+`X'.
+
+\1f
+File: magit.info, Node: Stashing, Next: Branching, Prev: Resetting, Up: Top
+
+13 Stashing
+***********
+
+You can create a new stash with `z z'. Your stashes will be listed in
+the status buffer, and you can apply them with `a' and pop them with
+`A'. To drop a stash, use `k'.
+
+ With a prefix argument, both `a' and `A' will attempt to reinstate
+the index as well as the working tree from the stash.
+
+ Typing `z -k z' will create a stash just like `z z', but will leave
+the changes in your working tree and index. This makes it easier to,
+for example, test multiple variations of the same change.
+
+ If you just want to make quick snapshots in between edits, you can
+use `z s', which automatically enters a timestamp as description, and
+keeps your working tree and index intact by default.
+
+ You can visit and show stashes in the usual way: Typing `SPC' and
+`DEL' will pop up a buffer with the description of the stash and scroll
+it, typing `RET' will move point into that buffer. Using `C-u RET' will
+move point into that buffer in other window.
+
+\1f
+File: magit.info, Node: Branching, Next: The Branch Manager, Prev: Stashing, Up: Top
+
+14 Branching
+************
+
+The current branch is indicated in the header of the status buffer.
+You can switch to a different branch by typing `b b'. This will
+immediately checkout the branch into your working copy, so you
+shouldn't have any local modifications when switching branches.
+
+ If you try to switch to a remote branch, Magit will offer to create a
+local tracking branch for it instead. This way, you can easily start
+working on new branches that have appeared in a remote repository.
+
+ Typing `b b' while point is at a commit description will offer that
+commit as the default to switch to. This will result in a detached
+head.
+
+ Typing `b m' will let you rename a branch. Unless a branch with the
+same name already exists, obviously...
+
+ To create a new branch and switch to it immediately, type `b n'.
+
+ To delete a branch, type `b d'. If you're currently on that branch,
+Magit will offer to switch to the 'master' branch.
+
+ Deleting a branch is only possible if it's already fully merged into
+HEAD or its upstream branch. Unless you type `b D', that is. Here be
+dragons...
+
+ Typing `b v' will list the local and remote branches in a new buffer
+called `*magit-branches*' from which you can work with them. See *Note
+The Branch Manager:: for more details.
+
+\1f
+File: magit.info, Node: The Branch Manager, Next: Wazzup, Prev: Branching, Up: Top
+
+15 The Branch Manager
+*********************
+
+The Branch Manager is a separate buffer called `*magit-branches*' with
+its own local key map. The buffer contains both local and remote
+branches. The current local branch is marked by a "*" in front of the
+name.
+
+ To check out a branch, move your cursor to the desired branch and
+press `RET'.
+
+ Typing `k' will delete the branch in the current line, and `C-u k'
+deletes it even if it hasn't been merged into the current local branch.
+Deleting works for both local and remote branches.
+
+ By typing `T' on a local branch, you can change which remote branch
+it's set to track.
+
+\1f
+File: magit.info, Node: Wazzup, Next: Merging, Prev: The Branch Manager, Up: Top
+
+16 Wazzup
+*********
+
+Typing `w' will show a summary of how your other branches relate to the
+current branch.
+
+ For each branch, you will get a section that lists the commits in
+that branch that are not in the current branch. The sections are
+initially collapsed; you need to explicitly open them with `TAB' (or
+similar) to show the lists of commits.
+
+ When point is on a _N unmerged commits in ..._ title, the
+corresponding branch will be offered as the default for a merge.
+
+ Hitting `i' on a branch title will ignore this branch in the wazzup
+view. You can use `C-u w' to show all branches, including the ignored
+ones. Hitting `i' on an already ignored branch in that view will
+unignore it.
+
+\1f
+File: magit.info, Node: Merging, Next: Rebasing, Prev: Wazzup, Up: Top
+
+17 Merging
+**********
+
+Magit offers two ways to merge branches: manual and automatic. A
+manual merge will apply all changes to your working tree and staging
+area, but will not commit them, while an automatic merge will go ahead
+and commit them immediately.
+
+ Type `m m' to initiate merge.
+
+ After initiating a merge, the header of the status buffer might
+remind you that the next commit will be a merge commit (with more than
+one parent). If you want to abort a manual merge, just do a hard reset
+to HEAD with `X'.
+
+ Merges can fail if the two branches you want to merge introduce
+conflicting changes. In that case, the automatic merge stops before the
+commit, essentially falling back to a manual merge. You need to resolve
+the conflicts for example with `e' and stage the resolved files, for
+example with `S'.
+
+ You can not stage individual hunks one by one as you resolve them,
+you can only stage whole files once all conflicts in them have been
+resolved.
+
+\1f
+File: magit.info, Node: Rebasing, Next: Interactive Rebasing, Prev: Merging, Up: Top
+
+18 Rebasing
+***********
+
+Typing `R' in the status buffer will initiate a rebase or, if one is
+already in progress, ask you how to continue.
+
+ When a rebase is stopped in the middle because of a conflict, the
+header of the status buffer will indicate how far along you are in the
+series of commits that are being replayed. When that happens, you
+should resolve the conflicts and stage everything and hit `R c' to
+continue the rebase. Alternatively, hitting `c' or `C' while in the
+middle of a rebase will also ask you whether to continue the rebase.
+
+ Of course, you can initiate a rebase in any number of ways, by
+configuring `git pull' to rebase instead of merge, for example. Such a
+rebase can be finished with `R' as well.
+
+\1f
+File: magit.info, Node: Interactive Rebasing, Next: Rewriting, Prev: Rebasing, Up: Top
+
+19 Interactive Rebasing
+***********************
+
+Typing `E' in the status buffer will initiate an interactive rebase.
+This is equivalent to running `git rebase --interactive' at the command
+line. The `git-rebase-todo' file will be opened in an Emacs buffer for
+you to edit. This file is opened using `emacsclient', so just edit this
+file as you normally would, then call the `server-edit' function
+(typically bound to `C-x #') to tell Emacs you are finished editing,
+and the rebase will proceed as usual.
+
+ If you have loaded `rebase-mode.el' (which is included in the Magit
+distribution), the `git-rebase-todo' buffer will be in `rebase-mode'.
+This mode disables normal text editing but instead provides single-key
+commands (shown in the buffer) to perform all the edits that you would
+normally do manually, including changing the operation to be performed
+each commit ("pick", "squash", etc.), deleting (commenting out) commits
+from the list, and reordering commits. You can finish editing the
+buffer and proceed with the rebase by pressing `C-c C-c', which is
+bound to `server-edit' in this mode, and you can abort the rebase with
+`C-c C-k', just like when editing a commit message in Magit.
+
+\1f
+File: magit.info, Node: Rewriting, Next: Pushing and Pulling, Prev: Interactive Rebasing, Up: Top
+
+20 Rewriting
+************
+
+As hinted at earlier, you can rewrite your commit history. For
+example, you can reset the current head to an earlier commit with `x'.
+This leaves the working tree unchanged, and the status buffer will show
+all the changes that have been made since that new value of the current
+head. You can commit these changes again, possibly splitting them into
+multiple commits as you go along.
+
+ Amending your last commit is a common special case of rewriting
+history like this.
+
+ Another common way to rewrite history is to reset the head to an
+earlier commit, and then to cherry pick the previous commits in a
+different order. You could pick them from the reflog, for example.
+
+ Magit has several commands that can simplify the book keeping
+associated with rewriting. These commands all start with the `r'
+prefix key.
+
+ Typing `r b' will start a rewrite operation. You will be prompted
+for a _base_ commit. This commit and all subsequent commits up until
+the current head are then put in a list of _Pending commits_, after
+which the current head will be reset to the _parent_ of the base
+commit. This can be configured to behave like `git rebase', i.e.
+exclude the selected base commit from the rewrite operation, with the
+`magit-rewrite-inclusive' variable.
+
+ You would then typically use `a' and `A' to cherry pick commits from
+the list of pending commits in the desired order, until all have been
+applied. Magit shows which commits have been applied by changing their
+marker from `*' to `.'.
+
+ Using `A' will immediately commit the commit (as usual). If you
+want to combine multiple previous commits into a single new one, use
+`a' to apply them all to your working tree, and then commit them
+together.
+
+ Magit has no explicit support for rewriting merge commits. It will
+happily include merge commits in the list of pending commits, but there
+is no way of replaying them automatically. You have to redo the merge
+explicitly.
+
+ You can also use `v' to revert a commit when you have changed your
+mind. This will change the `.' mark back to `*'.
+
+ Once you are done with the rewrite, type `r s' to remove the book
+keeping information from the status buffer.
+
+ If you rather wish to start over, type `r a'. This will abort the
+rewriting, resetting the current head back to the value it had before
+the rewrite was started with `r b'.
+
+ Typing `r f' will _finish_ the rewrite: it will apply all unused
+commits one after the other, as if you would us `A' with all of them.
+
+ You can change the `*' and `.' marks of a pending commit explicitly
+with `r *' and `r .'.
+
+ In addition to a list of pending commits, the status buffer will show
+the _Pending changes_. This section shows the diff between the
+original head and the current head. You can use it to review the
+changes that you still need to rewrite, and you can apply hunks from
+it, like from any other diff.
+
+\1f
+File: magit.info, Node: Pushing and Pulling, Next: Bisecting, Prev: Rewriting, Up: Top
+
+21 Pushing and Pulling
+**********************
+
+Magit will run `git push' when you type `P P'. If you give a prefix
+argument to `P P', you will be prompted for the repository to push to.
+When no default remote repository has been configured yet for the
+current branch, you will be prompted as well. Typing `P P' will only
+push the current branch to the remote. In other words, it will run
+`git push <remote> <branch>'. The branch will be created in the remote
+if it doesn't exist already. The local branch will be configured so
+that it pulls from the new remote branch. If you give a double prefix
+argument to `P P', you will be prompted in addition for the target
+branch to push to. In other words, it will run `git push <remote>
+<branch>:<target>'.
+
+ Typing `f f' will run `git fetch'. It will prompt for the name of
+the remote to update if there is no default one. Typing `f o' will
+always prompt for the remote. Typing `F F' will run `git pull'. When
+you don't have a default branch configured to be pulled into the
+current one, you will be asked for it.
+
+ If there is a default remote repository for the current branch, Magit
+will show that repository in the status buffer header.
+
+ In this case, the status buffer will also have a _Unpushed commits_
+section that shows the commits on your current head that are not in the
+branch named `<remote>/<branch>'. This section works just like the
+history buffer: you can see details about a commit with `RET', compare
+two of them with `.' and `=', and you can reset your current head to
+one of them with `x', for example. If you want to push the changes then
+type `P P'.
+
+ When the remote branch has changes that are not in the current
+branch, Magit shows them in a section called _Unpulled changes_. Typing
+`F F' will fetch and merge them into the current branch.
+
+\1f
+File: magit.info, Node: Submodules, Next: Using Magit Extensions, Prev: Bisecting, Up: Top
+
+22 Submodules
+*************
+
+`M u'
+ Update the submodules, with a prefix argument it will initializing.
+
+`M i'
+ Initialize the submodules.
+
+`M b'
+ Update and initialize the submodules in one go.
+
+`M s'
+ Synchronizes submodules' remote URL configuration setting to the
+ value specified in .gitmodules.
+
+\1f
+File: magit.info, Node: Bisecting, Next: Submodules, Prev: Pushing and Pulling, Up: Top
+
+23 Bisecting
+************
+
+Magit supports bisecting by showing how many revisions and steps are
+left to be tested in the status buffer. You can control the bisect
+session from both the status and from log buffers with the `B' key menu.
+
+ Typing `B s' will start a bisect session. You will be prompted for
+a revision that is known to be bad (defaults to _HEAD_) and for a
+revision that is known to be good (defaults to the revision at point if
+there is one). git will select a revision for you to test, and Magit
+will update its status buffer accordingly.
+
+ You can tell git that the current revision is good with `B g', that
+it is bad with `B b' or that git should skip it with `B k'. You can
+also tell git to go into full automatic mode by giving it the name of a
+script to run for each revision to test with `B u'.
+
+ The current status can be shown as a log with `B l'. It contains the
+revisions that have already been tested and your decisions about their
+state.
+
+ The revisions left to test can be visualized in gitk with `B v'.
+
+ When you're finished bisecting you have to reset the session with `B
+r'.
+
+\1f
+File: magit.info, Node: Using Magit Extensions, Next: Using Git Directly, Prev: Submodules, Up: Top
+
+24 Magit Extensions
+*******************
+
+* Menu:
+
+* Activating extensions::
+* Interfacing with Subversion::
+* Interfacing with Topgit::
+* Interfacing with StGit::
+* Developing Extensions::
+
+\1f
+File: magit.info, Node: Activating extensions, Next: Interfacing with Subversion, Up: Using Magit Extensions
+
+24.1 Activating extensions
+==========================
+
+Magit comes with a couple of shipped extensions that allow interaction
+with `git-svn', `topgit' and `stgit'. See following sections for
+specific details on how to use them.
+
+ Extensions can be activated globally or on a per-repository basis.
+Since those extensions are implemented as minor modes, one can use for
+example `M-x magit-topgit-mode' to toggle the `topgit' extension,
+making the corresponding section and commands (un)available.
+
+ In order to do that automatically (and for every repository), one can
+use for example:
+
+ (add-hook 'magit-mode-hook 'turn-on-magit-topgit)
+
+ Magit also allows configuring different extensions, based on the git
+repository configuration.
+
+ (add-hook 'magit-mode-hook 'magit-load-config-extensions)
+
+ This will read git configuration variables and activate the relevant
+extensions.
+
+ For example, after running the following commands, the `topgit'
+extension will be loaded for every repository, while the `svn' one will
+be loaded only for the current one.
+
+ $ git config --global --add magit.extension topgit
+ $ git config --add magit.extension svn
+
+ Note the `--add' flag, which means that each extension gets its own
+line in the `config' file.
+
+\1f
+File: magit.info, Node: Interfacing with Subversion, Next: Interfacing with Topgit, Prev: Activating extensions, Up: Using Magit Extensions
+
+24.2 Interfacing with Subversion
+================================
+
+Typing `N r' runs `git svn rebase', typing `N c' runs `git svn dcommit'
+and typing `N f' runs `git svn fetch'.
+
+ `N s' will prompt you for a (numeric, Subversion) revision and then
+search for a corresponding Git sha1 for the commit. This is limited to
+the path of the remote Subversion repository. With a prefix (`C-u N s'
+the user will also be prompted for a branch to search in.
+
+\1f
+File: magit.info, Node: Interfacing with Topgit, Next: Interfacing with StGit, Prev: Interfacing with Subversion, Up: Using Magit Extensions
+
+24.3 Interfacing with Topgit
+============================
+
+Topgit (http://repo.or.cz/r/topgit.git) is a patch queue manager that
+aims at being close as possible to raw Git, which makes it easy to use
+with Magit. In particular, it does not require to use a different set of
+commands for "commit", "update",… operations.
+
+ `magit-topgit.el' provides basic integration with Magit, mostly by
+providing a "Topics" section.
+
+ Topgit branches can be created the regular way, by using a "t/"
+prefix by convention. So, creating a "t/foo" branch will actually
+populate the "Topics" section with one more branch after committing
+`.topdeps' and `.topmsg'.
+
+ Also, the way we pull (see *Note Pushing and Pulling::) such a
+branch is slightly different, since it requires updating the various
+dependencies of that branch. This should be mostly transparent, except
+in case of conflicts.
+
+\1f
+File: magit.info, Node: Interfacing with StGit, Next: Developing Extensions, Prev: Interfacing with Topgit, Up: Using Magit Extensions
+
+24.4 Interfacing with StGit
+===========================
+
+StGit (http://www.procode.org/stgit) is a Python application providing
+similar functionality to Quilt (i.e. pushing/popping patches to/from a
+stack) on top of Git. These operations are performed using Git commands
+and the patches are stored as Git commit objects, allowing easy merging
+of the StGit patches into other repositories using standard Git
+functionality.
+
+ `magit-stgit.el' provides basic integration with Magit, mostly by
+providing a "Series" section, whose patches can be seen as regular
+commits through the "visit" action.
+
+ You can change the current patch in a series with the "apply" action,
+as well as you can delete them using the "discard" action.
+
+ Additionally, the `magit-stgit-refresh' and `magit-stgit-rebase'
+commands let you perform the respective StGit operations.
+
+\1f
+File: magit.info, Node: Developing Extensions, Prev: Interfacing with StGit, Up: Using Magit Extensions
+
+24.5 Developing Extensions
+==========================
+
+Magit provides a generic mechanism to allow cooperation with Git-related
+systems, such as foreign VCS, patch systems,…
+
+ In particular it allows to:
+
+ * Define sections to display specific informations about the current
+ state of the repository, and place them relatively to existing
+ sections.
+
+ `magit-define-inserter' automagically defines two hooks called
+ `magit-before-insert-SECTION-hook' and
+ `magit-after-insert-SECTION-hook' that allow to generate and place
+ more sections.
+
+ In the following example, we use the builtin "stashes" section to
+ place our own "foo" one.
+
+ (magit-define-inserter foo ()
+ (magit-git-section 'foo
+ "Foo:" 'foo-wash-function
+ "foo" "arg1" "arg2"))
+ (add-hook 'magit-after-insert-stashes-hook 'magit-insert-foo)
+
+ * Define new types of objects in those sections.
+
+ The function `foo-wash-function' defined above post-processes each
+ line of the output of the "git foo arg1 arg2" command, and is able
+ to associate a type to certain lines.
+
+ A simple implementation could be:
+
+ (defun foo-wash-function ()
+ (let ((foo (buffer-substring (line-beginning-position) (line-end-position))))
+ (goto-char (line-beginning-position))
+ (magit-with-section foo 'foo
+ (magit-set-section-info foo)
+ (forward-line))))
+
+ In this case, every line of the command output is transformed into
+ an object of type `'foo'.
+
+ * Alter behavior of generic commands to dispatch them correctly to
+ the relevant system, optionally making use of the newly defined
+ types.
+
+ (magit-add-action (item info "discard")
+ ((foo)
+ (do-something-meaningful-for-discarding-a-foo)))
+
+ This will alter the behavior of `k', when applied to those objects.
+
+ * Plug a different logic into basic commands, to reflect the
+ presence of the extension.
+
+ `magit-define-command' automagically defines a
+ `magit-CMD-command-hook' that can contain a list of functions to
+ call before the actual core code. Execution stops after the first
+ hook that returns a non-nil value. This leaves room for extension
+ logic.
+
+ (add-hook 'magit-create-branch-command-hook 'foo-create-branch)
+
+ The function `foo-create-branch' will be called each time an
+ attempt is made to create a branch, and can, for example, react to
+ a certain name convention.
+
+ * Define new commands and associated menu.
+
+ This part is not really specific to extensions, except that menus
+ take place in the "Extensions" submenu.
+
+
+ It is suggested that Magit extensions authors stick to the
+convention of making extensions minor modes. This has many advantages,
+including the fact that users are able to toggle extensions, and that
+it's easy to configure a specific set of extensions for a given
+repository.
+
+ Shipped extensions can serve as an example of how to develop new
+extensions.
+
+ Basically a `foo' extension should provide a `magit-foo-mode' minor
+mode, as well as a `turn-on-magit-foo' function. The main task of the
+minor mode is to register/unregister the various hooks that the
+extension requires. The registered actions on the other hand can be
+left alone and activated globally, since they can be run only on
+displayed items, which won't happen when the minor mode is off.
+
+ Don't forget to call `magit-refresh' when the minor mode is toggled
+interactively, so that the relevant sections can be shown or hidden.
+
+\1f
+File: magit.info, Node: Using Git Directly, Next: Customization, Prev: Using Magit Extensions, Up: Top
+
+25 Using Git Directly
+*********************
+
+For situations when Magit doesn't do everything you need, you can run
+raw Git commands using `:'. This will prompt for a Git command, run
+it, and refresh the status buffer. The output can be viewed by typing
+`$'.
+
+\1f
+File: magit.info, Node: Customization, Next: Frequently Asked Questions, Prev: Using Git Directly, Up: Top
+
+26 Customization
+****************
+
+The following variables can be used to adapt Magit to your workflow:
+
+`magit-git-executable'
+ The name of the Git executable.
+
+`magit-git-standard-options'
+ Standard options when running Git.
+
+`magit-repo-dirs'
+ Directories containing Git repositories.
+
+ Magit will look into these directories for Git repositories and
+ offer them as choices for `magit-status'.
+
+`magit-repo-dirs-depth'
+ 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.
+
+`magit-save-some-buffers'
+ 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.
+
+`magit-save-some-buffers-predicate'
+ Specifies a predicate function on `magit-save-some-buffers' to
+ determine which unsaved buffers should be prompted for saving.
+
+`magit-commit-all-when-nothing-staged'
+ 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.
+
+`magit-commit-signoff'
+ When performing `git commit' adds `--signoff'.
+
+`magit-log-cutoff-length'
+ The maximum number of commits to show in the `log' and `whazzup'
+ buffers.
+
+`magit-log-infinite-length'
+ Number of log used to show as maximum for
+ `magit-log-cutoff-length'.
+
+`magit-log-auto-more'
+ Insert more log entries automatically when moving past the last
+ entry.
+
+ Only considered when moving past the last entry with
+ `magit-goto-next-section'.
+
+`magit-process-popup-time'
+ Popup the process buffer if a command takes longer than this many
+ seconds.
+
+`magit-revert-item-confirm'
+ Require acknowledgment before reverting an item.
+
+`magit-log-edit-confirm-cancellation'
+ Require acknowledgment before canceling the log edit buffer.
+
+`magit-remote-ref-format'
+ 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
+ completion.
+
+ 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'.
+
+`magit-process-connection-type'
+ Connection type used for the git process.
+
+ `nil' mean pipe, it is usually faster and more efficient, and work
+ on cygwin. `t' mean pty, it enable magit to prompt for passphrase
+ when needed.
+
+`magit-completing-read-function'
+ Function to be called when requesting input from the user.
+
+`magit-create-branch-behaviour'
+ 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...
+
+`magit-status-buffer-switch-function'
+ Function for `magit-status' to use for switching to the status
+ buffer.
+
+ The function is given one argument, the status buffer.
+
+`magit-rewrite-inclusive'
+ 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}'
+
+
+ A'---B'---C'---D'
+ ^
+
+ `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.
+
+
+ A---B'---C'---D'
+ ^
+
+`magit-topgit-executable'
+ The name of the TopGit executable.
+
+`magit-topgit-branch-prefix'
+ Convention prefix for topic branch creation.
+
+
+\1f
+File: magit.info, Node: Frequently Asked Questions, Prev: Customization, Up: Top
+
+27 Frequently Asked Questions
+*****************************
+
+* Menu:
+
+* FAQ - Changes::
+* FAQ 1 - Troubleshooting::
+* FAQ 2 - Display issues::
+
+\1f
+File: magit.info, Node: FAQ - Changes, Next: FAQ 1 - Troubleshooting, Up: Frequently Asked Questions
+
+27.1 Changes
+============
+
+ * v1.1: Changed the way extensions work. Previously, they were
+ enabled unconditionally once the library was loaded. Now they are
+ minor modes that need to be activated explicitly (potentially on a
+ per-repository basis). See *Note Activating extensions::.
+
+
+\1f
+File: magit.info, Node: FAQ 1 - Troubleshooting, Next: FAQ 2 - Display issues, Prev: FAQ - Changes, Up: Frequently Asked Questions
+
+27.2 Troubleshooting
+====================
+
+* Menu:
+
+* FAQ 1-1:: How do I get raw error messages from git?
+
+\1f
+File: magit.info, Node: FAQ 1-1, Up: FAQ 1 - Troubleshooting
+
+27.2.1 Question 1.1
+-------------------
+
+How do I get raw error messages from git?
+
+Answer
+......
+
+If a command goes wrong, you can hit `$' to access the git process
+buffer. There, the entire trace for the latest operation is available.
+
+\1f
+File: magit.info, Node: FAQ 2 - Display issues, Prev: FAQ 1 - Troubleshooting, Up: Frequently Asked Questions
+
+27.3 Display issues
+===================
+
+* Menu:
+
+* FAQ 2-1:: How do I fix international characters display?
+
+\1f
+File: magit.info, Node: FAQ 2-1, Up: FAQ 2 - Display issues
+
+27.3.1 Question 2.1
+-------------------
+
+How do I fix international characters display?
+
+Answer
+......
+
+Please make sure your Magit buffer uses a compatible coding system. In
+the particular case of file names, git itself quotes them by default.
+You can disable this with one of the following approaches:
+
+ $ git config core.quotepath false
+
+ or
+
+ (setq magit-git-standard-options (append magit-git-standard-options
+ '("-c" "core.quotepath=false")))
+
+ The latter might not work in old versions of git.
+
+
+\1f
+Tag Table:
+Node: Top\7f639
+Node: Introduction\7f1592
+Node: Acknowledgments\7f3064
+Node: Sections\7f3744
+Node: Status\7f6294
+Node: Untracked files\7f9033
+Node: Staging and Committing\7f10237
+Node: History\7f14135
+Node: Reflogs\7f17315
+Node: Commit Buffer\7f17719
+Node: Diffing\7f19045
+Node: Tagging\7f20032
+Node: Resetting\7f20481
+Node: Stashing\7f22005
+Node: Branching\7f23063
+Node: The Branch Manager\7f24441
+Node: Wazzup\7f25157
+Node: Merging\7f25948
+Node: Rebasing\7f26998
+Node: Interactive Rebasing\7f27824
+Node: Rewriting\7f29116
+Node: Pushing and Pulling\7f32141
+Node: Submodules\7f34068
+Node: Bisecting\7f34488
+Node: Using Magit Extensions\7f35703
+Node: Activating extensions\7f36000
+Node: Interfacing with Subversion\7f37384
+Node: Interfacing with Topgit\7f37982
+Node: Interfacing with StGit\7f39010
+Node: Developing Extensions\7f40008
+Node: Using Git Directly\7f43786
+Node: Customization\7f44157
+Node: Frequently Asked Questions\7f48703
+Node: FAQ - Changes\7f48934
+Node: FAQ 1 - Troubleshooting\7f49342
+Node: FAQ 1-1\7f49590
+Node: FAQ 2 - Display issues\7f49894
+Node: FAQ 2-1\7f50123
+\1f
+End Tag Table
--- /dev/null
+;;; rebase-mode -- edit git rebase files.
+
+;; Copyright (C) 2010 Phil Jackson
+;; Copyright (C) 2011 Peter J Weisberg
+;;
+;; Magit is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+;;
+;; Magit is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
+;; License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with Magit. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Allows the editing of a git rebase file (which you might get when
+;; using 'git rebase -i' or hitting 'E' in Magit). Assumes editing is
+;; happening in a server.
+
+;;; Code:
+
+(require 'server)
+
+(defgroup rebase-mode nil
+ "Customize Rebase Mode"
+ :group 'faces)
+
+(defface rebase-mode-killed-action-face
+ '((((class color))
+ :inherit font-lock-comment-face
+ :strike-through t))
+ "Action lines in the rebase TODO list that have been commented out."
+ :group 'rebase-mode)
+
+(defface rebase-mode-description-face
+ '((t :inherit font-lock-comment-face))
+ "Face for one-line commit descriptions"
+ :group 'rebase-mode)
+
+(defconst rebase-mode-action-line-re
+ (rx
+ line-start
+ (? "#")
+ (group
+ (|
+ (any "presf")
+ "pick"
+ "reword"
+ "edit"
+ "squash"
+ "fixup"))
+ (char space)
+ (group
+ (** 4 40 hex-digit)) ;sha1
+ (char space)
+ (group
+ (* not-newline)))
+ "Regexp that matches an action line in a rebase buffer.")
+
+(defconst rebase-mode-exec-line-re
+ (rx
+ line-start
+ (? "#")
+ (group
+ (| "x"
+ "exec"))
+ (char space)
+ (group
+ (* not-newline)))
+ "Regexp that matches an exec line in a rebase buffer.")
+
+(defconst rebase-mode-dead-line-re
+ (rx-to-string `(and line-start
+ (char ?#)
+ (or (regexp ,(substring rebase-mode-action-line-re 1))
+ (regexp ,(substring rebase-mode-exec-line-re 1)))) t)
+ "Regexp that matches a commented-out exec or action line in a rebase buffer.")
+
+(defvar rebase-mode-font-lock-keywords
+ (list
+ (list rebase-mode-action-line-re
+ '(1 font-lock-keyword-face)
+ '(2 font-lock-builtin-face)
+ '(3 'rebase-mode-description-face))
+ (list rebase-mode-exec-line-re
+ '(1 font-lock-keyword-face))
+ (list (rx line-start (char "#") (* not-newline)) 0 font-lock-comment-face)
+ (list rebase-mode-dead-line-re 0 ''rebase-mode-killed-action-face t))
+ "Font lock keywords for `rebase-mode'.")
+
+(defvar key-to-action-map
+ '(("c" . "pick")
+ ("r" . "reword")
+ ("e" . "edit")
+ ("s" . "squash")
+ ("f" . "fixup"))
+ "Mapping from key to action.")
+
+(defvar rebase-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "q") 'server-edit)
+ (define-key map (kbd "C-c C-c") 'server-edit)
+
+ (define-key map (kbd "a") 'rebase-mode-abort)
+ (define-key map (kbd "C-c C-k") 'rebase-mode-abort)
+
+ (define-key map (kbd "M-p") 'rebase-mode-move-line-up)
+ (define-key map (kbd "M-n") 'rebase-mode-move-line-down)
+ (define-key map (kbd "k") 'rebase-mode-kill-line)
+ (define-key map (kbd "x") 'rebase-mode-exec)
+
+ (define-key map (kbd "n") 'forward-line)
+ (define-key map (kbd "p") '(lambda(n)
+ (interactive "p")
+ (forward-line (* n -1))))
+ (define-key map [remap undo] 'rebase-mode-undo)
+ map)
+ "Keymap for rebase-mode. Note this will be added to by the
+top-level code which defines the edit functions.")
+
+(require 'easymenu)
+(easy-menu-define rebase-mode-menu rebase-mode-map
+ "Rebase-mode menu"
+ '("Rebase"
+ ["Pick" rebase-mode-pick t]
+ ["Reword" rebase-mode-reword t]
+ ["Edit" rebase-mode-edit t]
+ ["Squash" rebase-mode-squash t]
+ ["Fixup" rebase-mode-fixup t]
+ ["Kill" rebase-mode-kill-line t]
+ ["Move Down" rebase-mode-move-line-down t]
+ ["Move Up" rebase-mode-move-line-up t]
+ ["Execute" rebase-mode-exec t]
+ "---"
+ ["Abort" rebase-mode-abort t]
+ ["Done" server-edit t]))
+
+;; create the functions which edit the action lines themselves (based
+;; on `key-to-action-map' above)
+(mapc (lambda (key-action)
+ (let ((fun-name (intern (concat "rebase-mode-" (cdr key-action)))))
+ ;; define the function
+ (eval `(defun ,fun-name ()
+ (interactive)
+ (rebase-mode-edit-line ,(cdr key-action))))
+
+ ;; bind the function in `rebase-mode-map'
+ (define-key rebase-mode-map (car key-action) fun-name)))
+ key-to-action-map)
+
+(defun rebase-mode-edit-line (change-to)
+ "Change the keyword at the start of the current action line to
+that of CHANGE-TO."
+ (when (rebase-mode-looking-at-action)
+ (let ((buffer-read-only nil)
+ (start (point)))
+ (goto-char (point-at-bol))
+ (delete-region (point) (progn (forward-word 1) (point)))
+ (insert change-to)
+ (goto-char start))))
+
+(defun rebase-mode-looking-at-action ()
+ "Return non-nil if looking at an action line."
+ (save-excursion
+ (goto-char (point-at-bol))
+ (looking-at rebase-mode-action-line-re)))
+
+(defun rebase-mode-looking-at-action-or-exec ()
+ "Return non-nil if looking at an action line or exec line."
+ (save-excursion
+ (goto-char (point-at-bol))
+ (or (looking-at rebase-mode-action-line-re)
+ (looking-at rebase-mode-exec-line-re))))
+
+(defun rebase-mode-looking-at-exec ()
+ "Return non-nil if cursor is on an exec line."
+ (string-match rebase-mode-exec-line-re (thing-at-point 'line)))
+
+(defun rebase-mode-looking-at-killed-exec ()
+ "Return non-nil if looking at an exec line that has been commented out"
+ (let ((line (thing-at-point 'line)))
+ (and (eq (aref line 0) ?#)
+ (string-match rebase-mode-exec-line-re line))))
+
+(defun rebase-mode-move-line-up ()
+ "Move the current action line up."
+ (interactive)
+ (when (rebase-mode-looking-at-action-or-exec)
+ (let ((buffer-read-only nil)
+ (col (current-column)))
+ (transpose-lines 1)
+ (forward-line -2)
+ (move-to-column col))))
+
+(defun rebase-mode-move-line-down ()
+ "Assuming the next line is also an action line, move the current line down."
+ (interactive)
+ ;; if we're on an action and the next line is also an action
+ (when (and (rebase-mode-looking-at-action-or-exec)
+ (save-excursion
+ (forward-line)
+ (rebase-mode-looking-at-action-or-exec)))
+ (let ((buffer-read-only nil)
+ (col (current-column)))
+ (forward-line 1)
+ (transpose-lines 1)
+ (forward-line -1)
+ (move-to-column col))))
+
+(defun rebase-mode-abort ()
+ "Abort this rebase (by emptying the buffer, saving and closing
+server connection)."
+ (interactive)
+ (when (or (not (buffer-modified-p))
+ (y-or-n-p "Abort this rebase? "))
+ (let ((buffer-read-only nil))
+ (delete-region (point-min) (point-max))
+ (save-buffer)
+ (server-edit))))
+
+(defun rebase-mode-kill-line ()
+ "Kill the current action line."
+ (interactive)
+ (when (and (not (eq (char-after (point-at-bol)) ?#))
+ (rebase-mode-looking-at-action-or-exec))
+ (beginning-of-line)
+ (let ((buffer-read-only nil))
+ (insert "#"))
+ (forward-line)))
+
+(defun rebase-mode-exec (edit)
+ "Prompt the user for a shell command to be executed, and add it to
+the todo list.
+
+If the cursor is on a commented-out exec line, uncomment the
+current line instead of prompting.
+
+When the prefix argument EDIT is non-nil and the cursor is on an
+exec line, edit that line instead of inserting a new one. If the
+exec line was commented out, also uncomment it."
+ (interactive "P")
+ (cond
+ ((and edit (rebase-mode-looking-at-exec))
+ (let ((new-line (rebase-mode-read-exec-line
+ (match-string-no-properties 2 (thing-at-point 'line))))
+ (inhibit-read-only t))
+ (delete-region (point-at-bol) (point-at-eol))
+ (if (not (equal "" new-line))
+ (insert "exec " new-line)
+ (delete-char -1)
+ (forward-line))
+ (move-beginning-of-line nil)))
+ ((rebase-mode-looking-at-killed-exec)
+ (save-excursion
+ (beginning-of-line)
+ (let ((buffer-read-only nil))
+ (delete-char 1))))
+ (t
+ (let ((inhibit-read-only t)
+ (line (rebase-mode-read-exec-line)))
+ (unless (equal "" line)
+ (move-end-of-line nil)
+ (newline)
+ (insert (concat "exec " line))))
+ (move-beginning-of-line nil))))
+
+(defun rebase-mode-read-exec-line (&optional initial-line)
+ (read-shell-command "Execute: " initial-line))
+
+(defun rebase-mode-undo (&optional arg)
+ "A thin wrapper around `undo', which allows undoing in
+read-only buffers."
+ (interactive "P")
+ (let ((inhibit-read-only t))
+ (undo arg)))
+
+;;;###autoload
+(define-derived-mode rebase-mode special-mode "Rebase"
+ "Major mode for editing of a Git rebase file.
+
+Rebase files are generated when you run 'git rebase -i' or run
+`magit-interactive-rebase'. They describe how Git should perform
+the rebase. See the documentation for git-rebase (e.g., by
+running 'man git-rebase' at the command line) for details."
+ (setq font-lock-defaults '(rebase-mode-font-lock-keywords t t)))
+
+(defun rebase-mode-show-keybindings ()
+ "Modify the \"Commands:\" section of the comment Git generates
+at the bottom of the file so that in place of the one-letter
+abbreviation for the command, it shows the command's keybinding.
+By default, this is the same except for the \"pick\" command."
+ (save-excursion
+ (goto-char (point-min))
+ (while (search-forward-regexp "^# \\(.\\), \\([[:alpha:]]+\\) = " nil t)
+ (let ((start (match-beginning 1))
+ (end (match-end 1))
+ (command (intern (concat "rebase-mode-" (match-string 2)))))
+ (when (fboundp command)
+ (let ((overlay (make-overlay start end)))
+ (overlay-put overlay
+ 'display
+ (key-description (where-is-internal command nil t)))))))))
+
+(add-hook 'rebase-mode-hook 'rebase-mode-show-keybindings t)
+
+(defun rebase-mode-disable-before-save-hook ()
+ (set (make-local-variable 'before-save-hook) nil))
+
+(add-hook 'rebase-mode-hook 'rebase-mode-disable-before-save-hook)
+
+;;;###autoload
+(add-to-list 'auto-mode-alist
+ '("git-rebase-todo" . rebase-mode))
+
+(provide 'rebase-mode)
+
+;;; rebase-mode.el ends here
--- /dev/null
+;;; package.el --- Simple package system for Emacs
+
+;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
+
+;; Author: Tom Tromey <tromeyNOSPAMredhat.com>
+;; Created: 10 Mar 2007
+;; Version: 1.0
+;; Keywords: tools
+;; Package-Requires: ((tabulated-list "0"))
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Change Log:
+
+;; 2 Apr 2007 - now using ChangeLog file
+;; 15 Mar 2007 - updated documentation
+;; 14 Mar 2007 - Changed how obsolete packages are handled
+;; 13 Mar 2007 - Wrote package-install-from-buffer
+;; 12 Mar 2007 - Wrote package-menu mode
+
+;;; Commentary:
+
+;; The idea behind package.el is to be able to download packages and
+;; install them. Packages are versioned and have versioned
+;; dependencies. Furthermore, this supports built-in packages which
+;; may or may not be newer than user-specified packages. This makes
+;; it possible to upgrade Emacs and automatically disable packages
+;; which have moved from external to core. (Note though that we don't
+;; currently register any of these, so this feature does not actually
+;; work.)
+
+;; A package is described by its name and version. The distribution
+;; format is either a tar file or a single .el file.
+
+;; A tar file should be named "NAME-VERSION.tar". The tar file must
+;; unpack into a directory named after the package and version:
+;; "NAME-VERSION". It must contain a file named "PACKAGE-pkg.el"
+;; which consists of a call to define-package. It may also contain a
+;; "dir" file and the info files it references.
+
+;; A .el file is named "NAME-VERSION.el" in the remote archive, but is
+;; installed as simply "NAME.el" in a directory named "NAME-VERSION".
+
+;; The downloader downloads all dependent packages. By default,
+;; packages come from the official GNU sources, but others may be
+;; added by customizing the `package-archives' alist. Packages get
+;; byte-compiled at install time.
+
+;; At activation time we will set up the load-path and the info path,
+;; and we will load the package's autoloads. If a package's
+;; dependencies are not available, we will not activate that package.
+
+;; Conceptually a package has multiple state transitions:
+;;
+;; * Download. Fetching the package from ELPA.
+;; * Install. Untar the package, or write the .el file, into
+;; ~/.emacs.d/elpa/ directory.
+;; * Byte compile. Currently this phase is done during install,
+;; but we may change this.
+;; * Activate. Evaluate the autoloads for the package to make it
+;; available to the user.
+;; * Load. Actually load the package and run some code from it.
+
+;; Other external functions you may want to use:
+;;
+;; M-x list-packages
+;; Enters a mode similar to buffer-menu which lets you manage
+;; packages. You can choose packages for install (mark with "i",
+;; then "x" to execute) or deletion (not implemented yet), and you
+;; can see what packages are available. This will automatically
+;; fetch the latest list of packages from ELPA.
+;;
+;; M-x package-install-from-buffer
+;; Install a package consisting of a single .el file that appears
+;; in the current buffer. This only works for packages which
+;; define a Version header properly; package.el also supports the
+;; extension headers Package-Version (in case Version is an RCS id
+;; or similar), and Package-Requires (if the package requires other
+;; packages).
+;;
+;; M-x package-install-file
+;; Install a package from the indicated file. The package can be
+;; either a tar file or a .el file. A tar file must contain an
+;; appropriately-named "-pkg.el" file; a .el file must be properly
+;; formatted as with package-install-from-buffer.
+
+;;; Thanks:
+;;; (sorted by sort-lines):
+
+;; Jim Blandy <jimbNOSPAMred-bean.com>
+;; Karl Fogel <kfogelNOSPAMred-bean.com>
+;; Kevin Ryde <user42NOSPAMzip.com.au>
+;; Lawrence Mitchell
+;; Michael Olson <mwolsonNOSPAMmember.fsf.org>
+;; Sebastian Tennant <sebyteNOSPAMsmolny.plus.com>
+;; Stefan Monnier <monnierNOSPAMiro.umontreal.ca>
+;; Vinicius Jose Latorre <viniciusjlNOSPAMig.com.br>
+;; Phil Hagelberg <philNOSPAMhagelb.org>
+
+;;; ToDo:
+
+;; - a trust mechanism, since compiling a package can run arbitrary code.
+;; For example, download package signatures and check that they match.
+;; - putting info dirs at the start of the info path means
+;; users see a weird ordering of categories. OTOH we want to
+;; override later entries. maybe emacs needs to enforce
+;; the standard layout?
+;; - put bytecode in a separate directory tree
+;; - perhaps give users a way to recompile their bytecode
+;; or do it automatically when emacs changes
+;; - give users a way to know whether a package is installed ok
+;; - give users a way to view a package's documentation when it
+;; only appears in the .el
+;; - use/extend checkdoc so people can tell if their package will work
+;; - "installed" instead of a blank in the status column
+;; - tramp needs its files to be compiled in a certain order.
+;; how to handle this? fix tramp?
+;; - on emacs 21 we don't kill the -autoloads.el buffer. what about 22?
+;; - maybe we need separate .elc directories for various emacs versions
+;; and also emacs-vs-xemacs. That way conditional compilation can
+;; work. But would this break anything?
+;; - should store the package's keywords in archive-contents, then
+;; let the users filter the package-menu by keyword. See
+;; finder-by-keyword. (We could also let people view the
+;; Commentary, but it isn't clear how useful this is.)
+;; - William Xu suggests being able to open a package file without
+;; installing it
+;; - Interface with desktop.el so that restarting after an install
+;; works properly
+;; - Implement M-x package-upgrade, to upgrade any/all existing packages
+;; - Use hierarchical layout. PKG/etc PKG/lisp PKG/info
+;; ... except maybe lisp?
+;; - It may be nice to have a macro that expands to the package's
+;; private data dir, aka ".../etc". Or, maybe data-directory
+;; needs to be a list (though this would be less nice)
+;; a few packages want this, eg sokoban
+;; - package menu needs:
+;; ability to know which packages are built-in & thus not deletable
+;; it can sometimes print odd results, like 0.3 available but 0.4 active
+;; why is that?
+;; - Allow multiple versions on the server...?
+;; [ why bother? ]
+;; - Don't install a package which will invalidate dependencies overall
+;; - Allow something like (or (>= emacs 21.0) (>= xemacs 21.5))
+;; [ currently thinking, why bother.. KISS ]
+;; - Allow optional package dependencies
+;; then if we require 'bbdb', bbdb-specific lisp in lisp/bbdb
+;; and just don't compile to add to load path ...?
+;; - Have a list of archive URLs? [ maybe there's no point ]
+;; - David Kastrup pointed out on the xemacs list that for GPL it
+;; is friendlier to ship the source tree. We could "support" that
+;; by just having a "src" subdir in the package. This isn't ideal
+;; but it probably is not worth trying to support random source
+;; tree layouts, build schemes, etc.
+;; - Our treatment of the info path is somewhat bogus
+;; - perhaps have an "unstable" tree in ELPA as well as a stable one
+
+;;; Code:
+
+(require 'tabulated-list)
+
+(defgroup package nil
+ "Manager for Emacs Lisp packages."
+ :group 'applications
+ :version "24.1")
+
+;;;###autoload
+(defcustom package-enable-at-startup t
+ "Whether to activate installed packages when Emacs starts.
+If non-nil, packages are activated after reading the init file
+and before `after-init-hook'. Activation is not done if
+`user-init-file' is nil (e.g. Emacs was started with \"-q\").
+
+Even if the value is nil, you can type \\[package-initialize] to
+activate the package system at any time."
+ :type 'boolean
+ :group 'package
+ :version "24.1")
+
+(defcustom package-load-list '(all)
+ "List of packages for `package-initialize' to load.
+Each element in this list should be a list (NAME VERSION), or the
+symbol `all'. The symbol `all' says to load the latest installed
+versions of all packages not specified by other elements.
+
+For an element (NAME VERSION), NAME is a package name (a symbol).
+VERSION should be t, a string, or nil.
+If VERSION is t, all versions are loaded, though obsolete ones
+ will be put in `package-obsolete-alist' and not activated.
+If VERSION is a string, only that version is ever loaded.
+ Any other version, even if newer, is silently ignored.
+ Hence, the package is \"held\" at that version.
+If VERSION is nil, the package is not loaded (it is \"disabled\")."
+ :type '(repeat symbol)
+ :risky t
+ :group 'package
+ :version "24.1")
+
+(defvar Info-directory-list)
+(declare-function info-initialize "info" ())
+(declare-function url-http-parse-response "url-http" ())
+(declare-function lm-header "lisp-mnt" (header))
+(declare-function lm-commentary "lisp-mnt" (&optional file))
+(defvar url-http-end-of-headers)
+
+(defcustom package-archives '(("gnu" . "http://elpa.gnu.org/packages/"))
+ "An alist of archives from which to fetch.
+The default value points to the GNU Emacs package repository.
+
+Each element has the form (ID . LOCATION).
+ ID is an archive name, as a string.
+ LOCATION specifies the base location for the archive.
+ If it starts with \"http:\", it is treated as a HTTP URL;
+ otherwise it should be an absolute directory name.
+ (Other types of URL are currently not supported.)
+
+Only add locations that you trust, since fetching and installing
+a package can run arbitrary code."
+ :type '(alist :key-type (string :tag "Archive name")
+ :value-type (string :tag "URL or directory name"))
+ :risky t
+ :group 'package
+ :version "24.1")
+
+(defconst package-archive-version 1
+ "Version number of the package archive understood by this file.
+Lower version numbers than this will probably be understood as well.")
+
+(defconst package-el-version "1.0"
+ "Version of package.el.")
+
+;; We don't prime the cache since it tends to get out of date.
+(defvar package-archive-contents nil
+ "Cache of the contents of the Emacs Lisp Package Archive.
+This is an alist mapping package names (symbols) to package
+descriptor vectors. These are like the vectors for `package-alist'
+but have extra entries: one which is 'tar for tar packages and
+'single for single-file packages, and one which is the name of
+the archive from which it came.")
+(put 'package-archive-contents 'risky-local-variable t)
+
+(defcustom package-user-dir (locate-user-emacs-file "elpa")
+ "Directory containing the user's Emacs Lisp packages.
+The directory name should be absolute.
+Apart from this directory, Emacs also looks for system-wide
+packages in `package-directory-list'."
+ :type 'directory
+ :risky t
+ :group 'package
+ :version "24.1")
+
+(defcustom package-directory-list
+ ;; Defaults are subdirs named "elpa" in the site-lisp dirs.
+ (let (result)
+ (dolist (f load-path)
+ (and (stringp f)
+ (equal (file-name-nondirectory f) "site-lisp")
+ (push (expand-file-name "elpa" f) result)))
+ (nreverse result))
+ "List of additional directories containing Emacs Lisp packages.
+Each directory name should be absolute.
+
+These directories contain packages intended for system-wide; in
+contrast, `package-user-dir' contains packages for personal use."
+ :type '(repeat directory)
+ :risky t
+ :group 'package
+ :version "24.1")
+
+;; The value is precomputed in finder-inf.el, but don't load that
+;; until it's needed (i.e. when `package-initialize' is called).
+(defvar package--builtins nil
+ "Alist of built-in packages.
+The actual value is initialized by loading the library
+`finder-inf'; this is not done until it is needed, e.g. by the
+function `package-built-in-p'.
+
+Each element has the form (PKG . DESC), where PKG is a package
+name (a symbol) and DESC is a vector that describes the package.
+The vector DESC has the form [VERSION-LIST REQS DOCSTRING].
+ VERSION-LIST is a version list.
+ REQS is a list of packages required by the package, each
+ requirement having the form (NAME VL), where NAME is a string
+ and VL is a version list.
+ DOCSTRING is a brief description of the package.")
+(put 'package--builtins 'risky-local-variable t)
+
+(defvar package-alist nil
+ "Alist of all packages available for activation.
+Each element has the form (PKG . DESC), where PKG is a package
+name (a symbol) and DESC is a vector that describes the package.
+
+The vector DESC has the form [VERSION-LIST REQS DOCSTRING].
+ VERSION-LIST is a version list.
+ REQS is a list of packages required by the package, each
+ requirement having the form (NAME VL) where NAME is a string
+ and VL is a version list.
+ DOCSTRING is a brief description of the package.
+
+This variable is set automatically by `package-load-descriptor',
+called via `package-initialize'. To change which packages are
+loaded and/or activated, customize `package-load-list'.")
+(put 'package-alist 'risky-local-variable t)
+
+(defvar package-activated-list nil
+ "List of the names of currently activated packages.")
+(put 'package-activated-list 'risky-local-variable t)
+
+(defvar package-obsolete-alist nil
+ "Representation of obsolete packages.
+Like `package-alist', but maps package name to a second alist.
+The inner alist is keyed by version.")
+(put 'package-obsolete-alist 'risky-local-variable t)
+
+(defun package-version-join (vlist)
+ "Return the version string corresponding to the list VLIST.
+This is, approximately, the inverse of `version-to-list'.
+\(Actually, it returns only one of the possible inverses, since
+`version-to-list' is a many-to-one operation.)"
+ (if (null vlist)
+ ""
+ (let ((str-list (list "." (int-to-string (car vlist)))))
+ (dolist (num (cdr vlist))
+ (cond
+ ((>= num 0)
+ (push (int-to-string num) str-list)
+ (push "." str-list))
+ ((< num -3)
+ (error "Invalid version list `%s'" vlist))
+ (t
+ ;; pre, or beta, or alpha
+ (cond ((equal "." (car str-list))
+ (pop str-list))
+ ((not (string-match "[0-9]+" (car str-list)))
+ (error "Invalid version list `%s'" vlist)))
+ (push (cond ((= num -1) "pre")
+ ((= num -2) "beta")
+ ((= num -3) "alpha"))
+ str-list))))
+ (if (equal "." (car str-list))
+ (pop str-list))
+ (apply 'concat (nreverse str-list)))))
+
+(defun package-strip-version (dirname)
+ "Strip the version from a combined package name and version.
+E.g., if given \"quux-23.0\", will return \"quux\""
+ (if (string-match (concat "\\`" package-subdirectory-regexp "\\'") dirname)
+ (match-string 1 dirname)))
+
+(defun package-load-descriptor (dir package)
+ "Load the description file in directory DIR for package PACKAGE.
+Here, PACKAGE is a string of the form NAME-VERSION, where NAME is
+the package name and VERSION is its version."
+ (let* ((pkg-dir (expand-file-name package dir))
+ (pkg-file (expand-file-name
+ (concat (package-strip-version package) "-pkg")
+ pkg-dir)))
+ (when (and (file-directory-p pkg-dir)
+ (file-exists-p (concat pkg-file ".el")))
+ (load pkg-file nil t))))
+
+(defun package-load-all-descriptors ()
+ "Load descriptors for installed Emacs Lisp packages.
+This looks for package subdirectories in `package-user-dir' and
+`package-directory-list'. The variable `package-load-list'
+controls which package subdirectories may be loaded.
+
+In each valid package subdirectory, this function loads the
+description file containing a call to `define-package', which
+updates `package-alist' and `package-obsolete-alist'."
+ (let ((regexp (concat "\\`" package-subdirectory-regexp "\\'")))
+ (dolist (dir (cons package-user-dir package-directory-list))
+ (when (file-directory-p dir)
+ (dolist (subdir (directory-files dir))
+ (when (string-match regexp subdir)
+ (package-maybe-load-descriptor (match-string 1 subdir)
+ (match-string 2 subdir)
+ dir)))))))
+
+(defun package-maybe-load-descriptor (name version dir)
+ "Maybe load a specific package from directory DIR.
+NAME and VERSION are the package's name and version strings.
+This function checks `package-load-list', before actually loading
+the package by calling `package-load-descriptor'."
+ (let ((force (assq (intern name) package-load-list))
+ (subdir (concat name "-" version)))
+ (and (file-directory-p (expand-file-name subdir dir))
+ ;; Check `package-load-list':
+ (cond ((null force)
+ (memq 'all package-load-list))
+ ((null (setq force (cadr force)))
+ nil) ; disabled
+ ((eq force t)
+ t)
+ ((stringp force) ; held
+ (version-list-= (version-to-list version)
+ (version-to-list force)))
+ (t
+ (error "Invalid element in `package-load-list'")))
+ ;; Actually load the descriptor:
+ (package-load-descriptor dir subdir))))
+
+(defsubst package-desc-vers (desc)
+ "Extract version from a package description vector."
+ (aref desc 0))
+
+(defsubst package-desc-reqs (desc)
+ "Extract requirements from a package description vector."
+ (aref desc 1))
+
+(defsubst package-desc-doc (desc)
+ "Extract doc string from a package description vector."
+ (aref desc 2))
+
+(defsubst package-desc-kind (desc)
+ "Extract the kind of download from an archive package description vector."
+ (aref desc 3))
+
+(defun package--dir (name version)
+ "Return the directory where a package is installed, or nil if none.
+NAME and VERSION are both strings."
+ (let* ((subdir (concat name "-" version))
+ (dir-list (cons package-user-dir package-directory-list))
+ pkg-dir)
+ (while dir-list
+ (let ((subdir-full (expand-file-name subdir (car dir-list))))
+ (if (file-directory-p subdir-full)
+ (setq pkg-dir subdir-full
+ dir-list nil)
+ (setq dir-list (cdr dir-list)))))
+ pkg-dir))
+
+(defun package-activate-1 (package pkg-vec)
+ (let* ((name (symbol-name package))
+ (version-str (package-version-join (package-desc-vers pkg-vec)))
+ (pkg-dir (package--dir name version-str)))
+ (unless pkg-dir
+ (error "Internal error: unable to find directory for `%s-%s'"
+ name version-str))
+ ;; Add info node.
+ (when (file-exists-p (expand-file-name "dir" pkg-dir))
+ ;; FIXME: not the friendliest, but simple.
+ (require 'info)
+ (info-initialize)
+ (push pkg-dir Info-directory-list))
+ ;; Add to load path, add autoloads, and activate the package.
+ (push pkg-dir load-path)
+ (load (expand-file-name (concat name "-autoloads") pkg-dir) nil t)
+ (push package package-activated-list)
+ ;; Don't return nil.
+ t))
+
+(defun package-built-in-p (package &optional min-version)
+ "Return true if PACKAGE is built-in to Emacs.
+Optional arg MIN-VERSION, if non-nil, should be a version list
+specifying the minimum acceptable version."
+ (require 'finder-inf nil t) ; For `package--builtins'.
+ (if (eq package 'emacs)
+ (version-list-<= min-version (version-to-list emacs-version))
+ (let ((elt (assq package package--builtins)))
+ (and elt (version-list-<= min-version
+ (package-desc-vers (cdr elt)))))))
+
+;; This function goes ahead and activates a newer version of a package
+;; if an older one was already activated. This is not ideal; we'd at
+;; least need to check to see if the package has actually been loaded,
+;; and not merely activated.
+(defun package-activate (package min-version)
+ "Activate package PACKAGE, of version MIN-VERSION or newer.
+MIN-VERSION should be a version list.
+If PACKAGE has any dependencies, recursively activate them.
+Return nil if the package could not be activated."
+ (let ((pkg-vec (cdr (assq package package-alist)))
+ available-version found)
+ ;; Check if PACKAGE is available in `package-alist'.
+ (when pkg-vec
+ (setq available-version (package-desc-vers pkg-vec)
+ found (version-list-<= min-version available-version)))
+ (cond
+ ;; If no such package is found, maybe it's built-in.
+ ((null found)
+ (package-built-in-p package min-version))
+ ;; If the package is already activated, just return t.
+ ((memq package package-activated-list)
+ t)
+ ;; Otherwise, proceed with activation.
+ (t
+ (let ((fail (catch 'dep-failure
+ ;; Activate its dependencies recursively.
+ (dolist (req (package-desc-reqs pkg-vec))
+ (unless (package-activate (car req) (cadr req))
+ (throw 'dep-failure req))))))
+ (if fail
+ (warn "Unable to activate package `%s'.
+Required package `%s-%s' is unavailable"
+ package (car fail) (package-version-join (cadr fail)))
+ ;; If all goes well, activate the package itself.
+ (package-activate-1 package pkg-vec)))))))
+
+(defun package-mark-obsolete (package pkg-vec)
+ "Put package on the obsolete list, if not already there."
+ (let ((elt (assq package package-obsolete-alist)))
+ (if elt
+ ;; If this obsolete version does not exist in the list, update
+ ;; it the list.
+ (unless (assoc (package-desc-vers pkg-vec) (cdr elt))
+ (setcdr elt (cons (cons (package-desc-vers pkg-vec) pkg-vec)
+ (cdr elt))))
+ ;; Make a new association.
+ (push (cons package (list (cons (package-desc-vers pkg-vec)
+ pkg-vec)))
+ package-obsolete-alist))))
+
+(defun define-package (name-string version-string
+ &optional docstring requirements
+ &rest _extra-properties)
+ "Define a new package.
+NAME-STRING is the name of the package, as a string.
+VERSION-STRING is the version of the package, as a string.
+DOCSTRING is a short description of the package, a string.
+REQUIREMENTS is a list of dependencies on other packages.
+ Each requirement is of the form (OTHER-PACKAGE OTHER-VERSION),
+ where OTHER-VERSION is a string.
+
+EXTRA-PROPERTIES is currently unused."
+ (let* ((name (intern name-string))
+ (version (version-to-list version-string))
+ (new-pkg-desc
+ (cons name
+ (vector version
+ (mapcar
+ (lambda (elt)
+ (list (car elt)
+ (version-to-list (car (cdr elt)))))
+ requirements)
+ docstring)))
+ (old-pkg (assq name package-alist)))
+ (cond
+ ;; If there's no old package, just add this to `package-alist'.
+ ((null old-pkg)
+ (push new-pkg-desc package-alist))
+ ((version-list-< (package-desc-vers (cdr old-pkg)) version)
+ ;; Remove the old package and declare it obsolete.
+ (package-mark-obsolete name (cdr old-pkg))
+ (setq package-alist (cons new-pkg-desc
+ (delq old-pkg package-alist))))
+ ;; You can have two packages with the same version, e.g. one in
+ ;; the system package directory and one in your private
+ ;; directory. We just let the first one win.
+ ((not (version-list-= (package-desc-vers (cdr old-pkg)) version))
+ ;; The package is born obsolete.
+ (package-mark-obsolete name (cdr new-pkg-desc))))))
+
+;; From Emacs 22.
+(defun package-autoload-ensure-default-file (file)
+ "Make sure that the autoload file FILE exists and if not create it."
+ (unless (file-exists-p file)
+ (write-region
+ (concat ";;; " (file-name-nondirectory file)
+ " --- automatically extracted autoloads\n"
+ ";;\n"
+ ";;; Code:\n\n"
+ "\f\n;; Local Variables:\n"
+ ";; version-control: never\n"
+ ";; no-byte-compile: t\n"
+ ";; no-update-autoloads: t\n"
+ ";; End:\n"
+ ";;; " (file-name-nondirectory file)
+ " ends here\n")
+ nil file))
+ file)
+
+(defun package-generate-autoloads (name pkg-dir)
+ (require 'autoload) ;Load before we let-bind generated-autoload-file!
+ (let* ((auto-name (concat name "-autoloads.el"))
+ ;;(ignore-name (concat name "-pkg.el"))
+ (generated-autoload-file (expand-file-name auto-name pkg-dir))
+ (version-control 'never))
+ (unless (fboundp 'autoload-ensure-default-file)
+ (package-autoload-ensure-default-file generated-autoload-file))
+ (update-directory-autoloads pkg-dir)
+ (let ((buf (find-buffer-visiting generated-autoload-file)))
+ (when buf (kill-buffer buf)))))
+
+(defvar tar-parse-info)
+(declare-function tar-untar-buffer "tar-mode" ())
+(declare-function tar-header-name "tar-mode" (tar-header))
+(declare-function tar-header-link-type "tar-mode" (tar-header))
+
+(defun package-untar-buffer (dir)
+ "Untar the current buffer.
+This uses `tar-untar-buffer' from Tar mode. All files should
+untar into a directory named DIR; otherwise, signal an error."
+ (require 'tar-mode)
+ (tar-mode)
+ ;; Make sure everything extracts into DIR.
+ (let ((regexp (concat "\\`" (regexp-quote (expand-file-name dir)) "/"))
+ (case-fold-search (memq system-type '(windows-nt ms-dos cygwin))))
+ (dolist (tar-data tar-parse-info)
+ (let ((name (expand-file-name (tar-header-name tar-data))))
+ (or (string-match regexp name)
+ ;; Tarballs created by some utilities don't list
+ ;; directories with a trailing slash (Bug#13136).
+ (and (string-equal dir name)
+ (eq (tar-header-link-type tar-data) 5))
+ (error "Package does not untar cleanly into directory %s/" dir)))))
+ (tar-untar-buffer))
+
+(defun package-unpack (package version)
+ (let* ((name (symbol-name package))
+ (dirname (concat name "-" version))
+ (pkg-dir (expand-file-name dirname package-user-dir)))
+ (make-directory package-user-dir t)
+ ;; FIXME: should we delete PKG-DIR if it exists?
+ (let* ((default-directory (file-name-as-directory package-user-dir)))
+ (package-untar-buffer dirname)
+ (package--make-autoloads-and-compile name pkg-dir))))
+
+(defun package--make-autoloads-and-compile (name pkg-dir)
+ "Generate autoloads and do byte-compilation for package named NAME.
+PKG-DIR is the name of the package directory."
+ (package-generate-autoloads name pkg-dir)
+ (let ((load-path (cons pkg-dir load-path)))
+ ;; We must load the autoloads file before byte compiling, in
+ ;; case there are magic cookies to set up non-trivial paths.
+ (load (expand-file-name (concat name "-autoloads") pkg-dir) nil t)
+ (byte-recompile-directory pkg-dir 0 t)))
+
+(defun package--write-file-no-coding (file-name)
+ (let ((buffer-file-coding-system 'no-conversion))
+ (write-region (point-min) (point-max) file-name)))
+
+(defun package-unpack-single (file-name version desc requires)
+ "Install the contents of the current buffer as a package."
+ ;; Special case "package".
+ (if (string= file-name "package")
+ (package--write-file-no-coding
+ (expand-file-name (concat file-name ".el") package-user-dir))
+ (let* ((pkg-dir (expand-file-name (concat file-name "-"
+ (package-version-join
+ (version-to-list version)))
+ package-user-dir))
+ (el-file (expand-file-name (concat file-name ".el") pkg-dir))
+ (pkg-file (expand-file-name (concat file-name "-pkg.el") pkg-dir)))
+ (make-directory pkg-dir t)
+ (package--write-file-no-coding el-file)
+ (let ((print-level nil)
+ (print-length nil))
+ (write-region
+ (concat
+ (prin1-to-string
+ (list 'define-package
+ file-name
+ version
+ desc
+ (list 'quote
+ ;; Turn version lists into string form.
+ (mapcar
+ (lambda (elt)
+ (list (car elt)
+ (package-version-join (cadr elt))))
+ requires))))
+ "\n")
+ nil
+ pkg-file
+ nil nil nil 'excl))
+ (package--make-autoloads-and-compile file-name pkg-dir))))
+
+(defmacro package--with-work-buffer (location file &rest body)
+ "Run BODY in a buffer containing the contents of FILE at LOCATION.
+LOCATION is the base location of a package archive, and should be
+one of the URLs (or file names) specified in `package-archives'.
+FILE is the name of a file relative to that base location.
+
+This macro retrieves FILE from LOCATION into a temporary buffer,
+and evaluates BODY while that buffer is current. This work
+buffer is killed afterwards. Return the last value in BODY."
+ `(let* ((http (string-match "\\`https?:" ,location))
+ (buffer
+ (if http
+ (url-retrieve-synchronously (concat ,location ,file))
+ (generate-new-buffer "*package work buffer*"))))
+ (prog1
+ (with-current-buffer buffer
+ (if http
+ (progn (package-handle-response)
+ (re-search-forward "^$" nil 'move)
+ (forward-char)
+ (delete-region (point-min) (point)))
+ (unless (file-name-absolute-p ,location)
+ (error "Archive location %s is not an absolute file name"
+ ,location))
+ (insert-file-contents (expand-file-name ,file ,location)))
+ ,@body)
+ (kill-buffer buffer))))
+
+(defun package-handle-response ()
+ "Handle the response from a `url-retrieve-synchronously' call.
+Parse the HTTP response and throw if an error occurred.
+The url package seems to require extra processing for this.
+This should be called in a `save-excursion', in the download buffer.
+It will move point to somewhere in the headers."
+ ;; We assume HTTP here.
+ (require 'url-http)
+ (let ((response (url-http-parse-response)))
+ (when (or (< response 200) (>= response 300))
+ (error "Error during download request:%s"
+ (buffer-substring-no-properties (point) (progn
+ (end-of-line)
+ (point)))))))
+
+(defun package-download-single (name version desc requires)
+ "Download and install a single-file package."
+ (let ((location (package-archive-base name))
+ (file (concat (symbol-name name) "-" version ".el")))
+ (package--with-work-buffer location file
+ (package-unpack-single (symbol-name name) version desc requires))))
+
+(defun package-download-tar (name version)
+ "Download and install a tar package."
+ (let ((location (package-archive-base name))
+ (file (concat (symbol-name name) "-" version ".tar")))
+ (package--with-work-buffer location file
+ (package-unpack name version))))
+
+(defvar package--initialized nil)
+
+(defun package-installed-p (package &optional min-version)
+ "Return true if PACKAGE, of MIN-VERSION or newer, is installed.
+MIN-VERSION should be a version list."
+ (unless package--initialized (error "package.el is not yet initialized!"))
+ (let ((pkg-desc (assq package package-alist)))
+ (if pkg-desc
+ (version-list-<= min-version
+ (package-desc-vers (cdr pkg-desc)))
+ ;; Also check built-in packages.
+ (package-built-in-p package min-version))))
+
+(defun package-compute-transaction (package-list requirements)
+ "Return a list of packages to be installed, including PACKAGE-LIST.
+PACKAGE-LIST should be a list of package names (symbols).
+
+REQUIREMENTS should be a list of additional requirements; each
+element in this list should have the form (PACKAGE VERSION-LIST),
+where PACKAGE is a package name and VERSION-LIST is the required
+version of that package.
+
+This function recursively computes the requirements of the
+packages in REQUIREMENTS, and returns a list of all the packages
+that must be installed. Packages that are already installed are
+not included in this list."
+ (dolist (elt requirements)
+ (let* ((next-pkg (car elt))
+ (next-version (cadr elt)))
+ (unless (package-installed-p next-pkg next-version)
+ ;; A package is required, but not installed. It might also be
+ ;; blocked via `package-load-list'.
+ (let ((pkg-desc (assq next-pkg package-archive-contents))
+ hold)
+ (when (setq hold (assq next-pkg package-load-list))
+ (setq hold (cadr hold))
+ (cond ((eq hold t))
+ ((eq hold nil)
+ (error "Required package '%s' is disabled"
+ (symbol-name next-pkg)))
+ ((null (stringp hold))
+ (error "Invalid element in `package-load-list'"))
+ ((version-list-< (version-to-list hold) next-version)
+ (error "Package `%s' held at version %s, \
+but version %s required"
+ (symbol-name next-pkg) hold
+ (package-version-join next-version)))))
+ (unless pkg-desc
+ (error "Package `%s-%s' is unavailable"
+ (symbol-name next-pkg)
+ (package-version-join next-version)))
+ (unless (version-list-<= next-version
+ (package-desc-vers (cdr pkg-desc)))
+ (error
+ "Need package `%s-%s', but only %s is available"
+ (symbol-name next-pkg) (package-version-join next-version)
+ (package-version-join (package-desc-vers (cdr pkg-desc)))))
+ ;; Only add to the transaction if we don't already have it.
+ (unless (memq next-pkg package-list)
+ (push next-pkg package-list))
+ (setq package-list
+ (package-compute-transaction package-list
+ (package-desc-reqs
+ (cdr pkg-desc))))))))
+ package-list)
+
+(defun package-read-from-string (str)
+ "Read a Lisp expression from STR.
+Signal an error if the entire string was not used."
+ (let* ((read-data (read-from-string str))
+ (more-left
+ (condition-case nil
+ ;; The call to `ignore' suppresses a compiler warning.
+ (progn (ignore (read-from-string
+ (substring str (cdr read-data))))
+ t)
+ (end-of-file nil))))
+ (if more-left
+ (error "Can't read whole string")
+ (car read-data))))
+
+(defun package--read-archive-file (file)
+ "Re-read archive file FILE, if it exists.
+Will return the data from the file, or nil if the file does not exist.
+Will throw an error if the archive version is too new."
+ (let ((filename (expand-file-name file package-user-dir)))
+ (when (file-exists-p filename)
+ (with-temp-buffer
+ (insert-file-contents-literally filename)
+ (let ((contents (read (current-buffer))))
+ (if (> (car contents) package-archive-version)
+ (error "Package archive version %d is higher than %d"
+ (car contents) package-archive-version))
+ (cdr contents))))))
+
+(defun package-read-all-archive-contents ()
+ "Re-read `archive-contents', if it exists.
+If successful, set `package-archive-contents'."
+ (setq package-archive-contents nil)
+ (dolist (archive package-archives)
+ (package-read-archive-contents (car archive))))
+
+(defun package-read-archive-contents (archive)
+ "Re-read archive contents for ARCHIVE.
+If successful, set the variable `package-archive-contents'.
+If the archive version is too new, signal an error."
+ ;; Version 1 of 'archive-contents' is identical to our internal
+ ;; representation.
+ (let* ((dir (concat "archives/" archive))
+ (contents-file (concat dir "/archive-contents"))
+ contents)
+ (when (setq contents (package--read-archive-file contents-file))
+ (dolist (package contents)
+ (package--add-to-archive-contents package archive)))))
+
+(defun package--add-to-archive-contents (package archive)
+ "Add the PACKAGE from the given ARCHIVE if necessary.
+Also, add the originating archive to the end of the package vector."
+ (let* ((name (car package))
+ (version (package-desc-vers (cdr package)))
+ (entry (cons name
+ (vconcat (cdr package) (vector archive))))
+ (existing-package (assq name package-archive-contents)))
+ (cond ((not existing-package)
+ (add-to-list 'package-archive-contents entry))
+ ((version-list-< (package-desc-vers (cdr existing-package))
+ version)
+ ;; Replace the entry with this one.
+ (setq package-archive-contents
+ (cons entry
+ (delq existing-package
+ package-archive-contents)))))))
+
+(defun package-download-transaction (package-list)
+ "Download and install all the packages in PACKAGE-LIST.
+PACKAGE-LIST should be a list of package names (symbols).
+This function assumes that all package requirements in
+PACKAGE-LIST are satisfied, i.e. that PACKAGE-LIST is computed
+using `package-compute-transaction'."
+ (dolist (elt package-list)
+ (let* ((desc (cdr (assq elt package-archive-contents)))
+ ;; As an exception, if package is "held" in
+ ;; `package-load-list', download the held version.
+ (hold (cadr (assq elt package-load-list)))
+ (v-string (or (and (stringp hold) hold)
+ (package-version-join (package-desc-vers desc))))
+ (kind (package-desc-kind desc)))
+ (cond
+ ((eq kind 'tar)
+ (package-download-tar elt v-string))
+ ((eq kind 'single)
+ (package-download-single elt v-string
+ (package-desc-doc desc)
+ (package-desc-reqs desc)))
+ (t
+ (error "Unknown package kind: %s" (symbol-name kind))))
+ ;; If package A depends on package B, then A may `require' B
+ ;; during byte compilation. So we need to activate B before
+ ;; unpacking A.
+ (package-maybe-load-descriptor (symbol-name elt) v-string
+ package-user-dir)
+ (package-activate elt (version-to-list v-string)))))
+
+;;;###autoload
+(defun package-install (name)
+ "Install the package named NAME.
+NAME should be the name of one of the available packages in an
+archive in `package-archives'. Interactively, prompt for NAME."
+ (interactive
+ (progn
+ ;; Initialize the package system to get the list of package
+ ;; symbols for completion.
+ (unless package--initialized
+ (package-initialize t))
+ (unless package-archive-contents
+ (package-refresh-contents))
+ (list (intern (completing-read
+ "Install package: "
+ (mapcar (lambda (elt)
+ (cons (symbol-name (car elt))
+ nil))
+ package-archive-contents)
+ nil t)))))
+ (let ((pkg-desc (assq name package-archive-contents)))
+ (unless pkg-desc
+ (error "Package `%s' is not available for installation"
+ (symbol-name name)))
+ (package-download-transaction
+ (package-compute-transaction (list name)
+ (package-desc-reqs (cdr pkg-desc))))))
+
+(defun package-strip-rcs-id (str)
+ "Strip RCS version ID from the version string STR.
+If the result looks like a dotted numeric version, return it.
+Otherwise return nil."
+ (when str
+ (when (string-match "\\`[ \t]*[$]Revision:[ \t]+" str)
+ (setq str (substring str (match-end 0))))
+ (condition-case nil
+ (if (version-to-list str)
+ str)
+ (error nil))))
+
+(defun package-buffer-info ()
+ "Return a vector describing the package in the current buffer.
+The vector has the form
+
+ [FILENAME REQUIRES DESCRIPTION VERSION COMMENTARY]
+
+FILENAME is the file name, a string, sans the \".el\" extension.
+REQUIRES is a list of requirements, each requirement having the
+ form (NAME VER); NAME is a string and VER is a version list.
+DESCRIPTION is the package description, a string.
+VERSION is the version, a string.
+COMMENTARY is the commentary section, a string, or nil if none.
+
+If the buffer does not contain a conforming package, signal an
+error. If there is a package, narrow the buffer to the file's
+boundaries."
+ (goto-char (point-min))
+ (unless (re-search-forward "^;;; \\([^ ]*\\)\\.el ---[ \t]*\\(.*?\\)[ \t]*\\(-\\*-.*-\\*-[ \t]*\\)?$" nil t)
+ (error "Packages lacks a file header"))
+ (let ((file-name (match-string-no-properties 1))
+ (desc (match-string-no-properties 2))
+ (start (line-beginning-position)))
+ (unless (search-forward (concat ";;; " file-name ".el ends here"))
+ (error "Package lacks a terminating comment"))
+ ;; Try to include a trailing newline.
+ (forward-line)
+ (narrow-to-region start (point))
+ (require 'lisp-mnt)
+ ;; Use some headers we've invented to drive the process.
+ (let* ((requires-str (lm-header "package-requires"))
+ (requires (if requires-str
+ (package-read-from-string requires-str)))
+ ;; Prefer Package-Version; if defined, the package author
+ ;; probably wants us to use it. Otherwise try Version.
+ (pkg-version
+ (or (package-strip-rcs-id (lm-header "package-version"))
+ (package-strip-rcs-id (lm-header "version"))))
+ (commentary (lm-commentary)))
+ (unless pkg-version
+ (error
+ "Package lacks a \"Version\" or \"Package-Version\" header"))
+ ;; Turn string version numbers into list form.
+ (setq requires
+ (mapcar
+ (lambda (elt)
+ (list (car elt)
+ (version-to-list (car (cdr elt)))))
+ requires))
+ (vector file-name requires desc pkg-version commentary))))
+
+(defun package-tar-file-info (file)
+ "Find package information for a tar file.
+FILE is the name of the tar file to examine.
+The return result is a vector like `package-buffer-info'."
+ (let ((default-directory (file-name-directory file))
+ (file (file-name-nondirectory file)))
+ (unless (string-match (concat "\\`" package-subdirectory-regexp "\\.tar\\'")
+ file)
+ (error "Invalid package name `%s'" file))
+ (let* ((pkg-name (match-string-no-properties 1 file))
+ (pkg-version (match-string-no-properties 2 file))
+ ;; Extract the package descriptor.
+ (pkg-def-contents (shell-command-to-string
+ ;; Requires GNU tar.
+ (concat "tar -xOf " file " "
+
+ pkg-name "-" pkg-version "/"
+ pkg-name "-pkg.el")))
+ (pkg-def-parsed (package-read-from-string pkg-def-contents)))
+ (unless (eq (car pkg-def-parsed) 'define-package)
+ (error "No `define-package' sexp is present in `%s-pkg.el'" pkg-name))
+ (let ((name-str (nth 1 pkg-def-parsed))
+ (version-string (nth 2 pkg-def-parsed))
+ (docstring (nth 3 pkg-def-parsed))
+ (requires (nth 4 pkg-def-parsed))
+ (readme (shell-command-to-string
+ ;; Requires GNU tar.
+ (concat "tar -xOf " file " "
+ pkg-name "-" pkg-version "/README"))))
+ (unless (equal pkg-version version-string)
+ (error "Package has inconsistent versions"))
+ (unless (equal pkg-name name-str)
+ (error "Package has inconsistent names"))
+ ;; Kind of a hack.
+ (if (string-match ": Not found in archive" readme)
+ (setq readme nil))
+ ;; Turn string version numbers into list form.
+ (if (eq (car requires) 'quote)
+ (setq requires (car (cdr requires))))
+ (setq requires
+ (mapcar (lambda (elt)
+ (list (car elt)
+ (version-to-list (cadr elt))))
+ requires))
+ (vector pkg-name requires docstring version-string readme)))))
+
+;;;###autoload
+(defun package-install-from-buffer (pkg-info type)
+ "Install a package from the current buffer.
+When called interactively, the current buffer is assumed to be a
+single .el file that follows the packaging guidelines; see info
+node `(elisp)Packaging'.
+
+When called from Lisp, PKG-INFO is a vector describing the
+information, of the type returned by `package-buffer-info'; and
+TYPE is the package type (either `single' or `tar')."
+ (interactive (list (package-buffer-info) 'single))
+ (save-excursion
+ (save-restriction
+ (let* ((file-name (aref pkg-info 0))
+ (requires (aref pkg-info 1))
+ (desc (if (string= (aref pkg-info 2) "")
+ "No description available."
+ (aref pkg-info 2)))
+ (pkg-version (aref pkg-info 3)))
+ ;; Download and install the dependencies.
+ (let ((transaction (package-compute-transaction nil requires)))
+ (package-download-transaction transaction))
+ ;; Install the package itself.
+ (cond
+ ((eq type 'single)
+ (package-unpack-single file-name pkg-version desc requires))
+ ((eq type 'tar)
+ (package-unpack (intern file-name) pkg-version))
+ (t
+ (error "Unknown type: %s" (symbol-name type))))
+ ;; Try to activate it.
+ (package-initialize)))))
+
+;;;###autoload
+(defun package-install-file (file)
+ "Install a package from a file.
+The file can either be a tar file or an Emacs Lisp file."
+ (interactive "fPackage file name: ")
+ (with-temp-buffer
+ (insert-file-contents-literally file)
+ (cond
+ ((string-match "\\.el$" file)
+ (package-install-from-buffer (package-buffer-info) 'single))
+ ((string-match "\\.tar$" file)
+ (package-install-from-buffer (package-tar-file-info file) 'tar))
+ (t (error "Unrecognized extension `%s'" (file-name-extension file))))))
+
+(defun package-delete (name version)
+ (let ((dir (package--dir name version)))
+ (if (string-equal (file-name-directory dir)
+ (file-name-as-directory
+ (expand-file-name package-user-dir)))
+ (progn
+ (delete-directory dir t t)
+ (message "Package `%s-%s' deleted." name version))
+ ;; Don't delete "system" packages
+ (error "Package `%s-%s' is a system package, not deleting"
+ name version))))
+
+(defun package-archive-base (name)
+ "Return the archive containing the package NAME."
+ (let ((desc (cdr (assq (intern-soft name) package-archive-contents))))
+ (cdr (assoc (aref desc (- (length desc) 1)) package-archives))))
+
+(defun package--download-one-archive (archive file)
+ "Retrieve an archive file FILE from ARCHIVE, and cache it.
+ARCHIVE should be a cons cell of the form (NAME . LOCATION),
+similar to an entry in `package-alist'. Save the cached copy to
+\"archives/NAME/archive-contents\" in `package-user-dir'."
+ (let* ((dir (expand-file-name "archives" package-user-dir))
+ (dir (expand-file-name (car archive) dir)))
+ (package--with-work-buffer (cdr archive) file
+ ;; Read the retrieved buffer to make sure it is valid (e.g. it
+ ;; may fetch a URL redirect page).
+ (when (listp (read buffer))
+ (make-directory dir t)
+ (setq buffer-file-name (expand-file-name file dir))
+ (let ((version-control 'never))
+ (save-buffer))))))
+
+;;;###autoload
+(defun package-refresh-contents ()
+ "Download the ELPA archive description if needed.
+This informs Emacs about the latest versions of all packages, and
+makes them available for download."
+ (interactive)
+ (unless (file-exists-p package-user-dir)
+ (make-directory package-user-dir t))
+ (dolist (archive package-archives)
+ (condition-case-unless-debug nil
+ (package--download-one-archive archive "archive-contents")
+ (error (message "Failed to download `%s' archive."
+ (car archive)))))
+ (package-read-all-archive-contents))
+
+;;;###autoload
+(defun package-initialize (&optional no-activate)
+ "Load Emacs Lisp packages, and activate them.
+The variable `package-load-list' controls which packages to load.
+If optional arg NO-ACTIVATE is non-nil, don't activate packages."
+ (interactive)
+ (setq package-alist nil
+ package-obsolete-alist nil)
+ (package-load-all-descriptors)
+ (package-read-all-archive-contents)
+ (unless no-activate
+ (dolist (elt package-alist)
+ (package-activate (car elt) (package-desc-vers (cdr elt)))))
+ (setq package--initialized t))
+
+\f
+;;;; Package description buffer.
+
+;;;###autoload
+(defun describe-package (package)
+ "Display the full documentation of PACKAGE (a symbol)."
+ (interactive
+ (let* ((guess (function-called-at-point))
+ packages val)
+ (require 'finder-inf nil t)
+ ;; Load the package list if necessary (but don't activate them).
+ (unless package--initialized
+ (package-initialize t))
+ (setq packages (append (mapcar 'car package-alist)
+ (mapcar 'car package-archive-contents)
+ (mapcar 'car package--builtins)))
+ (unless (memq guess packages)
+ (setq guess nil))
+ (setq packages (mapcar 'symbol-name packages))
+ (setq val
+ (completing-read (if guess
+ (format "Describe package (default %s): "
+ guess)
+ "Describe package: ")
+ packages nil t nil nil guess))
+ (list (if (equal val "") guess (intern val)))))
+ (if (or (null package) (not (symbolp package)))
+ (message "No package specified")
+ (help-setup-xref (list #'describe-package package)
+ (called-interactively-p 'interactive))
+ (with-help-window (help-buffer)
+ (with-current-buffer standard-output
+ (describe-package-1 package)))))
+
+(defun describe-package-1 (package)
+ (require 'lisp-mnt)
+ (let ((package-name (symbol-name package))
+ (built-in (assq package package--builtins))
+ desc pkg-dir reqs version installable archive)
+ (prin1 package)
+ (princ " is ")
+ (cond
+ ;; Loaded packages are in `package-alist'.
+ ((setq desc (cdr (assq package package-alist)))
+ (setq version (package-version-join (package-desc-vers desc)))
+ (if (setq pkg-dir (package--dir package-name version))
+ (insert "an installed package.\n\n")
+ ;; This normally does not happen.
+ (insert "a deleted package.\n\n")))
+ ;; Available packages are in `package-archive-contents'.
+ ((setq desc (cdr (assq package package-archive-contents)))
+ (setq version (package-version-join (package-desc-vers desc))
+ archive (aref desc (- (length desc) 1))
+ installable t)
+ (if built-in
+ (insert "a built-in package.\n\n")
+ (insert "an uninstalled package.\n\n")))
+ (built-in
+ (setq desc (cdr built-in)
+ version (package-version-join (package-desc-vers desc)))
+ (insert "a built-in package.\n\n"))
+ (t
+ (insert "an orphan package.\n\n")))
+
+ (insert " " (propertize "Status" 'font-lock-face 'bold) ": ")
+ (cond (pkg-dir
+ (insert (propertize "Installed"
+ 'font-lock-face 'font-lock-comment-face))
+ (insert " in `")
+ ;; Todo: Add button for uninstalling.
+ (help-insert-xref-button (file-name-as-directory pkg-dir)
+ 'help-package-def pkg-dir)
+ (if built-in
+ (insert "',\n shadowing a "
+ (propertize "built-in package"
+ 'font-lock-face 'font-lock-builtin-face)
+ ".")
+ (insert "'.")))
+ (installable
+ (if built-in
+ (insert (propertize "Built-in." 'font-lock-face 'font-lock-builtin-face)
+ " Alternate version available")
+ (insert "Available"))
+ (insert " from " archive)
+ (insert " -- ")
+ (let ((button-text (if (display-graphic-p) "Install" "[Install]"))
+ (button-face (if (display-graphic-p)
+ '(:box (:line-width 2 :color "dark grey")
+ :background "light grey"
+ :foreground "black")
+ 'link)))
+ (insert-text-button button-text 'face button-face 'follow-link t
+ 'package-symbol package
+ 'action 'package-install-button-action)))
+ (built-in
+ (insert (propertize "Built-in." 'font-lock-face 'font-lock-builtin-face)))
+ (t (insert "Deleted.")))
+ (insert "\n")
+ (and version (> (length version) 0)
+ (insert " "
+ (propertize "Version" 'font-lock-face 'bold) ": " version "\n"))
+
+ (setq reqs (if desc (package-desc-reqs desc)))
+ (when reqs
+ (insert " " (propertize "Requires" 'font-lock-face 'bold) ": ")
+ (let ((first t)
+ name vers text)
+ (dolist (req reqs)
+ (setq name (car req)
+ vers (cadr req)
+ text (format "%s-%s" (symbol-name name)
+ (package-version-join vers)))
+ (cond (first (setq first nil))
+ ((>= (+ 2 (current-column) (length text))
+ (window-width))
+ (insert ",\n "))
+ (t (insert ", ")))
+ (help-insert-xref-button text 'help-package name))
+ (insert "\n")))
+ (insert " " (propertize "Summary" 'font-lock-face 'bold)
+ ": " (if desc (package-desc-doc desc)) "\n\n")
+
+ (if built-in
+ ;; For built-in packages, insert the commentary.
+ (let ((fn (locate-file (concat package-name ".el") load-path
+ load-file-rep-suffixes))
+ (opoint (point)))
+ (insert (or (lm-commentary fn) ""))
+ (save-excursion
+ (goto-char opoint)
+ (when (re-search-forward "^;;; Commentary:\n" nil t)
+ (replace-match ""))
+ (while (re-search-forward "^\\(;+ ?\\)" nil t)
+ (replace-match ""))))
+ (let ((readme (expand-file-name (concat package-name "-readme.txt")
+ package-user-dir))
+ readme-string)
+ ;; For elpa packages, try downloading the commentary. If that
+ ;; fails, try an existing readme file in `package-user-dir'.
+ (cond ((condition-case nil
+ (package--with-work-buffer (package-archive-base package)
+ (concat package-name "-readme.txt")
+ (setq buffer-file-name
+ (expand-file-name readme package-user-dir))
+ (let ((version-control 'never))
+ (save-buffer))
+ (setq readme-string (buffer-string))
+ t)
+ (error nil))
+ (insert readme-string))
+ ((file-readable-p readme)
+ (insert-file-contents readme)
+ (goto-char (point-max))))))))
+
+(defun package-install-button-action (button)
+ (let ((package (button-get button 'package-symbol)))
+ (when (y-or-n-p (format "Install package `%s'? " package))
+ (package-install package)
+ (revert-buffer nil t)
+ (goto-char (point-min)))))
+
+\f
+;;;; Package menu mode.
+
+(defvar package-menu-mode-map
+ (let ((map (make-sparse-keymap))
+ (menu-map (make-sparse-keymap "Package")))
+ (set-keymap-parent map tabulated-list-mode-map)
+ (define-key map "\C-m" 'package-menu-describe-package)
+ (define-key map "u" 'package-menu-mark-unmark)
+ (define-key map "\177" 'package-menu-backup-unmark)
+ (define-key map "d" 'package-menu-mark-delete)
+ (define-key map "i" 'package-menu-mark-install)
+ (define-key map "U" 'package-menu-mark-upgrades)
+ (define-key map "r" 'package-menu-refresh)
+ (define-key map "~" 'package-menu-mark-obsolete-for-deletion)
+ (define-key map "x" 'package-menu-execute)
+ (define-key map "h" 'package-menu-quick-help)
+ (define-key map "?" 'package-menu-describe-package)
+ (define-key map [menu-bar package-menu] (cons "Package" menu-map))
+ (define-key menu-map [mq]
+ '(menu-item "Quit" quit-window
+ :help "Quit package selection"))
+ (define-key menu-map [s1] '("--"))
+ (define-key menu-map [mn]
+ '(menu-item "Next" next-line
+ :help "Next Line"))
+ (define-key menu-map [mp]
+ '(menu-item "Previous" previous-line
+ :help "Previous Line"))
+ (define-key menu-map [s2] '("--"))
+ (define-key menu-map [mu]
+ '(menu-item "Unmark" package-menu-mark-unmark
+ :help "Clear any marks on a package and move to the next line"))
+ (define-key menu-map [munm]
+ '(menu-item "Unmark Backwards" package-menu-backup-unmark
+ :help "Back up one line and clear any marks on that package"))
+ (define-key menu-map [md]
+ '(menu-item "Mark for Deletion" package-menu-mark-delete
+ :help "Mark a package for deletion and move to the next line"))
+ (define-key menu-map [mi]
+ '(menu-item "Mark for Install" package-menu-mark-install
+ :help "Mark a package for installation and move to the next line"))
+ (define-key menu-map [mupgrades]
+ '(menu-item "Mark Upgradable Packages" package-menu-mark-upgrades
+ :help "Mark packages that have a newer version for upgrading"))
+ (define-key menu-map [s3] '("--"))
+ (define-key menu-map [mg]
+ '(menu-item "Update Package List" revert-buffer
+ :help "Update the list of packages"))
+ (define-key menu-map [mr]
+ '(menu-item "Refresh Package List" package-menu-refresh
+ :help "Download the ELPA archive"))
+ (define-key menu-map [s4] '("--"))
+ (define-key menu-map [mt]
+ '(menu-item "Mark Obsolete Packages" package-menu-mark-obsolete-for-deletion
+ :help "Mark all obsolete packages for deletion"))
+ (define-key menu-map [mx]
+ '(menu-item "Execute Actions" package-menu-execute
+ :help "Perform all the marked actions"))
+ (define-key menu-map [s5] '("--"))
+ (define-key menu-map [mh]
+ '(menu-item "Help" package-menu-quick-help
+ :help "Show short key binding help for package-menu-mode"))
+ (define-key menu-map [mc]
+ '(menu-item "View Commentary" package-menu-view-commentary
+ :help "Display information about this package"))
+ map)
+ "Local keymap for `package-menu-mode' buffers.")
+
+(defvar package-menu--new-package-list nil
+ "List of newly-available packages since `list-packages' was last called.")
+
+(define-derived-mode package-menu-mode tabulated-list-mode "Package Menu"
+ "Major mode for browsing a list of packages.
+Letters do not insert themselves; instead, they are commands.
+\\<package-menu-mode-map>
+\\{package-menu-mode-map}"
+ (setq tabulated-list-format [("Package" 18 package-menu--name-predicate)
+ ("Version" 12 nil)
+ ("Status" 10 package-menu--status-predicate)
+ ("Description" 0 nil)])
+ (setq tabulated-list-padding 2)
+ (setq tabulated-list-sort-key (cons "Status" nil))
+ (tabulated-list-init-header))
+
+(defmacro package--push (package desc status listname)
+ "Convenience macro for `package-menu--generate'.
+If the alist stored in the symbol LISTNAME lacks an entry for a
+package PACKAGE with descriptor DESC, add one. The alist is
+keyed with cons cells (PACKAGE . VERSION-LIST), where PACKAGE is
+a symbol and VERSION-LIST is a version list."
+ `(let* ((version (package-desc-vers ,desc))
+ (key (cons ,package version)))
+ (unless (assoc key ,listname)
+ (push (list key ,status (package-desc-doc ,desc)) ,listname))))
+
+(defun package-menu--generate (remember-pos packages)
+ "Populate the Package Menu.
+If REMEMBER-POS is non-nil, keep point on the same entry.
+PACKAGES should be t, which means to display all known packages,
+or a list of package names (symbols) to display."
+ ;; Construct list of ((PACKAGE . VERSION) STATUS DESCRIPTION).
+ (let (info-list name)
+ ;; Installed packages:
+ (dolist (elt package-alist)
+ (setq name (car elt))
+ (when (or (eq packages t) (memq name packages))
+ (package--push name (cdr elt)
+ (if (stringp (cadr (assq name package-load-list)))
+ "held" "installed")
+ info-list)))
+
+ ;; Built-in packages:
+ (dolist (elt package--builtins)
+ (setq name (car elt))
+ (when (and (not (eq name 'emacs)) ; Hide the `emacs' package.
+ (or (eq packages t) (memq name packages)))
+ (package--push name (cdr elt) "built-in" info-list)))
+
+ ;; Available and disabled packages:
+ (dolist (elt package-archive-contents)
+ (setq name (car elt))
+ (when (or (eq packages t) (memq name packages))
+ (let ((hold (assq name package-load-list)))
+ (package--push name (cdr elt)
+ (cond
+ ((and hold (null (cadr hold))) "disabled")
+ ((memq name package-menu--new-package-list) "new")
+ (t "available"))
+ info-list))))
+
+ ;; Obsolete packages:
+ (dolist (elt package-obsolete-alist)
+ (dolist (inner-elt (cdr elt))
+ (when (or (eq packages t) (memq (car elt) packages))
+ (package--push (car elt) (cdr inner-elt) "obsolete" info-list))))
+
+ ;; Print the result.
+ (setq tabulated-list-entries (mapcar 'package-menu--print-info info-list))
+ (tabulated-list-print remember-pos)))
+
+(defun package-menu--print-info (pkg)
+ "Return a package entry suitable for `tabulated-list-entries'.
+PKG has the form ((PACKAGE . VERSION) STATUS DOC).
+Return (KEY [NAME VERSION STATUS DOC]), where KEY is the
+identifier (NAME . VERSION-LIST)."
+ (let* ((package (caar pkg))
+ (version (cdr (car pkg)))
+ (status (nth 1 pkg))
+ (doc (or (nth 2 pkg) ""))
+ (face (cond
+ ((string= status "built-in") 'font-lock-builtin-face)
+ ((string= status "available") 'default)
+ ((string= status "new") 'bold)
+ ((string= status "held") 'font-lock-constant-face)
+ ((string= status "disabled") 'font-lock-warning-face)
+ ((string= status "installed") 'font-lock-comment-face)
+ (t 'font-lock-warning-face)))) ; obsolete.
+ (list (cons package version)
+ (vector (list (symbol-name package)
+ 'face 'link
+ 'follow-link t
+ 'package-symbol package
+ 'action 'package-menu-describe-package)
+ (propertize (package-version-join version)
+ 'font-lock-face face)
+ (propertize status 'font-lock-face face)
+ (propertize doc 'font-lock-face face)))))
+
+(defun package-menu-refresh ()
+ "Download the Emacs Lisp package archive.
+This fetches the contents of each archive specified in
+`package-archives', and then refreshes the package menu."
+ (interactive)
+ (unless (derived-mode-p 'package-menu-mode)
+ (error "The current buffer is not a Package Menu"))
+ (package-refresh-contents)
+ (package-menu--generate t t))
+
+(defun package-menu-describe-package (&optional button)
+ "Describe the current package.
+If optional arg BUTTON is non-nil, describe its associated package."
+ (interactive)
+ (let ((package (if button (button-get button 'package-symbol)
+ (car (tabulated-list-get-id)))))
+ (if package
+ (describe-package package))))
+
+;; fixme numeric argument
+(defun package-menu-mark-delete (&optional _num)
+ "Mark a package for deletion and move to the next line."
+ (interactive "p")
+ (if (member (package-menu-get-status) '("installed" "obsolete"))
+ (tabulated-list-put-tag "D" t)
+ (forward-line)))
+
+(defun package-menu-mark-install (&optional _num)
+ "Mark a package for installation and move to the next line."
+ (interactive "p")
+ (if (member (package-menu-get-status) '("available" "new"))
+ (tabulated-list-put-tag "I" t)
+ (forward-line)))
+
+(defun package-menu-mark-unmark (&optional _num)
+ "Clear any marks on a package and move to the next line."
+ (interactive "p")
+ (tabulated-list-put-tag " " t))
+
+(defun package-menu-backup-unmark ()
+ "Back up one line and clear any marks on that package."
+ (interactive)
+ (forward-line -1)
+ (tabulated-list-put-tag " "))
+
+(defun package-menu-mark-obsolete-for-deletion ()
+ "Mark all obsolete packages for deletion."
+ (interactive)
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (if (equal (package-menu-get-status) "obsolete")
+ (tabulated-list-put-tag "D" t)
+ (forward-line 1)))))
+
+(defun package-menu-quick-help ()
+ "Show short key binding help for package-menu-mode."
+ (interactive)
+ (message "n-ext, i-nstall, d-elete, u-nmark, x-ecute, r-efresh, h-elp"))
+
+(define-obsolete-function-alias
+ 'package-menu-view-commentary 'package-menu-describe-package "24.1")
+
+(defun package-menu-get-status ()
+ (let* ((pkg (tabulated-list-get-id))
+ (entry (and pkg (assq pkg tabulated-list-entries))))
+ (if entry
+ (aref (cadr entry) 2)
+ "")))
+
+(defun package-menu--find-upgrades ()
+ (let (installed available upgrades)
+ ;; Build list of installed/available packages in this buffer.
+ (dolist (entry tabulated-list-entries)
+ ;; ENTRY is ((NAME . VERSION) [NAME VERSION STATUS DOC])
+ (let ((pkg (car entry))
+ (status (aref (cadr entry) 2)))
+ (cond ((equal status "installed")
+ (push pkg installed))
+ ((member status '("available" "new"))
+ (push pkg available)))))
+ ;; Loop through list of installed packages, finding upgrades
+ (dolist (pkg installed)
+ (let ((avail-pkg (assq (car pkg) available)))
+ (and avail-pkg
+ (version-list-< (cdr pkg) (cdr avail-pkg))
+ (push avail-pkg upgrades))))
+ upgrades))
+
+(defun package-menu-mark-upgrades ()
+ "Mark all upgradable packages in the Package Menu.
+For each installed package with a newer version available, place
+an (I)nstall flag on the available version and a (D)elete flag on
+the installed version. A subsequent \\[package-menu-execute]
+call will upgrade the package."
+ (interactive)
+ (unless (derived-mode-p 'package-menu-mode)
+ (error "The current buffer is not a Package Menu"))
+ (let ((upgrades (package-menu--find-upgrades)))
+ (if (null upgrades)
+ (message "No packages to upgrade.")
+ (widen)
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (let* ((pkg (tabulated-list-get-id))
+ (upgrade (assq (car pkg) upgrades)))
+ (cond ((null upgrade)
+ (forward-line 1))
+ ((equal pkg upgrade)
+ (package-menu-mark-install))
+ (t
+ (package-menu-mark-delete))))))
+ (message "%d package%s marked for upgrading."
+ (length upgrades)
+ (if (= (length upgrades) 1) "" "s")))))
+
+(defun package-menu-execute (&optional noquery)
+ "Perform marked Package Menu actions.
+Packages marked for installation are downloaded and installed;
+packages marked for deletion are removed.
+Optional argument NOQUERY non-nil means do not ask the user to confirm."
+ (interactive)
+ (unless (derived-mode-p 'package-menu-mode)
+ (error "The current buffer is not in Package Menu mode"))
+ (let (install-list delete-list cmd id)
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (setq cmd (char-after))
+ (unless (eq cmd ?\s)
+ ;; This is the key (PACKAGE . VERSION-LIST).
+ (setq id (tabulated-list-get-id))
+ (cond ((eq cmd ?D)
+ (push (cons (symbol-name (car id))
+ (package-version-join (cdr id)))
+ delete-list))
+ ((eq cmd ?I)
+ (push (car id) install-list))))
+ (forward-line)))
+ (when install-list
+ (if (or
+ noquery
+ (yes-or-no-p
+ (if (= (length install-list) 1)
+ (format "Install package `%s'? " (car install-list))
+ (format "Install these %d packages (%s)? "
+ (length install-list)
+ (mapconcat 'symbol-name install-list ", ")))))
+ (mapc 'package-install install-list)))
+ ;; Delete packages, prompting if necessary.
+ (when delete-list
+ (if (or
+ noquery
+ (yes-or-no-p
+ (if (= (length delete-list) 1)
+ (format "Delete package `%s-%s'? "
+ (caar delete-list)
+ (cdr (car delete-list)))
+ (format "Delete these %d packages (%s)? "
+ (length delete-list)
+ (mapconcat (lambda (elt)
+ (concat (car elt) "-" (cdr elt)))
+ delete-list
+ ", ")))))
+ (dolist (elt delete-list)
+ (condition-case-unless-debug err
+ (package-delete (car elt) (cdr elt))
+ (error (message (cadr err)))))
+ (error "Aborted")))
+ ;; If we deleted anything, regenerate `package-alist'. This is done
+ ;; automatically if we installed a package.
+ (and delete-list (null install-list)
+ (package-initialize))
+ (if (or delete-list install-list)
+ (package-menu--generate t t)
+ (message "No operations specified."))))
+
+(defun package-menu--version-predicate (A B)
+ (let ((vA (or (aref (cadr A) 1) '(0)))
+ (vB (or (aref (cadr B) 1) '(0))))
+ (if (version-list-= vA vB)
+ (package-menu--name-predicate A B)
+ (version-list-< vA vB))))
+
+(defun package-menu--status-predicate (A B)
+ (let ((sA (aref (cadr A) 2))
+ (sB (aref (cadr B) 2)))
+ (cond ((string= sA sB)
+ (package-menu--name-predicate A B))
+ ((string= sA "new") t)
+ ((string= sB "new") nil)
+ ((string= sA "available") t)
+ ((string= sB "available") nil)
+ ((string= sA "installed") t)
+ ((string= sB "installed") nil)
+ ((string= sA "held") t)
+ ((string= sB "held") nil)
+ ((string= sA "built-in") t)
+ ((string= sB "built-in") nil)
+ ((string= sA "obsolete") t)
+ ((string= sB "obsolete") nil)
+ (t (string< sA sB)))))
+
+(defun package-menu--description-predicate (A B)
+ (let ((dA (aref (cadr A) 3))
+ (dB (aref (cadr B) 3)))
+ (if (string= dA dB)
+ (package-menu--name-predicate A B)
+ (string< dA dB))))
+
+(defun package-menu--name-predicate (A B)
+ (string< (symbol-name (caar A))
+ (symbol-name (caar B))))
+
+;;;###autoload
+(defun list-packages (&optional no-fetch)
+ "Display a list of packages.
+This first fetches the updated list of packages before
+displaying, unless a prefix argument NO-FETCH is specified.
+The list is displayed in a buffer named `*Packages*'."
+ (interactive "P")
+ (require 'finder-inf nil t)
+ ;; Initialize the package system if necessary.
+ (unless package--initialized
+ (package-initialize t))
+ (let (old-archives new-packages)
+ (unless no-fetch
+ ;; Read the locally-cached archive-contents.
+ (package-read-all-archive-contents)
+ (setq old-archives package-archive-contents)
+ ;; Fetch the remote list of packages.
+ (package-refresh-contents)
+ ;; Find which packages are new.
+ (dolist (elt package-archive-contents)
+ (unless (assq (car elt) old-archives)
+ (push (car elt) new-packages))))
+
+ ;; Generate the Package Menu.
+ (let ((buf (get-buffer-create "*Packages*")))
+ (with-current-buffer buf
+ (package-menu-mode)
+ (set (make-local-variable 'package-menu--new-package-list)
+ new-packages)
+ (package-menu--generate nil t))
+ ;; The package menu buffer has keybindings. If the user types
+ ;; `M-x list-packages', that suggests it should become current.
+ (switch-to-buffer buf))
+
+ (let ((upgrades (package-menu--find-upgrades)))
+ (if upgrades
+ (message "%d package%s can be upgraded; type `%s' to mark %s for upgrading."
+ (length upgrades)
+ (if (= (length upgrades) 1) "" "s")
+ (substitute-command-keys "\\[package-menu-mark-upgrades]")
+ (if (= (length upgrades) 1) "it" "them"))))))
+
+;;;###autoload
+(defalias 'package-list-packages 'list-packages)
+
+;; Used in finder.el
+(defun package-show-package-list (packages)
+ "Display PACKAGES in a *Packages* buffer.
+This is similar to `list-packages', but it does not fetch the
+updated list of packages, and it only displays packages with
+names in PACKAGES (which should be a list of symbols)."
+ (require 'finder-inf nil t)
+ (let ((buf (get-buffer-create "*Packages*")))
+ (with-current-buffer buf
+ (package-menu-mode)
+ (package-menu--generate nil packages))
+ (switch-to-buffer buf)))
+
+(defun package-list-packages-no-fetch ()
+ "Display a list of packages.
+Does not fetch the updated list of packages before displaying.
+The list is displayed in a buffer named `*Packages*'."
+ (interactive)
+ (list-packages t))
+
+(provide 'package)
+
+;;; package.el ends here
--- /dev/null
+;;; tabulated-list-autoloads.el --- automatically extracted autoloads
+;;
+;;; Code:
+
+\f
+;;;### (autoloads (tabulated-list-mode) "tabulated-list" "tabulated-list.el"
+;;;;;; (21205 13642))
+;;; Generated autoloads from tabulated-list.el
+
+(autoload 'tabulated-list-mode "tabulated-list" "\
+Generic major mode for browsing a list of items.
+This mode is usually not used directly; instead, other major
+modes are derived from it, using `define-derived-mode'.
+
+In this major mode, the buffer is divided into multiple columns,
+which are labeled using the header line. Each non-empty line
+belongs to one \"entry\", and the entries can be sorted according
+to their column values.
+
+An inheriting mode should usually do the following in their body:
+
+ - Set `tabulated-list-format', specifying the column format.
+ - Set `tabulated-list-revert-hook', if the buffer contents need
+ to be specially recomputed prior to `revert-buffer'.
+ - Maybe set a `tabulated-list-entries' function (see below).
+ - Maybe set `tabulated-list-printer' (see below).
+ - Maybe set `tabulated-list-padding'.
+ - Call `tabulated-list-init-header' to initialize `header-line-format'
+ according to `tabulated-list-format'.
+
+An inheriting mode is usually accompanied by a \"list-FOO\"
+command (e.g. `list-packages', `list-processes'). This command
+creates or switches to a buffer and enables the major mode in
+that buffer. If `tabulated-list-entries' is not a function, the
+command should initialize it to a list of entries for displaying.
+Finally, it should call `tabulated-list-print'.
+
+`tabulated-list-print' calls the printer function specified by
+`tabulated-list-printer', once for each entry. The default
+printer is `tabulated-list-print-entry', but a mode that keeps
+data in an ewoc may instead specify a printer function (e.g., one
+that calls `ewoc-enter-last'), with `tabulated-list-print-entry'
+as the ewoc pretty-printer.
+
+\(fn)" t nil)
+
+;;;***
+\f
+;;;### (autoloads nil nil ("tabulated-list-pkg.el") (21205 13642
+;;;;;; 931937))
+
+;;;***
+\f
+(provide 'tabulated-list-autoloads)
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; coding: utf-8
+;; End:
+;;; tabulated-list-autoloads.el ends here
--- /dev/null
+(define-package "tabulated-list" "0" "generic major mode for tabulated lists." (quote nil))
--- /dev/null
+;;; tabulated-list.el --- generic major mode for tabulated lists.
+
+;; Copyright (C) 2011 Free Software Foundation, Inc.
+
+;; Author: Chong Yidong <cydNOSPAMstupidchicken.com>
+;; Keywords: extensions, lisp
+;; Version: 0
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This package is a backport of a native functionality of GNU Emacs 24.
+
+;; This file defines `tabulated-list-mode', a generic major mode for displaying
+;; lists of tabulated data, intended for other major modes to inherit from. It
+;; provides several utility routines, e.g. for pretty-printing lines of
+;; tabulated data to fit into the appropriate columns.
+
+;; For usage information, see the documentation of `tabulated-list-mode'.
+
+;; This package originated from Tom Tromey's Package Menu mode, extended and
+;; generalized to be used by other modes.
+
+;;; Code:
+
+(defvar tabulated-list-format nil
+ "The format of the current Tabulated List mode buffer.
+This should be a vector of elements (NAME WIDTH SORT), where:
+ - NAME is a string describing the column.
+ - WIDTH is the width to reserve for the column.
+ For the final element, its numerical value is ignored.
+ - SORT specifies how to sort entries by this column.
+ If nil, this column cannot be used for sorting.
+ If t, sort by comparing the string value printed in the column.
+ Otherwise, it should be a predicate function suitable for
+ `sort', accepting arguments with the same form as the elements
+ of `tabulated-list-entries'.")
+(make-variable-buffer-local 'tabulated-list-format)
+
+(defvar tabulated-list-entries nil
+ "Entries displayed in the current Tabulated List buffer.
+This should be either a function, or a list.
+If a list, each element has the form (ID [DESC1 ... DESCN]),
+where:
+ - ID is nil, or a Lisp object uniquely identifying this entry,
+ which is used to keep the cursor on the \"same\" entry when
+ rearranging the list. Comparison is done with `equal'.
+
+ - Each DESC is a column descriptor, one for each column
+ specified in `tabulated-list-format'. A descriptor is either
+ a string, which is printed as-is, or a list (LABEL . PROPS),
+ which means to use `insert-text-button' to insert a text
+ button with label LABEL and button properties PROPS.
+ The string, or button label, must not contain any newline.
+
+If `tabulated-list-entries' is a function, it is called with no
+arguments and must return a list of the above form.")
+(make-variable-buffer-local 'tabulated-list-entries)
+
+(defvar tabulated-list-padding 0
+ "Number of characters preceding each Tabulated List mode entry.
+By default, lines are padded with spaces, but you can use the
+function `tabulated-list-put-tag' to change this.")
+(make-variable-buffer-local 'tabulated-list-padding)
+
+(defvar tabulated-list-revert-hook nil
+ "Hook run before reverting a Tabulated List buffer.
+This is commonly used to recompute `tabulated-list-entries'.")
+
+(defvar tabulated-list-printer 'tabulated-list-print-entry
+ "Function for inserting a Tabulated List entry at point.
+It is called with two arguments, ID and COLS. ID is a Lisp
+object identifying the entry, and COLS is a vector of column
+descriptors, as documented in `tabulated-list-entries'.")
+(make-variable-buffer-local 'tabulated-list-printer)
+
+(defvar tabulated-list-sort-key nil
+ "Sort key for the current Tabulated List mode buffer.
+If nil, no additional sorting is performed.
+Otherwise, this should be a cons cell (NAME . FLIP).
+NAME is a string matching one of the column names in
+`tabulated-list-format' (the corresponding SORT entry in
+`tabulated-list-format' then specifies how to sort). FLIP, if
+non-nil, means to invert the resulting sort.")
+(make-variable-buffer-local 'tabulated-list-sort-key)
+
+(defun tabulated-list-get-id (&optional pos)
+ "Obtain the entry ID of the Tabulated List mode entry at POS.
+This is an ID object from `tabulated-list-entries', or nil.
+POS, if omitted or nil, defaults to point."
+ (get-text-property (or pos (point)) 'tabulated-list-id))
+
+(defun tabulated-list-put-tag (tag &optional advance)
+ "Put TAG in the padding area of the current line.
+TAG should be a string, with length <= `tabulated-list-padding'.
+If ADVANCE is non-nil, move forward by one line afterwards."
+ (unless (stringp tag)
+ (error "Invalid argument to `tabulated-list-put-tag'"))
+ (unless (> tabulated-list-padding 0)
+ (error "Unable to tag the current line"))
+ (save-excursion
+ (beginning-of-line)
+ (when (get-text-property (point) 'tabulated-list-id)
+ (let ((beg (point))
+ (inhibit-read-only t))
+ (forward-char tabulated-list-padding)
+ (insert-and-inherit
+ (if (<= (length tag) tabulated-list-padding)
+ (concat tag
+ (make-string (- tabulated-list-padding (length tag))
+ ?\s))
+ (substring tag 0 tabulated-list-padding)))
+ (delete-region beg (+ beg tabulated-list-padding)))))
+ (if advance
+ (forward-line)))
+
+(defvar tabulated-list-mode-map
+ (let ((map (copy-keymap special-mode-map)))
+ (set-keymap-parent map button-buffer-map)
+ (define-key map "n" 'next-line)
+ (define-key map "p" 'previous-line)
+ (define-key map [follow-link] 'mouse-face)
+ (define-key map [mouse-2] 'mouse-select-window)
+ map)
+ "Local keymap for `tabulated-list-mode' buffers.")
+
+(defvar tabulated-list-sort-button-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [header-line mouse-1] 'tabulated-list-col-sort)
+ (define-key map [header-line mouse-2] 'tabulated-list-col-sort)
+ (define-key map [follow-link] 'mouse-face)
+ map)
+ "Local keymap for `tabulated-list-mode' sort buttons.")
+
+(defvar tabulated-list-glyphless-char-display
+ (when (boundp 'glyphless-char-display)
+ (let ((table (make-char-table 'glyphless-char-display nil)))
+ (set-char-table-parent table glyphless-char-display)
+ ;; Some text terminals can't display the unicode arrows; be safe.
+ (aset table 9650 (cons nil "^"))
+ (aset table 9660 (cons nil "v"))
+ table))
+ "The `glyphless-char-display' table in Tabulated List buffers.")
+
+(defun tabulated-list-init-header ()
+ "Set up header line for the Tabulated List buffer."
+ (let ((x tabulated-list-padding)
+ (button-props `(help-echo "Click to sort by column"
+ mouse-face highlight
+ keymap ,tabulated-list-sort-button-map))
+ (cols nil))
+ (if (> tabulated-list-padding 0)
+ (push (propertize " " 'display `(space :align-to ,x)) cols))
+ (dotimes (n (length tabulated-list-format))
+ (let* ((col (aref tabulated-list-format n))
+ (width (nth 1 col))
+ (label (car col)))
+ (setq x (+ x 1 width))
+ (and (<= tabulated-list-padding 0)
+ (= n 0)
+ (setq label (concat " " label)))
+ (push
+ (cond
+ ;; An unsortable column
+ ((not (nth 2 col)) label)
+ ;; The selected sort column
+ ((equal (car col) (car tabulated-list-sort-key))
+ (apply 'propertize
+ (concat label
+ (cond
+ ((> (+ 2 (length label)) width)
+ "")
+ ((cdr tabulated-list-sort-key)
+ " ²")
+ (t " ¼")))
+ 'face 'bold
+ 'tabulated-list-column-name (car col)
+ button-props))
+ ;; Unselected sortable column.
+ (t (apply 'propertize label
+ 'tabulated-list-column-name (car col)
+ button-props)))
+ cols))
+ (push (propertize " "
+ 'display (list 'space :align-to x)
+ 'face 'fixed-pitch)
+ cols))
+ (setq header-line-format (mapconcat 'identity (nreverse cols) ""))))
+
+(defun tabulated-list-revert (&rest ignored)
+ "The `revert-buffer-function' for `tabulated-list-mode'.
+It runs `tabulated-list-revert-hook', then calls `tabulated-list-print'."
+ (interactive)
+ (unless (derived-mode-p 'tabulated-list-mode)
+ (error "The current buffer is not in Tabulated List mode"))
+ (run-hooks 'tabulated-list-revert-hook)
+ (tabulated-list-print t))
+
+(defun tabulated-list-print (&optional remember-pos)
+ "Populate the current Tabulated List mode buffer.
+This sorts the `tabulated-list-entries' list if sorting is
+specified by `tabulated-list-sort-key'. It then erases the
+buffer and inserts the entries with `tabulated-list-printer'.
+
+Optional argument REMEMBER-POS, if non-nil, means to move point
+to the entry with the same ID element as the current line."
+ (let ((inhibit-read-only t)
+ (entries (if (functionp tabulated-list-entries)
+ (funcall tabulated-list-entries)
+ tabulated-list-entries))
+ entry-id saved-pt saved-col)
+ (and remember-pos
+ (setq entry-id (tabulated-list-get-id))
+ (setq saved-col (current-column)))
+ (erase-buffer)
+ ;; Sort the buffers, if necessary.
+ (when tabulated-list-sort-key
+ (let ((sort-column (car tabulated-list-sort-key))
+ (len (length tabulated-list-format))
+ (n 0)
+ sorter)
+ ;; Which column is to be sorted?
+ (while (and (< n len)
+ (not (equal (car (aref tabulated-list-format n))
+ sort-column)))
+ (setq n (1+ n)))
+ (when (< n len)
+ (setq sorter (nth 2 (aref tabulated-list-format n)))
+ (when (eq sorter t)
+ (setq sorter ; Default sorter checks column N:
+ (lambda (A B)
+ (setq A (aref (cadr A) n))
+ (setq B (aref (cadr B) n))
+ (string< (if (stringp A) A (car A))
+ (if (stringp B) B (car B))))))
+ (setq entries (sort entries sorter))
+ (if (cdr tabulated-list-sort-key)
+ (setq entries (nreverse entries)))
+ (unless (functionp tabulated-list-entries)
+ (setq tabulated-list-entries entries)))))
+ ;; Print the resulting list.
+ (dolist (elt entries)
+ (and entry-id
+ (equal entry-id (car elt))
+ (setq saved-pt (point)))
+ (apply tabulated-list-printer elt))
+ (set-buffer-modified-p nil)
+ ;; If REMEMBER-POS was specified, move to the "old" location.
+ (if saved-pt
+ (progn (goto-char saved-pt)
+ (move-to-column saved-col)
+ (recenter))
+ (goto-char (point-min)))))
+
+(defun tabulated-list-print-entry (id cols)
+ "Insert a Tabulated List entry at point.
+This is the default `tabulated-list-printer' function. ID is a
+Lisp object identifying the entry to print, and COLS is a vector
+of column descriptors."
+ (let ((beg (point))
+ (x (max tabulated-list-padding 0))
+ (len (length tabulated-list-format)))
+ (if (> tabulated-list-padding 0)
+ (insert (make-string x ?\s)))
+ (dotimes (n len)
+ (let* ((format (aref tabulated-list-format n))
+ (desc (aref cols n))
+ (width (nth 1 format))
+ (label (if (stringp desc) desc (car desc)))
+ (help-echo (concat (car format) ": " label)))
+ ;; Truncate labels if necessary (except last column).
+ (and (< (1+ n) len)
+ (> (string-width label) width)
+ (setq label (truncate-string-to-width label width nil nil t)))
+ (when (fboundp 'bidi-string-mark-left-to-right)
+ (setq label (bidi-string-mark-left-to-right label)))
+ (if (stringp desc)
+ (insert (propertize label 'help-echo help-echo))
+ (apply 'insert-text-button label (cdr desc)))
+ (setq x (+ x 1 width)))
+ ;; No need to append any spaces if this is the last column.
+ (if (< (1+ n) len)
+ (indent-to x 1)))
+ (insert ?\n)
+ (put-text-property beg (point) 'tabulated-list-id id)))
+
+(defun tabulated-list-col-sort (&optional e)
+ "Sort Tabulated List entries by the column of the mouse click E."
+ (interactive "e")
+ (let* ((pos (event-start e))
+ (obj (posn-object pos))
+ (name (get-text-property (if obj (cdr obj) (posn-point pos))
+ 'tabulated-list-column-name
+ (car obj))))
+ (with-current-buffer (window-buffer (posn-window pos))
+ (when (derived-mode-p 'tabulated-list-mode)
+ ;; Flip the sort order on a second click.
+ (if (equal name (car tabulated-list-sort-key))
+ (setcdr tabulated-list-sort-key
+ (not (cdr tabulated-list-sort-key)))
+ (setq tabulated-list-sort-key (cons name nil)))
+ (tabulated-list-init-header)
+ (tabulated-list-print t)))))
+
+;;; The mode definition:
+
+;;;###autoload
+(define-derived-mode tabulated-list-mode special-mode "Tabulated"
+ "Generic major mode for browsing a list of items.
+This mode is usually not used directly; instead, other major
+modes are derived from it, using `define-derived-mode'.
+
+In this major mode, the buffer is divided into multiple columns,
+which are labeled using the header line. Each non-empty line
+belongs to one \"entry\", and the entries can be sorted according
+to their column values.
+
+An inheriting mode should usually do the following in their body:
+
+ - Set `tabulated-list-format', specifying the column format.
+ - Set `tabulated-list-revert-hook', if the buffer contents need
+ to be specially recomputed prior to `revert-buffer'.
+ - Maybe set a `tabulated-list-entries' function (see below).
+ - Maybe set `tabulated-list-printer' (see below).
+ - Maybe set `tabulated-list-padding'.
+ - Call `tabulated-list-init-header' to initialize `header-line-format'
+ according to `tabulated-list-format'.
+
+An inheriting mode is usually accompanied by a \"list-FOO\"
+command (e.g. `list-packages', `list-processes'). This command
+creates or switches to a buffer and enables the major mode in
+that buffer. If `tabulated-list-entries' is not a function, the
+command should initialize it to a list of entries for displaying.
+Finally, it should call `tabulated-list-print'.
+
+`tabulated-list-print' calls the printer function specified by
+`tabulated-list-printer', once for each entry. The default
+printer is `tabulated-list-print-entry', but a mode that keeps
+data in an ewoc may instead specify a printer function (e.g., one
+that calls `ewoc-enter-last'), with `tabulated-list-print-entry'
+as the ewoc pretty-printer."
+ (setq truncate-lines t)
+ (setq buffer-read-only t)
+ (set (make-local-variable 'revert-buffer-function)
+ 'tabulated-list-revert)
+ (when (boundp 'glyphless-char-display)
+ (set (make-local-variable 'glyphless-char-display)
+ tabulated-list-glyphless-char-display)))
+
+(put 'tabulated-list-mode 'mode-class 'special)
+
+(provide 'tabulated-list)
+
+;; Local Variables:
+;; coding: utf-8
+;; End:
+
+;;; tabulated-list.el ends here
--- /dev/null
+;;; yaml-mode-autoloads.el --- automatically extracted autoloads
+;;
+;;; Code:
+
+\f
+;;;### (autoloads (yaml-mode yaml) "yaml-mode" "yaml-mode.el" (21205
+;;;;;; 13955))
+;;; Generated autoloads from yaml-mode.el
+
+(let ((loads (get 'yaml 'custom-loads))) (if (member '"yaml-mode" loads) nil (put 'yaml 'custom-loads (cons '"yaml-mode" loads))))
+
+(autoload 'yaml-mode "yaml-mode" "\
+Simple mode to edit YAML.
+
+\\{yaml-mode-map}
+
+\(fn)" t nil)
+
+(add-to-list 'auto-mode-alist '("\\.ya?ml$" . yaml-mode))
+
+;;;***
+\f
+;;;### (autoloads nil nil ("yaml-mode-pkg.el") (21205 13955 546345))
+
+;;;***
+\f
+(provide 'yaml-mode-autoloads)
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; coding: utf-8
+;; End:
+;;; yaml-mode-autoloads.el ends here
--- /dev/null
+(define-package "yaml-mode" "0.0.9" "Major mode for editing YAML files" (quote nil))
--- /dev/null
+;;; yaml-mode.el --- Major mode for editing YAML files
+
+;; Copyright (C) 2010-2013 Yoshiki Kurihara
+
+;; Author: Yoshiki Kurihara <clouderNOSPAMgmail.com>
+;; Marshall T. Vandegrift <llasramNOSPAMgmail.com>
+;; Keywords: data yaml
+;; Version: 0.0.9
+
+;; This file is not part of Emacs
+
+;; This file 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 2, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This is a major mode for editing files in the YAML data
+;; serialization format. It was initially developed by Yoshiki
+;; Kurihara and many features were added by Marshall Vandegrift. As
+;; YAML and Python share the fact that indentation determines
+;; structure, this mode provides indentation and indentation command
+;; behavior very similar to that of python-mode.
+
+;;; Installation:
+
+;; To install, just drop this file into a directory in your
+;; `load-path' and (optionally) byte-compile it. To automatically
+;; handle files ending in '.yml', add something like:
+;;
+;; (require 'yaml-mode)
+;; (add-to-list 'auto-mode-alist '("\\.yml$" . yaml-mode))
+;;
+;; to your .emacs file.
+;;
+;; Unlike python-mode, this mode follows the Emacs convention of not
+;; binding the ENTER key to `newline-and-indent'. To get this
+;; behavior, add the key definition to `yaml-mode-hook':
+;;
+;; (add-hook 'yaml-mode-hook
+;; '(lambda ()
+;; (define-key yaml-mode-map "\C-m" 'newline-and-indent)))
+
+;;; Known Bugs:
+
+;; YAML is easy to write but complex to parse, and this mode doesn't
+;; even really try. Indentation and highlighting will break on
+;; abnormally complicated structures.
+
+;;; Code:
+
+\f
+;; User definable variables
+
+;;;###autoload
+(defgroup yaml nil
+ "Support for the YAML serialization format"
+ :group 'languages
+ :prefix "yaml-")
+
+(defcustom yaml-mode-hook nil
+ "*Hook run by `yaml-mode'."
+ :type 'hook
+ :group 'yaml)
+
+(defcustom yaml-indent-offset 2
+ "*Amount of offset per level of indentation."
+ :type 'integer
+ :group 'yaml)
+
+(defcustom yaml-backspace-function 'backward-delete-char-untabify
+ "*Function called by `yaml-electric-backspace' when deleting backwards.
+It will receive one argument, the numeric prefix value."
+ :type 'function
+ :group 'yaml)
+
+(defcustom yaml-block-literal-search-lines 100
+ "*Maximum number of lines to search for start of block literals."
+ :type 'integer
+ :group 'yaml)
+
+(defcustom yaml-block-literal-electric-alist
+ '((?| . "") (?> . "-"))
+ "*Characters for which to provide electric behavior.
+The association list key should be a key code and the associated value
+should be a string containing additional characters to insert when
+that key is pressed to begin a block literal."
+ :type 'alist
+ :group 'yaml)
+
+(defface yaml-tab-face
+ '((((class color)) (:background "red" :foreground "red" :bold t))
+ (t (:reverse-video t)))
+ "Face to use for highlighting tabs in YAML files."
+ :group 'faces
+ :group 'yaml)
+
+(defcustom yaml-imenu-generic-expression
+ '((nil "^\\(:?[a-zA-Z_-]+\\):" 1))
+ "The imenu regex to parse an outline of the yaml file."
+ :type 'string
+ :group 'yaml)
+
+\f
+;; Constants
+
+(defconst yaml-mode-version "0.0.9" "Version of `yaml-mode'.")
+
+(defconst yaml-blank-line-re "^ *$"
+ "Regexp matching a line containing only (valid) whitespace.")
+
+(defconst yaml-comment-re "\\(?:^\\|\\s-+\\)\\(#.*\\)"
+ "Regexp matching a line containing a YAML comment or delimiter.")
+
+(defconst yaml-directive-re "^\\(?:--- \\)? *%\\(\\w+\\)"
+ "Regexp matching a line contatining a YAML directive.")
+
+(defconst yaml-document-delimiter-re "^ *\\(?:---\\|[.][.][.]\\)"
+ "Rexexp matching a YAML document delimiter line.")
+
+(defconst yaml-node-anchor-alias-re "[&*][a-zA-Z0-9_-]+"
+ "Regexp matching a YAML node anchor or alias.")
+
+(defconst yaml-tag-re "!!?[^ \n]+"
+ "Rexexp matching a YAML tag.")
+
+(defconst yaml-bare-scalar-re
+ "\\(?:[^-:,#!\n{\\[ ]\\|[^#!\n{\\[ ]\\S-\\)[^#\n]*?"
+ "Rexexp matching a YAML bare scalar.")
+
+(defconst yaml-hash-key-re
+ (concat "\\(?:^\\(?:--- \\)?\\|{\\|\\(?:[-,] +\\)+\\) *"
+ "\\(?:" yaml-tag-re " +\\)?"
+ "\\(" yaml-bare-scalar-re "\\) *:"
+ "\\(?: +\\|$\\)")
+ "Regexp matching a single YAML hash key.")
+
+(defconst yaml-scalar-context-re
+ (concat "\\(?:^\\(?:--- \\)?\\|{\\|\\(?:[-,] +\\)+\\) *"
+ "\\(?:" yaml-bare-scalar-re " *: \\)?")
+ "Regexp indicating the begininng of a scalar context.")
+
+(defconst yaml-nested-map-re
+ (concat ".*: *\\(?:&.*\\|{ *\\|" yaml-tag-re " *\\)?$")
+ "Regexp matching a line beginning a YAML nested structure.")
+
+(defconst yaml-block-literal-base-re " *[>|][-+0-9]* *\\(?:\n\\|\\'\\)"
+ "Regexp matching the substring start of a block literal.")
+
+(defconst yaml-block-literal-re
+ (concat yaml-scalar-context-re
+ "\\(?:" yaml-tag-re "\\)?"
+ yaml-block-literal-base-re)
+ "Regexp matching a line beginning a YAML block literal.")
+
+(defconst yaml-nested-sequence-re
+ (concat "^\\(?: *- +\\)+"
+ "\\(?:" yaml-bare-scalar-re " *:\\(?: +.*\\)?\\)?$")
+ "Regexp matching a line containing one or more nested YAML sequences.")
+
+(defconst yaml-constant-scalars-re
+ (concat "\\(?:^\\|\\(?::\\|-\\|,\\|{\\|\\[\\) +\\) *"
+ (regexp-opt
+ '("~" "null" "Null" "NULL"
+ ".nan" ".NaN" ".NAN"
+ ".inf" ".Inf" ".INF"
+ "-.inf" "-.Inf" "-.INF"
+ "y" "Y" "yes" "Yes" "YES" "n" "N" "no" "No" "NO"
+ "true" "True" "TRUE" "false" "False" "FALSE"
+ "on" "On" "ON" "off" "Off" "OFF") t)
+ " *$")
+ "Regexp matching certain scalar constants in scalar context.")
+
+\f
+;; Mode setup
+
+(defvar yaml-mode-map ()
+ "Keymap used in `yaml-mode' buffers.")
+(if yaml-mode-map
+ nil
+ (setq yaml-mode-map (make-sparse-keymap))
+ (define-key yaml-mode-map "|" 'yaml-electric-bar-and-angle)
+ (define-key yaml-mode-map ">" 'yaml-electric-bar-and-angle)
+ (define-key yaml-mode-map "-" 'yaml-electric-dash-and-dot)
+ (define-key yaml-mode-map "." 'yaml-electric-dash-and-dot)
+ (define-key yaml-mode-map [backspace] 'yaml-electric-backspace)
+ (define-key yaml-mode-map "\C-j" 'newline-and-indent))
+
+(defvar yaml-mode-syntax-table nil
+ "Syntax table in use in `yaml-mode' buffers.")
+(if yaml-mode-syntax-table
+ nil
+ (setq yaml-mode-syntax-table (make-syntax-table))
+ (modify-syntax-entry ?\' "\"" yaml-mode-syntax-table)
+ (modify-syntax-entry ?\" "\"" yaml-mode-syntax-table)
+ (modify-syntax-entry ?# "<" yaml-mode-syntax-table)
+ (modify-syntax-entry ?\n ">" yaml-mode-syntax-table)
+ (modify-syntax-entry ?\\ "\\" yaml-mode-syntax-table)
+ (modify-syntax-entry ?- "w" yaml-mode-syntax-table)
+ (modify-syntax-entry ?_ "_" yaml-mode-syntax-table)
+ (modify-syntax-entry ?\( "." yaml-mode-syntax-table)
+ (modify-syntax-entry ?\) "." yaml-mode-syntax-table)
+ (modify-syntax-entry ?\{ "(}" yaml-mode-syntax-table)
+ (modify-syntax-entry ?\} "){" yaml-mode-syntax-table)
+ (modify-syntax-entry ?\[ "(]" yaml-mode-syntax-table)
+ (modify-syntax-entry ?\] ")[" yaml-mode-syntax-table))
+
+;;;###autoload
+(define-derived-mode yaml-mode fundamental-mode "YAML"
+ "Simple mode to edit YAML.
+
+\\{yaml-mode-map}"
+ (set (make-local-variable 'comment-start) "# ")
+ (set (make-local-variable 'comment-start-skip) "#+ *")
+ (set (make-local-variable 'indent-line-function) 'yaml-indent-line)
+ (set (make-local-variable 'indent-tabs-mode) nil)
+ (set (make-local-variable 'font-lock-defaults)
+ '(yaml-font-lock-keywords
+ nil nil nil nil
+ (font-lock-syntactic-keywords . yaml-font-lock-syntactic-keywords))))
+
+\f
+;; Font-lock support
+
+(defvar yaml-font-lock-keywords
+ (list
+ (cons yaml-comment-re '(1 font-lock-comment-face))
+ (cons yaml-constant-scalars-re '(1 font-lock-constant-face))
+ (cons yaml-tag-re '(0 font-lock-type-face))
+ (cons yaml-node-anchor-alias-re '(0 font-lock-function-name-face t))
+ (cons yaml-hash-key-re '(1 font-lock-variable-name-face t))
+ (cons yaml-document-delimiter-re '(0 font-lock-comment-face))
+ (cons yaml-directive-re '(1 font-lock-builtin-face))
+ '(yaml-font-lock-block-literals 0 font-lock-string-face t)
+ '("^[\t]+" 0 'yaml-tab-face t))
+ "Additional expressions to highlight in YAML mode.")
+
+(defvar yaml-font-lock-syntactic-keywords
+ (list '(yaml-syntactic-block-literals 0 "." t))
+ "Additional syntax features to highlight in YAML mode.")
+
+
+(defun yaml-font-lock-block-literals (bound)
+ "Find lines within block literals.
+Find the next line of the first (if any) block literal after point and
+prior to BOUND. Returns the beginning and end of the block literal
+line in the match data, as consumed by `font-lock-keywords' matcher
+functions. The function begins by searching backwards to determine
+whether or not the current line is within a block literal. This could
+be time-consuming in large buffers, so the number of lines searched is
+artificially limitted to the value of
+`yaml-block-literal-search-lines'."
+ (if (eolp) (goto-char (1+ (point))))
+ (unless (or (eobp) (>= (point) bound))
+ (let ((begin (point))
+ (end (min (1+ (point-at-eol)) bound)))
+ (goto-char (point-at-bol))
+ (while (and (looking-at yaml-blank-line-re) (not (bobp)))
+ (forward-line -1))
+ (let ((nlines yaml-block-literal-search-lines)
+ (min-level (current-indentation)))
+ (forward-line -1)
+ (while (and (/= nlines 0)
+ (/= min-level 0)
+ (not (looking-at yaml-block-literal-re))
+ (not (bobp)))
+ (set 'nlines (1- nlines))
+ (unless (looking-at yaml-blank-line-re)
+ (set 'min-level (min min-level (current-indentation))))
+ (forward-line -1))
+ (cond
+ ((and (< (current-indentation) min-level)
+ (looking-at yaml-block-literal-re))
+ (goto-char end) (set-match-data (list begin end)) t)
+ ((progn
+ (goto-char begin)
+ (re-search-forward (concat yaml-block-literal-re
+ " *\\(.*\\)\n")
+ bound t))
+ (set-match-data (nthcdr 2 (match-data))) t))))))
+
+(defun yaml-syntactic-block-literals (bound)
+ "Find quote characters within block literals.
+Finds the first quote character within a block literal (if any) after
+point and prior to BOUND. Returns the position of the quote character
+in the match data, as consumed by matcher functions in
+`font-lock-syntactic-keywords'. This allows the mode to treat ['\"]
+characters in block literals as punctuation syntax instead of string
+syntax, preventing unmatched quotes in block literals from painting
+the entire buffer in `font-lock-string-face'."
+ (let ((found nil))
+ (while (and (not found)
+ (/= (point) bound)
+ (yaml-font-lock-block-literals bound))
+ (let ((begin (match-beginning 0)) (end (match-end 0)))
+ (goto-char begin)
+ (cond
+ ((re-search-forward "['\"]" end t) (setq found t))
+ ((goto-char end)))))
+ found))
+
+\f
+;; Indentation and electric keys
+
+(defun yaml-compute-indentation ()
+ "Calculate the maximum sensible indentation for the current line."
+ (save-excursion
+ (beginning-of-line)
+ (if (looking-at yaml-document-delimiter-re) 0
+ (forward-line -1)
+ (while (and (looking-at yaml-blank-line-re)
+ (> (point) (point-min)))
+ (forward-line -1))
+ (+ (current-indentation)
+ (if (looking-at yaml-nested-map-re) yaml-indent-offset 0)
+ (if (looking-at yaml-nested-sequence-re) yaml-indent-offset 0)
+ (if (looking-at yaml-block-literal-re) yaml-indent-offset 0)))))
+
+(defun yaml-indent-line ()
+ "Indent the current line.
+The first time this command is used, the line will be indented to the
+maximum sensible indentation. Each immediately subsequent usage will
+back-dent the line by `yaml-indent-offset' spaces. On reaching column
+0, it will cycle back to the maximum sensible indentation."
+ (interactive "*")
+ (let ((ci (current-indentation))
+ (cc (current-column))
+ (need (yaml-compute-indentation)))
+ (save-excursion
+ (beginning-of-line)
+ (delete-horizontal-space)
+ (if (and (equal last-command this-command) (/= ci 0))
+ (indent-to (* (/ (- ci 1) yaml-indent-offset) yaml-indent-offset))
+ (indent-to need)))
+ (if (< (current-column) (current-indentation))
+ (forward-to-indentation 0))))
+
+(defun yaml-electric-backspace (arg)
+ "Delete characters or back-dent the current line.
+If invoked following only whitespace on a line, will back-dent to the
+immediately previous multiple of `yaml-indent-offset' spaces."
+ (interactive "*p")
+ (if (or (/= (current-indentation) (current-column)) (bolp))
+ (funcall yaml-backspace-function arg)
+ (let ((ci (current-column)))
+ (beginning-of-line)
+ (delete-horizontal-space)
+ (indent-to (* (/ (- ci (* arg yaml-indent-offset))
+ yaml-indent-offset)
+ yaml-indent-offset)))))
+
+(defun yaml-electric-bar-and-angle (arg)
+ "Insert the bound key and possibly begin a block literal.
+Inserts the bound key. If inserting the bound key causes the current
+line to match the initial line of a block literal, then inserts the
+matching string from `yaml-block-literal-electric-alist', a newline,
+and indents appropriately."
+ (interactive "*P")
+ (self-insert-command (prefix-numeric-value arg))
+ (let ((extra-chars
+ (assoc last-command-event
+ yaml-block-literal-electric-alist)))
+ (cond
+ ((and extra-chars (not arg) (eolp)
+ (save-excursion
+ (beginning-of-line)
+ (looking-at yaml-block-literal-re)))
+ (insert (cdr extra-chars))
+ (newline-and-indent)))))
+
+(defun yaml-electric-dash-and-dot (arg)
+ "Insert the bound key and possibly de-dent line.
+Inserts the bound key. If inserting the bound key causes the current
+line to match a document delimiter, de-dent the line to the left
+margin."
+ (interactive "*P")
+ (self-insert-command (prefix-numeric-value arg))
+ (save-excursion
+ (beginning-of-line)
+ (if (and (not arg) (looking-at yaml-document-delimiter-re))
+ (delete-horizontal-space))))
+
+
+(defun yaml-set-imenu-generic-expression ()
+ (make-local-variable 'imenu-generic-expression)
+ (make-local-variable 'imenu-create-index-function)
+ (setq imenu-create-index-function 'imenu-default-create-index-function)
+ (setq imenu-generic-expression yaml-imenu-generic-expression))
+
+(add-hook 'yaml-mode-hook 'yaml-set-imenu-generic-expression)
+
+
+(defun yaml-mode-version ()
+ "Diplay version of `yaml-mode'."
+ (interactive)
+ (message "yaml-mode %s" yaml-mode-version)
+ yaml-mode-version)
+
+;;;###autoload
+(add-to-list 'auto-mode-alist '("\\.ya?ml$" . yaml-mode))
+
+(provide 'yaml-mode)
+
+;;; yaml-mode.el ends here
;; http://www.emacswiki.org/emacs/EmacsNiftyTricks
+
+;; http://www.emacswiki.org/emacs/ELPA
+(require 'package)
+
+(package-initialize)
+
(setq tex-dvi-view-command "(f=*; pdflatex \"${f%.dvi}.tex\" && open \"${f%.dvi}.pdf\")")
(require 'centered-cursor-mode)
(template-initialize)
;; load yaml-mode
-(require 'yaml-mode)
-(add-to-list 'auto-mode-alist '("\\.yml$" . yaml-mode))
+;; (require 'yaml-mode)
+;; (add-to-list 'auto-mode-alist '("\\.yml$" . yaml-mode))
(require 'htmlize )
;; example: [[bmap:space needle]]
;; load git support
; (require 'egg)
-(add-to-list 'load-path "~/.xemacs/xemacs-packages/lisp/egg")
-(load-library "egg")
+;; (add-to-list 'load-path "~/.xemacs/xemacs-packages/lisp/egg")
+;; (load-library "egg")
(load-library "cfengine")
;; to enable mouse-wheel
projects / emacsconfig.git / commitdiff