;;
;; To start: `M-x stgit'
+(when (< emacs-major-version 22)
+ (error "Emacs older than 22 is not supported by stgit.el"))
+
+(require 'git nil t)
+(require 'cl)
+(require 'ewoc)
+(require 'easymenu)
+
(defun stgit (dir)
- "Manage stgit patches"
+ "Manage StGit patches for the tree in DIR.
+
+See `stgit-mode' for commands available."
(interactive "DDirectory: \n")
(switch-to-stgit-buffer (git-get-top-dir dir))
- (stgit-refresh))
-
-(defun git-get-top-dir (dir)
- "Retrieve the top-level directory of a git tree."
- (let ((cdup (with-output-to-string
- (with-current-buffer standard-output
- (cd dir)
- (unless (eq 0 (call-process "git" nil t nil
- "rev-parse" "--show-cdup"))
- (error "cannot find top-level git tree for %s." dir))))))
- (expand-file-name (concat (file-name-as-directory dir)
- (car (split-string cdup "\n"))))))
+ (stgit-reload))
-(defun switch-to-stgit-buffer (dir)
- "Switch to a (possibly new) buffer displaying StGit patches for DIR"
+(defun stgit-assert-mode ()
+ "Signal an error if not in an StGit buffer."
+ (assert (derived-mode-p 'stgit-mode) nil "Not an StGit buffer"))
+
+(unless (fboundp 'git-get-top-dir)
+ (defun git-get-top-dir (dir)
+ "Retrieve the top-level directory of a git tree."
+ (let ((cdup (with-output-to-string
+ (with-current-buffer standard-output
+ (cd dir)
+ (unless (eq 0 (call-process "git" nil t nil
+ "rev-parse" "--show-cdup"))
+ (error "Cannot find top-level git tree for %s" dir))))))
+ (expand-file-name (concat (file-name-as-directory dir)
+ (car (split-string cdup "\n")))))))
+
+(defun stgit-refresh-git-status (&optional dir)
+ "If it exists, refresh the `git-status' buffer belonging to
+directory DIR or `default-directory'"
+ (when (and (fboundp 'git-find-status-buffer)
+ (fboundp 'git-refresh-status))
+ (let* ((top-dir (git-get-top-dir (or dir default-directory)))
+ (git-status-buffer (and top-dir (git-find-status-buffer top-dir))))
+ (when git-status-buffer
+ (with-current-buffer git-status-buffer
+ (git-refresh-status))))))
+
+(defun stgit-find-buffer (dir)
+ "Return the buffer displaying StGit patches for DIR, or nil if none."
(setq dir (file-name-as-directory dir))
(let ((buffers (buffer-list)))
(while (and buffers
(and (eq major-mode 'stgit-mode)
(string= default-directory dir)))))
(setq buffers (cdr buffers)))
- (switch-to-buffer (if buffers
- (car buffers)
- (create-stgit-buffer dir)))))
+ (and buffers (car buffers))))
+
+(defun switch-to-stgit-buffer (dir)
+ "Switch to a (possibly new) buffer displaying StGit patches for DIR."
+ (setq dir (file-name-as-directory dir))
+ (let ((buffer (stgit-find-buffer dir)))
+ (switch-to-buffer (or buffer
+ (create-stgit-buffer dir)))))
+
+(defstruct (stgit-patch)
+ status name desc empty files-ewoc)
+
+(defun stgit-patch-pp (patch)
+ (let* ((status (stgit-patch-status patch))
+ (start (point))
+ (name (stgit-patch-name patch))
+ (face (cdr (assq status stgit-patch-status-face-alist))))
+ (insert (case status
+ ('applied "+")
+ ('top ">")
+ ('unapplied "-")
+ (t " "))
+ (if (memq name stgit-marked-patches)
+ "*" " "))
+ (if (memq status '(index work))
+ (insert (propertize (if (eq status 'index) "Index" "Work tree")
+ 'face face))
+ (insert (format "%-30s"
+ (propertize (symbol-name name)
+ 'face face
+ 'syntax-table (string-to-syntax "w")))
+ " "
+ (if (stgit-patch-empty patch) "(empty) " "")
+ (propertize (or (stgit-patch-desc patch) "")
+ 'face 'stgit-description-face)))
+ (insert "\n")
+ (put-text-property start (point) 'entry-type 'patch)
+ (when (memq name stgit-expanded-patches)
+ (stgit-insert-patch-files patch))
+ (put-text-property start (point) 'patch-data patch)))
(defun create-stgit-buffer (dir)
"Create a buffer for showing StGit patches.
(with-current-buffer buf
(setq default-directory dir)
(stgit-mode)
+ (set (make-local-variable 'stgit-ewoc)
+ (ewoc-create #'stgit-patch-pp "Branch:\n\n" "--\n" t))
(setq buffer-read-only t))
buf))
(defmacro stgit-capture-output (name &rest body)
- "Capture StGit output and show it in a window at the end"
+ "Capture StGit output and, if there was any output, show it in a window
+at the end.
+Returns nil if there was no output."
+ (declare (debug ([&or stringp null] body))
+ (indent 1))
`(let ((output-buf (get-buffer-create ,(or name "*StGit output*")))
(stgit-dir default-directory)
(inhibit-read-only t))
(setq buffer-read-only t)
(if (< (point-min) (point-max))
(display-buffer output-buf t)))))
-(put 'stgit-capture-output 'lisp-indent-function 1)
-(defun stgit-run (&rest args)
+(defun stgit-make-run-args (args)
+ "Return a copy of ARGS with its elements converted to strings."
+ (mapcar (lambda (x)
+ ;; don't use (format "%s" ...) to limit type errors
+ (cond ((stringp x) x)
+ ((integerp x) (number-to-string x))
+ ((symbolp x) (symbol-name x))
+ (t
+ (error "Bad element in stgit-make-run-args args: %S" x))))
+ args))
+
+(defun stgit-run-silent (&rest args)
+ (setq args (stgit-make-run-args args))
(apply 'call-process "stg" nil standard-output nil args))
-(defun stgit-refresh ()
- "Update the contents of the stgit buffer"
+(defun stgit-run (&rest args)
+ (setq args (stgit-make-run-args args))
+ (let ((msgcmd (mapconcat #'identity args " ")))
+ (message "Running stg %s..." msgcmd)
+ (apply 'call-process "stg" nil standard-output nil args)
+ (message "Running stg %s...done" msgcmd)))
+
+(defun stgit-run-git (&rest args)
+ (setq args (stgit-make-run-args args))
+ (let ((msgcmd (mapconcat #'identity args " ")))
+ (message "Running git %s..." msgcmd)
+ (apply 'call-process "git" nil standard-output nil args)
+ (message "Running git %s...done" msgcmd)))
+
+(defun stgit-run-git-silent (&rest args)
+ (setq args (stgit-make-run-args args))
+ (apply 'call-process "git" nil standard-output nil args))
+
+(defun stgit-index-empty-p ()
+ "Returns non-nil if the index contains no changes from HEAD."
+ (zerop (stgit-run-git-silent "diff-index" "--cached" "--quiet" "HEAD")))
+
+(defun stgit-work-tree-empty-p ()
+ "Returns non-nil if the work tree contains no changes from index."
+ (zerop (stgit-run-git-silent "diff-files" "--quiet")))
+
+(defvar stgit-index-node)
+(defvar stgit-worktree-node)
+
+(defun stgit-refresh-index ()
+ (when stgit-index-node
+ (ewoc-invalidate (car stgit-index-node) (cdr stgit-index-node))))
+
+(defun stgit-refresh-worktree ()
+ (when stgit-worktree-node
+ (ewoc-invalidate (car stgit-worktree-node) (cdr stgit-worktree-node))))
+
+(defun stgit-run-series-insert-index (ewoc)
+ (setq index-node (cons ewoc (ewoc-enter-last ewoc
+ (make-stgit-patch
+ :status 'index
+ :name :index
+ :desc nil
+ :empty nil)))
+ worktree-node (cons ewoc (ewoc-enter-last ewoc
+ (make-stgit-patch
+ :status 'work
+ :name :work
+ :desc nil
+ :empty nil)))))
+
+(defun stgit-run-series (ewoc)
+ (setq stgit-index-node nil
+ stgit-worktree-node nil)
+ (let ((inserted-index (not stgit-show-worktree))
+ index-node
+ worktree-node
+ all-patchsyms)
+ (with-temp-buffer
+ (let* ((standard-output (current-buffer))
+ (exit-status (stgit-run-silent "series"
+ "--description" "--empty")))
+ (goto-char (point-min))
+ (if (not (zerop exit-status))
+ (cond ((looking-at "stg series: \\(.*\\)")
+ (setq inserted-index t)
+ (ewoc-set-hf ewoc (car (ewoc-get-hf ewoc))
+ (substitute-command-keys
+ "-- not initialized; run \\[stgit-init]")))
+ ((looking-at ".*")
+ (error "Error running stg: %s"
+ (match-string 0))))
+ (while (not (eobp))
+ (unless (looking-at
+ "\\([0 ]\\)\\([>+-]\\)\\( \\)\\([^ ]+\\) *[|#] \\(.*\\)")
+ (error "Syntax error in output from stg series"))
+ (let* ((state-str (match-string 2))
+ (state (cond ((string= state-str ">") 'top)
+ ((string= state-str "+") 'applied)
+ ((string= state-str "-") 'unapplied)))
+ (name (intern (match-string 4)))
+ (desc (match-string 5))
+ (empty (string= (match-string 1) "0")))
+ (unless inserted-index
+ (when (or (eq stgit-show-worktree-mode 'top)
+ (and (eq stgit-show-worktree-mode 'center)
+ (eq state 'unapplied)))
+ (setq inserted-index t)
+ (stgit-run-series-insert-index ewoc)))
+ (setq all-patchsyms (cons name all-patchsyms))
+ (ewoc-enter-last ewoc
+ (make-stgit-patch
+ :status state
+ :name name
+ :desc desc
+ :empty empty)))
+ (forward-line 1))))
+ (unless inserted-index
+ (stgit-run-series-insert-index ewoc)))
+ (setq stgit-index-node index-node
+ stgit-worktree-node worktree-node
+ stgit-marked-patches (intersection stgit-marked-patches
+ all-patchsyms))))
+
+(defun stgit-reload ()
+ "Update the contents of the StGit buffer."
(interactive)
+ (stgit-assert-mode)
(let ((inhibit-read-only t)
(curline (line-number-at-pos))
- (curpatch (stgit-patch-at-point)))
- (erase-buffer)
- (insert "Branch: ")
- (stgit-run "branch")
- (stgit-run "series" "--description")
- (stgit-rescan)
+ (curpatch (stgit-patch-name-at-point))
+ (curfile (stgit-patched-file-at-point)))
+ (ewoc-filter stgit-ewoc #'(lambda (x) nil))
+ (ewoc-set-hf stgit-ewoc
+ (concat "Branch: "
+ (propertize
+ (substring (with-output-to-string
+ (stgit-run-silent "branch"))
+ 0 -1)
+ 'face 'stgit-branch-name-face)
+ "\n\n")
+ (if stgit-show-worktree
+ "--"
+ (propertize
+ (substitute-command-keys "--\n\"\\[stgit-toggle-worktree]\"\
+ shows the working tree\n")
+ 'face 'stgit-description-face)))
+ (stgit-run-series stgit-ewoc)
(if curpatch
- (stgit-goto-patch curpatch)
- (goto-line curline))))
+ (stgit-goto-patch curpatch (and curfile (stgit-file-file curfile)))
+ (goto-line curline)))
+ (stgit-refresh-git-status))
-(defface stgit-description-face
- '((((background dark)) (:foreground "tan"))
- (((background light)) (:foreground "dark red")))
- "The face used for StGit desriptions")
+(defun stgit-set-default (symbol value)
+ "Set default value of SYMBOL to VALUE using `set-default' and
+reload all StGit buffers."
+ (set-default symbol value)
+ (dolist (buf (buffer-list))
+ (with-current-buffer buf
+ (when (eq major-mode 'stgit-mode)
+ (stgit-reload)))))
+
+(defgroup stgit nil
+ "A user interface for the StGit patch maintenance tool."
+ :group 'tools
+ :link '(function-link stgit)
+ :link '(url-link "http://www.procode.org/stgit/"))
+
+(defcustom stgit-abbreviate-copies-and-renames t
+ "If non-nil, abbreviate copies and renames as \"dir/{old -> new}/file\"
+instead of \"dir/old/file -> dir/new/file\"."
+ :type 'boolean
+ :group 'stgit
+ :set 'stgit-set-default)
+
+(defcustom stgit-default-show-worktree t
+ "Set to non-nil to by default show the working tree in a new stgit buffer.
+
+Use \\<stgit-mode-map>\\[stgit-toggle-worktree] to toggle the this setting in an already-started StGit buffer."
+ :type 'boolean
+ :group 'stgit
+ :link '(variable-link stgit-show-worktree))
+
+(defcustom stgit-find-copies-harder nil
+ "Try harder to find copied files when listing patches.
+
+When not nil, runs git diff-tree with the --find-copies-harder
+flag, which reduces performance."
+ :type 'boolean
+ :group 'stgit
+ :set 'stgit-set-default)
+
+(defcustom stgit-show-worktree-mode 'center
+ "This variable controls where the \"Index\" and \"Work tree\"
+will be shown on in the buffer.
+
+It can be set to 'top (above all patches), 'center (show between
+applied and unapplied patches), and 'bottom (below all patches)."
+ :type '(radio (const :tag "above all patches (top)" top)
+ (const :tag "between applied and unapplied patches (center)"
+ center)
+ (const :tag "below all patches (bottom)" bottom))
+ :group 'stgit
+ :link '(variable-link stgit-show-worktree)
+ :set 'stgit-set-default)
+
+(defface stgit-branch-name-face
+ '((t :inherit bold))
+ "The face used for the StGit branch name"
+ :group 'stgit)
(defface stgit-top-patch-face
'((((background dark)) (:weight bold :foreground "yellow"))
(((background light)) (:weight bold :foreground "purple"))
(t (:weight bold)))
- "The face used for the top patch names")
+ "The face used for the top patch names"
+ :group 'stgit)
(defface stgit-applied-patch-face
'((((background dark)) (:foreground "light yellow"))
(((background light)) (:foreground "purple"))
(t ()))
- "The face used for applied patch names")
+ "The face used for applied patch names"
+ :group 'stgit)
(defface stgit-unapplied-patch-face
'((((background dark)) (:foreground "gray80"))
(((background light)) (:foreground "orchid"))
(t ()))
- "The face used for unapplied patch names")
+ "The face used for unapplied patch names"
+ :group 'stgit)
-(defun stgit-rescan ()
- "Rescan the status buffer."
- (save-excursion
- (let ((marked ()))
- (goto-char (point-min))
- (while (not (eobp))
- (cond ((looking-at "Branch: \\(.*\\)")
- (put-text-property (match-beginning 1) (match-end 1)
- 'face 'bold))
- ((looking-at "\\([>+-]\\)\\( \\)\\([^ ]+\\) *[|#] \\(.*\\)")
- (let ((state (match-string 1))
- (patchsym (intern (match-string 3))))
- (put-text-property
- (match-beginning 3) (match-end 3) 'face
- (cond ((string= state ">") 'stgit-top-patch-face)
- ((string= state "+") 'stgit-applied-patch-face)
- ((string= state "-") 'stgit-unapplied-patch-face)))
- (put-text-property (match-beginning 4) (match-end 4)
- 'face 'stgit-description-face)
- (when (memq patchsym stgit-marked-patches)
- (replace-match "*" nil nil nil 2)
- (setq marked (cons patchsym marked))))))
- (forward-line 1))
- (setq stgit-marked-patches (nreverse marked)))))
+(defface stgit-description-face
+ '((((background dark)) (:foreground "tan"))
+ (((background light)) (:foreground "dark red")))
+ "The face used for StGit descriptions"
+ :group 'stgit)
+
+(defface stgit-index-work-tree-title-face
+ '((((supports :slant italic)) :slant italic)
+ (t :inherit bold))
+ "StGit mode face used for the \"Index\" and \"Work tree\" titles"
+ :group 'stgit)
+
+(defface stgit-unmerged-file-face
+ '((((class color) (background light)) (:foreground "red" :bold t))
+ (((class color) (background dark)) (:foreground "red" :bold t)))
+ "StGit mode face used for unmerged file status"
+ :group 'stgit)
+
+(defface stgit-unknown-file-face
+ '((((class color) (background light)) (:foreground "goldenrod" :bold t))
+ (((class color) (background dark)) (:foreground "goldenrod" :bold t)))
+ "StGit mode face used for unknown file status"
+ :group 'stgit)
+
+(defface stgit-ignored-file-face
+ '((((class color) (background light)) (:foreground "grey60"))
+ (((class color) (background dark)) (:foreground "grey40")))
+ "StGit mode face used for ignored files")
+
+(defface stgit-file-permission-face
+ '((((class color) (background light)) (:foreground "green" :bold t))
+ (((class color) (background dark)) (:foreground "green" :bold t)))
+ "StGit mode face used for permission changes."
+ :group 'stgit)
+
+(defface stgit-modified-file-face
+ '((((class color) (background light)) (:foreground "purple"))
+ (((class color) (background dark)) (:foreground "salmon")))
+ "StGit mode face used for modified file status"
+ :group 'stgit)
+
+(defconst stgit-file-status-code-strings
+ (mapcar (lambda (arg)
+ (cons (car arg)
+ (propertize (cadr arg) 'face (car (cddr arg)))))
+ '((add "Added" stgit-modified-file-face)
+ (copy "Copied" stgit-modified-file-face)
+ (delete "Deleted" stgit-modified-file-face)
+ (modify "Modified" stgit-modified-file-face)
+ (rename "Renamed" stgit-modified-file-face)
+ (mode-change "Mode change" stgit-modified-file-face)
+ (unmerged "Unmerged" stgit-unmerged-file-face)
+ (unknown "Unknown" stgit-unknown-file-face)
+ (ignore "Ignored" stgit-ignored-file-face)))
+ "Alist of code symbols to description strings")
+
+(defconst stgit-patch-status-face-alist
+ '((applied . stgit-applied-patch-face)
+ (top . stgit-top-patch-face)
+ (unapplied . stgit-unapplied-patch-face)
+ (index . stgit-index-work-tree-title-face)
+ (work . stgit-index-work-tree-title-face))
+ "Alist of face to use for a given patch status")
+
+(defun stgit-file-status-code-as-string (file)
+ "Return stgit status code for FILE as a string"
+ (let* ((code (assq (stgit-file-status file)
+ stgit-file-status-code-strings))
+ (score (stgit-file-cr-score file)))
+ (when code
+ (format "%-11s "
+ (if (and score (/= score 100))
+ (format "%s %s" (cdr code)
+ (propertize (format "%d%%" score)
+ 'face 'stgit-description-face))
+ (cdr code))))))
+
+(defun stgit-file-status-code (str &optional score)
+ "Return stgit status code from git status string"
+ (let ((code (assoc str '(("A" . add)
+ ("C" . copy)
+ ("D" . delete)
+ ("I" . ignore)
+ ("M" . modify)
+ ("R" . rename)
+ ("T" . mode-change)
+ ("U" . unmerged)
+ ("X" . unknown)))))
+ (setq code (if code (cdr code) 'unknown))
+ (when (stringp score)
+ (if (> (length score) 0)
+ (setq score (string-to-number score))
+ (setq score nil)))
+ (if score (cons code score) code)))
+
+(defconst stgit-file-type-strings
+ '((#o100 . "file")
+ (#o120 . "symlink")
+ (#o160 . "subproject"))
+ "Alist of names of file types")
+
+(defun stgit-file-type-string (type)
+ "Return string describing file type TYPE (the high bits of file permission).
+Cf. `stgit-file-type-strings' and `stgit-file-type-change-string'."
+ (let ((type-str (assoc type stgit-file-type-strings)))
+ (or (and type-str (cdr type-str))
+ (format "unknown type %o" type))))
+
+(defun stgit-file-type-change-string (old-perm new-perm)
+ "Return string describing file type change from OLD-PERM to NEW-PERM.
+Cf. `stgit-file-type-string'."
+ (let ((old-type (lsh old-perm -9))
+ (new-type (lsh new-perm -9)))
+ (cond ((= old-type new-type) "")
+ ((zerop new-type) "")
+ ((zerop old-type)
+ (if (= new-type #o100)
+ ""
+ (format " (%s)" (stgit-file-type-string new-type))))
+ (t (format " (%s -> %s)"
+ (stgit-file-type-string old-type)
+ (stgit-file-type-string new-type))))))
+
+(defun stgit-file-mode-change-string (old-perm new-perm)
+ "Return string describing file mode change from OLD-PERM to NEW-PERM.
+Cf. `stgit-file-type-change-string'."
+ (setq old-perm (logand old-perm #o777)
+ new-perm (logand new-perm #o777))
+ (if (or (= old-perm new-perm)
+ (zerop old-perm)
+ (zerop new-perm))
+ ""
+ (let* ((modified (logxor old-perm new-perm))
+ (not-x-modified (logand (logxor old-perm new-perm) #o666)))
+ (cond ((zerop modified) "")
+ ((and (zerop not-x-modified)
+ (or (and (eq #o111 (logand old-perm #o111))
+ (propertize "-x" 'face 'stgit-file-permission-face))
+ (and (eq #o111 (logand new-perm #o111))
+ (propertize "+x" 'face
+ 'stgit-file-permission-face)))))
+ (t (concat (propertize (format "%o" old-perm)
+ 'face 'stgit-file-permission-face)
+ (propertize " -> "
+ 'face 'stgit-description-face)
+ (propertize (format "%o" new-perm)
+ 'face 'stgit-file-permission-face)))))))
+
+(defstruct (stgit-file)
+ old-perm new-perm copy-or-rename cr-score cr-from cr-to status file)
+
+(defun stgit-describe-copy-or-rename (file)
+ (let ((arrow (concat " " (propertize "->" 'face 'stgit-description-face) " "))
+ from to common-head common-tail)
+
+ (when stgit-abbreviate-copies-and-renames
+ (setq from (split-string (stgit-file-cr-from file) "/")
+ to (split-string (stgit-file-cr-to file) "/"))
+
+ (while (and from to (cdr from) (cdr to)
+ (string-equal (car from) (car to)))
+ (setq common-head (cons (car from) common-head)
+ from (cdr from)
+ to (cdr to)))
+ (setq common-head (nreverse common-head)
+ from (nreverse from)
+ to (nreverse to))
+ (while (and from to (cdr from) (cdr to)
+ (string-equal (car from) (car to)))
+ (setq common-tail (cons (car from) common-tail)
+ from (cdr from)
+ to (cdr to)))
+ (setq from (nreverse from)
+ to (nreverse to)))
+
+ (if (or common-head common-tail)
+ (concat (if common-head
+ (mapconcat #'identity common-head "/")
+ "")
+ (if common-head "/" "")
+ (propertize "{" 'face 'stgit-description-face)
+ (mapconcat #'identity from "/")
+ arrow
+ (mapconcat #'identity to "/")
+ (propertize "}" 'face 'stgit-description-face)
+ (if common-tail "/" "")
+ (if common-tail
+ (mapconcat #'identity common-tail "/")
+ ""))
+ (concat (stgit-file-cr-from file) arrow (stgit-file-cr-to file)))))
+
+(defun stgit-file-pp (file)
+ (let ((status (stgit-file-status file))
+ (name (if (stgit-file-copy-or-rename file)
+ (stgit-describe-copy-or-rename file)
+ (stgit-file-file file)))
+ (mode-change (stgit-file-mode-change-string
+ (stgit-file-old-perm file)
+ (stgit-file-new-perm file)))
+ (start (point)))
+ (insert (format " %-12s%s%s%s%s\n"
+ (stgit-file-status-code-as-string file)
+ mode-change
+ (if (zerop (length mode-change)) "" " ")
+ name
+ (propertize (stgit-file-type-change-string
+ (stgit-file-old-perm file)
+ (stgit-file-new-perm file))
+ 'face 'stgit-description-face)))
+ (add-text-properties start (point)
+ (list 'entry-type 'file
+ 'file-data file))))
+
+(defun stgit-find-copies-harder-diff-arg ()
+ "Return the flag to use with `git-diff' depending on the
+`stgit-find-copies-harder' flag."
+ (if stgit-find-copies-harder "--find-copies-harder" "-C"))
+
+(defun stgit-insert-ls-files (args file-flag)
+ (let ((start (point)))
+ (apply 'stgit-run-git
+ (append '("ls-files" "--exclude-standard" "-z") args))
+ (goto-char start)
+ (while (looking-at "\\([^\0]*\\)\0")
+ (let ((name-len (- (match-end 0) (match-beginning 0))))
+ (insert ":0 0 0000000000000000000000000000000000000000 0000000000000000000000000000000000000000 " file-flag "\0")
+ (forward-char name-len)))))
+
+(defun stgit-insert-patch-files (patch)
+ "Expand (show modification of) the patch PATCH after the line
+at point."
+ (let* ((patchsym (stgit-patch-name patch))
+ (end (point-marker))
+ (args (list "-z" (stgit-find-copies-harder-diff-arg)))
+ (ewoc (ewoc-create #'stgit-file-pp nil nil t)))
+ (set-marker-insertion-type end t)
+ (setf (stgit-patch-files-ewoc patch) ewoc)
+ (with-temp-buffer
+ (let ((standard-output (current-buffer)))
+ (apply 'stgit-run-git
+ (cond ((eq patchsym :work)
+ `("diff-files" "-0" ,@args))
+ ((eq patchsym :index)
+ `("diff-index" ,@args "--cached" "HEAD"))
+ (t
+ `("diff-tree" ,@args "-r" ,(stgit-id patchsym)))))
+
+ (when (and (eq patchsym :work))
+ (when stgit-show-ignored
+ (stgit-insert-ls-files '("--ignored" "--others") "I"))
+ (when stgit-show-unknown
+ (stgit-insert-ls-files '("--others") "X"))
+ (sort-regexp-fields nil ":[^\0]*\0\\([^\0]*\\)\0" "\\1"
+ (point-min) (point-max)))
+
+ (goto-char (point-min))
+ (unless (or (eobp) (memq patchsym '(:work :index)))
+ (forward-char 41))
+ (while (looking-at ":\\([0-7]+\\) \\([0-7]+\\) [0-9A-Fa-f]\\{40\\} [0-9A-Fa-f]\\{40\\} ")
+ (let ((old-perm (string-to-number (match-string 1) 8))
+ (new-perm (string-to-number (match-string 2) 8)))
+ (goto-char (match-end 0))
+ (let ((file
+ (cond ((looking-at
+ "\\([CR]\\)\\([0-9]*\\)\0\\([^\0]*\\)\0\\([^\0]*\\)\0")
+ (let* ((patch-status (stgit-patch-status patch))
+ (file-subexp (if (eq patch-status 'unapplied)
+ 3
+ 4))
+ (file (match-string file-subexp)))
+ (make-stgit-file
+ :old-perm old-perm
+ :new-perm new-perm
+ :copy-or-rename t
+ :cr-score (string-to-number (match-string 2))
+ :cr-from (match-string 3)
+ :cr-to (match-string 4)
+ :status (stgit-file-status-code
+ (match-string 1))
+ :file file)))
+ ((looking-at "\\([ABD-QS-Z]\\)\0\\([^\0]*\\)\0")
+ (make-stgit-file
+ :old-perm old-perm
+ :new-perm new-perm
+ :copy-or-rename nil
+ :cr-score nil
+ :cr-from nil
+ :cr-to nil
+ :status (stgit-file-status-code
+ (match-string 1))
+ :file (match-string 2))))))
+ (goto-char (match-end 0))
+ (ewoc-enter-last ewoc file))))
+
+ (unless (ewoc-nth ewoc 0)
+ (ewoc-set-hf ewoc ""
+ (concat " "
+ (propertize "<no files>"
+ 'face 'stgit-description-face)
+ "\n")))))
+ (goto-char end)))
+
+(defun stgit-find-file (&optional other-window)
+ (let* ((file (or (stgit-patched-file-at-point)
+ (error "No file at point")))
+ (filename (expand-file-name (stgit-file-file file))))
+ (unless (file-exists-p filename)
+ (error "File does not exist"))
+ (funcall (if other-window 'find-file-other-window 'find-file)
+ filename)
+ (when (eq (stgit-file-status file) 'unmerged)
+ (smerge-mode 1))))
+
+(defun stgit-expand (&optional patches collapse)
+ "Show the contents of marked patches, or the patch at point.
+
+See also `stgit-collapse'.
+
+Non-interactively, operate on PATCHES, and collapse instead of
+expand if COLLAPSE is not nil."
+ (interactive (list (stgit-patches-marked-or-at-point t)))
+ (stgit-assert-mode)
+ (let ((patches-diff (funcall (if collapse #'intersection #'set-difference)
+ patches stgit-expanded-patches)))
+ (setq stgit-expanded-patches
+ (if collapse
+ (set-difference stgit-expanded-patches patches-diff)
+ (append stgit-expanded-patches patches-diff)))
+ (ewoc-map #'(lambda (patch)
+ (memq (stgit-patch-name patch) patches-diff))
+ stgit-ewoc))
+ (move-to-column (stgit-goal-column)))
+
+(defun stgit-collapse (&optional patches)
+ "Hide the contents of marked patches, or the patch at point.
+
+See also `stgit-expand'."
+ (interactive (list (stgit-patches-marked-or-at-point t)))
+ (stgit-assert-mode)
+ (stgit-expand patches t))
+
+(defun stgit-select-patch ()
+ (let ((patchname (stgit-patch-name-at-point)))
+ (stgit-expand (list patchname)
+ (memq patchname stgit-expanded-patches))))
+
+(defun stgit-select ()
+ "With point on a patch, toggle showing files in the patch.
+
+With point on a file, open the associated file. Opens the target
+file for (applied) copies and renames."
+ (interactive)
+ (stgit-assert-mode)
+ (case (get-text-property (point) 'entry-type)
+ ('patch
+ (stgit-select-patch))
+ ('file
+ (stgit-find-file))
+ (t
+ (error "No patch or file on line"))))
+
+(defun stgit-find-file-other-window ()
+ "Open file at point in other window"
+ (interactive)
+ (stgit-assert-mode)
+ (stgit-find-file t))
+
+(defun stgit-find-file-merge ()
+ "Open file at point and merge it using `smerge-ediff'."
+ (interactive)
+ (stgit-assert-mode)
+ (stgit-find-file t)
+ (smerge-ediff))
+
+(defun stgit-quit ()
+ "Hide the stgit buffer."
+ (interactive)
+ (stgit-assert-mode)
+ (bury-buffer))
+
+(defun stgit-git-status ()
+ "Show status using `git-status'."
+ (interactive)
+ (stgit-assert-mode)
+ (unless (fboundp 'git-status)
+ (error "The stgit-git-status command requires git-status"))
+ (let ((dir default-directory))
+ (save-selected-window
+ (pop-to-buffer nil)
+ (git-status dir))))
+
+(defun stgit-goal-column ()
+ "Return goal column for the current line"
+ (case (get-text-property (point) 'entry-type)
+ ('patch 2)
+ ('file 4)
+ (t 0)))
+
+(defun stgit-next-line (&optional arg)
+ "Move cursor vertically down ARG lines"
+ (interactive "p")
+ (stgit-assert-mode)
+ (next-line arg)
+ (move-to-column (stgit-goal-column)))
+
+(defun stgit-previous-line (&optional arg)
+ "Move cursor vertically up ARG lines"
+ (interactive "p")
+ (stgit-assert-mode)
+ (previous-line arg)
+ (move-to-column (stgit-goal-column)))
+
+(defun stgit-next-patch (&optional arg)
+ "Move cursor down ARG patches."
+ (interactive "p")
+ (stgit-assert-mode)
+ (ewoc-goto-next stgit-ewoc (or arg 1))
+ (move-to-column goal-column))
+
+(defun stgit-previous-patch (&optional arg)
+ "Move cursor up ARG patches."
+ (interactive "p")
+ (stgit-assert-mode)
+ (ewoc-goto-prev stgit-ewoc (or arg 1))
+ (move-to-column goal-column))
(defvar stgit-mode-hook nil
"Run after `stgit-mode' is setup.")
"Keymap for StGit major mode.")
(unless stgit-mode-map
- (setq stgit-mode-map (make-keymap))
- (suppress-keymap stgit-mode-map)
- (define-key stgit-mode-map " " 'stgit-mark)
- (define-key stgit-mode-map "\d" 'stgit-unmark)
- (define-key stgit-mode-map "?" 'stgit-help)
- (define-key stgit-mode-map "h" 'stgit-help)
- (define-key stgit-mode-map "p" 'previous-line)
- (define-key stgit-mode-map "n" 'next-line)
- (define-key stgit-mode-map "g" 'stgit-refresh)
- (define-key stgit-mode-map "r" 'stgit-rename)
- (define-key stgit-mode-map "e" 'stgit-edit)
- (define-key stgit-mode-map "c" 'stgit-coalesce)
- (define-key stgit-mode-map "N" 'stgit-new)
- (define-key stgit-mode-map "R" 'stgit-repair)
- (define-key stgit-mode-map "C" 'stgit-commit)
- (define-key stgit-mode-map "U" 'stgit-uncommit)
- (define-key stgit-mode-map ">" 'stgit-push-next)
- (define-key stgit-mode-map "<" 'stgit-pop-next)
- (define-key stgit-mode-map "P" 'stgit-push-or-pop)
- (define-key stgit-mode-map "G" 'stgit-goto)
- (define-key stgit-mode-map "=" 'stgit-show)
- (define-key stgit-mode-map "D" 'stgit-delete))
+ (let ((diff-map (make-sparse-keymap))
+ (toggle-map (make-sparse-keymap)))
+ (suppress-keymap diff-map)
+ (mapc (lambda (arg) (define-key diff-map (car arg) (cdr arg)))
+ '(("b" . stgit-diff-base)
+ ("c" . stgit-diff-combined)
+ ("m" . stgit-find-file-merge)
+ ("o" . stgit-diff-ours)
+ ("t" . stgit-diff-theirs)))
+ (suppress-keymap toggle-map)
+ (mapc (lambda (arg) (define-key toggle-map (car arg) (cdr arg)))
+ '(("t" . stgit-toggle-worktree)
+ ("i" . stgit-toggle-ignored)
+ ("u" . stgit-toggle-unknown)))
+ (setq stgit-mode-map (make-keymap))
+ (suppress-keymap stgit-mode-map)
+ (mapc (lambda (arg) (define-key stgit-mode-map (car arg) (cdr arg)))
+ `((" " . stgit-mark-down)
+ ("m" . stgit-mark-down)
+ ("\d" . stgit-unmark-up)
+ ("u" . stgit-unmark-down)
+ ("?" . stgit-help)
+ ("h" . stgit-help)
+ ("\C-p" . stgit-previous-line)
+ ("\C-n" . stgit-next-line)
+ ([up] . stgit-previous-line)
+ ([down] . stgit-next-line)
+ ("p" . stgit-previous-patch)
+ ("n" . stgit-next-patch)
+ ("\M-{" . stgit-previous-patch)
+ ("\M-}" . stgit-next-patch)
+ ("s" . stgit-git-status)
+ ("g" . stgit-reload-or-repair)
+ ("r" . stgit-refresh)
+ ("\C-c\C-r" . stgit-rename)
+ ("e" . stgit-edit)
+ ("M" . stgit-move-patches)
+ ("S" . stgit-squash)
+ ("N" . stgit-new)
+ ("c" . stgit-new-and-refresh)
+ ("\C-c\C-c" . stgit-commit)
+ ("\C-c\C-u" . stgit-uncommit)
+ ("U" . stgit-revert)
+ ("R" . stgit-resolve-file)
+ ("\r" . stgit-select)
+ ("+" . stgit-expand)
+ ("-" . stgit-collapse)
+ ("o" . stgit-find-file-other-window)
+ ("i" . stgit-toggle-index)
+ (">" . stgit-push-next)
+ ("<" . stgit-pop-next)
+ ("P" . stgit-push-or-pop)
+ ("G" . stgit-goto)
+ ("=" . stgit-diff)
+ ("D" . stgit-delete)
+ ([?\C-/] . stgit-undo)
+ ("\C-_" . stgit-undo)
+ ([?\C-c ?\C-/] . stgit-redo)
+ ("\C-c\C-_" . stgit-redo)
+ ("B" . stgit-branch)
+ ("\C-c\C-b" . stgit-rebase)
+ ("t" . ,toggle-map)
+ ("d" . ,diff-map)
+ ("q" . stgit-quit))))
+
+ (let ((at-unmerged-file '(let ((file (stgit-patched-file-at-point)))
+ (and file (eq (stgit-file-status file)
+ 'unmerged))))
+ (patch-collapsed-p '(lambda (p) (not (memq p stgit-expanded-patches)))))
+ (easy-menu-define stgit-menu stgit-mode-map
+ "StGit Menu"
+ `("StGit"
+ ["Reload" stgit-reload-or-repair
+ :help "Reload StGit status from disk"]
+ ["Repair" stgit-repair
+ :keys "\\[universal-argument] \\[stgit-reload-or-repair]"
+ :help "Repair StGit metadata"]
+ "-"
+ ["Undo" stgit-undo t]
+ ["Redo" stgit-redo t]
+ "-"
+ ["Git status" stgit-git-status :active (fboundp 'git-status)]
+ "-"
+ ["New patch" stgit-new-and-refresh
+ :help "Create a new patch from changes in index or work tree"
+ :active (not (and (stgit-index-empty-p) (stgit-work-tree-empty-p)))]
+ ["New empty patch" stgit-new
+ :help "Create a new, empty patch"]
+ ["(Un)mark patch" stgit-toggle-mark
+ :label (if (memq (stgit-patch-name-at-point nil t)
+ stgit-marked-patches)
+ "Unmark patch" "Mark patch")
+ :active (stgit-patch-name-at-point nil t)]
+ ["Expand/collapse patch"
+ (let ((patches (stgit-patches-marked-or-at-point)))
+ (if (member-if ,patch-collapsed-p patches)
+ (stgit-expand patches)
+ (stgit-collapse patches)))
+ :label (if (member-if ,patch-collapsed-p
+ (stgit-patches-marked-or-at-point))
+ "Expand patches"
+ "Collapse patches")
+ :active (stgit-patches-marked-or-at-point)]
+ ["Edit patch" stgit-edit
+ :help "Edit patch comment"
+ :active (stgit-patch-name-at-point nil t)]
+ ["Rename patch" stgit-rename :active (stgit-patch-name-at-point nil t)]
+ ["Push/pop patch" stgit-push-or-pop
+ :label (if (subsetp (stgit-patches-marked-or-at-point nil t)
+ (stgit-applied-patchsyms t))
+ "Pop patches" "Push patches")]
+ ["Delete patches" stgit-delete
+ :active (stgit-patches-marked-or-at-point nil t)]
+ "-"
+ ["Move patches" stgit-move-patches
+ :active stgit-marked-patches
+ :help "Move marked patch(es) to point"]
+ ["Squash patches" stgit-squash
+ :active (> (length stgit-marked-patches) 1)
+ :help "Merge marked patches into one"]
+ "-"
+ ["Refresh top patch" stgit-refresh
+ :active (not (and (stgit-index-empty-p) (stgit-work-tree-empty-p)))
+ :help "Refresh the top patch with changes in index or work tree"]
+ ["Refresh this patch" (stgit-refresh t)
+ :keys "\\[universal-argument] \\[stgit-refresh]"
+ :help "Refresh marked patch with changes in index or work tree"
+ :active (and (not (and (stgit-index-empty-p)
+ (stgit-work-tree-empty-p)))
+ (stgit-patch-name-at-point nil t))]
+ "-"
+ ["Find file" stgit-select
+ :active (eq (get-text-property (point) 'entry-type) 'file)]
+ ["Open file" stgit-find-file-other-window
+ :active (eq (get-text-property (point) 'entry-type) 'file)]
+ ["Toggle file index" stgit-toggle-index
+ :active (and (eq (get-text-property (point) 'entry-type) 'file)
+ (memq (stgit-patch-name-at-point) '(:work :index)))
+ :label (if (eq (stgit-patch-name-at-point) :work)
+ "Move change to index"
+ "Move change to work tree")]
+ "-"
+ ["Show diff" stgit-diff
+ :active (get-text-property (point) 'entry-type)]
+ ("Merge"
+ :active (stgit-git-index-unmerged-p)
+ ["Combined diff" stgit-diff-combined
+ :active (memq (stgit-patch-name-at-point nil nil) '(:work :index))]
+ ["Diff against base" stgit-diff-base
+ :help "Show diff against the common base"
+ :active (memq (stgit-patch-name-at-point nil nil) '(:work :index))]
+ ["Diff against ours" stgit-diff-ours
+ :help "Show diff against our branch"
+ :active (memq (stgit-patch-name-at-point nil nil) '(:work :index))]
+ ["Diff against theirs" stgit-diff-theirs
+ :help "Show diff against their branch"
+ :active (memq (stgit-patch-name-at-point nil nil) '(:work :index))]
+ "-"
+ ["Interactive merge" stgit-find-file-merge
+ :help "Interactively merge the file"
+ :active ,at-unmerged-file]
+ ["Resolve file" stgit-resolve-file
+ :help "Mark file conflict as resolved"
+ :active ,at-unmerged-file]
+ )
+ "-"
+ ["Show index & work tree" stgit-toggle-worktree :style toggle
+ :selected stgit-show-worktree]
+ ["Show unknown files" stgit-toggle-unknown :style toggle
+ :selected stgit-show-unknown :active stgit-show-worktree]
+ ["Show ignored files" stgit-toggle-ignored :style toggle
+ :selected stgit-show-ignored :active stgit-show-worktree]
+ "-"
+ ["Switch branches" stgit-branch t
+ :help "Switch to another branch"]
+ ["Rebase branch" stgit-rebase t
+ :help "Rebase the current branch"]
+ ))))
+
+;; disable tool bar editing buttons
+(put 'stgit-mode 'mode-class 'special)
(defun stgit-mode ()
"Major mode for interacting with StGit.
-Commands:
-\\{stgit-mode-map}"
+
+Start StGit using \\[stgit].
+
+Basic commands:
+\\<stgit-mode-map>\
+\\[stgit-help] Show this help text
+\\[stgit-quit] Hide the StGit buffer
+\\[describe-bindings] Show all key bindings
+
+\\[stgit-reload-or-repair] Reload the StGit buffer
+\\[universal-argument] \\[stgit-reload-or-repair] Repair StGit metadata
+
+\\[stgit-undo] Undo most recent StGit operation
+\\[stgit-redo] Undo recent undo
+
+\\[stgit-git-status] Run `git-status' (if available)
+
+Movement commands:
+\\[stgit-previous-line] Move to previous line
+\\[stgit-next-line] Move to next line
+\\[stgit-previous-patch] Move to previous patch
+\\[stgit-next-patch] Move to next patch
+
+\\[stgit-mark-down] Mark patch and move down
+\\[stgit-unmark-up] Unmark patch and move up
+\\[stgit-unmark-down] Unmark patch and move down
+
+Commands for patches:
+\\[stgit-select] Toggle showing changed files in patch
+\\[stgit-refresh] Refresh patch with changes in index or work tree
+\\[stgit-diff] Show the patch log and diff
+
+\\[stgit-expand] Show changes in marked patches
+\\[stgit-collapse] Hide changes in marked patches
+
+\\[stgit-new-and-refresh] Create a new patch from index or work tree
+\\[stgit-new] Create a new, empty patch
+
+\\[stgit-rename] Rename patch
+\\[stgit-edit] Edit patch description
+\\[stgit-delete] Delete patch(es)
+
+\\[stgit-revert] Revert all changes in index or work tree
+\\[stgit-toggle-index] Toggle all changes between index and work tree
+
+\\[stgit-push-next] Push next patch onto stack
+\\[stgit-pop-next] Pop current patch from stack
+\\[stgit-push-or-pop] Push or pop marked patches
+\\[stgit-goto] Make patch at point current by popping or pushing
+
+\\[stgit-squash] Squash (meld together) patches
+\\[stgit-move-patches] Move marked patches to point
+
+\\[stgit-commit] Commit patch(es)
+\\[stgit-uncommit] Uncommit patch(es)
+
+Commands for files:
+\\[stgit-select] Open the file in this window
+\\[stgit-find-file-other-window] Open the file in another window
+\\[stgit-diff] Show the file's diff
+
+\\[stgit-toggle-index] Toggle change between index and work tree
+\\[stgit-revert] Revert changes to file
+
+Display commands:
+\\[stgit-toggle-worktree] Toggle showing index and work tree
+\\[stgit-toggle-unknown] Toggle showing unknown files
+\\[stgit-toggle-ignored] Toggle showing ignored files
+
+Commands for diffs:
+\\[stgit-diff] Show diff of patch or file
+\\[stgit-diff-base] Show diff against the merge base
+\\[stgit-diff-ours] Show diff against our branch
+\\[stgit-diff-theirs] Show diff against their branch
+
+ With one prefix argument (e.g., \\[universal-argument] \\[stgit-diff]), \
+ignore space changes.
+ With two prefix arguments (e.g., \\[universal-argument] \
+\\[universal-argument] \\[stgit-diff]), ignore all space changes.
+
+Commands for merge conflicts:
+\\[stgit-find-file-merge] Resolve conflicts using `smerge-ediff'
+\\[stgit-resolve-file] Mark unmerged file as resolved
+
+Commands for branches:
+\\[stgit-branch] Switch to another branch
+\\[stgit-rebase] Rebase the current branch
+
+Customization variables:
+`stgit-abbreviate-copies-and-renames'
+`stgit-default-show-worktree'
+`stgit-find-copies-harder'
+`stgit-show-worktree-mode'
+
+See also \\[customize-group] for the \"stgit\" group."
(kill-all-local-variables)
(buffer-disable-undo)
(setq mode-name "StGit"
(use-local-map stgit-mode-map)
(set (make-local-variable 'list-buffers-directory) default-directory)
(set (make-local-variable 'stgit-marked-patches) nil)
+ (set (make-local-variable 'stgit-expanded-patches) (list :work :index))
+ (set (make-local-variable 'stgit-show-worktree) stgit-default-show-worktree)
+ (set (make-local-variable 'stgit-index-node) nil)
+ (set (make-local-variable 'stgit-worktree-node) nil)
+ (set (make-local-variable 'parse-sexp-lookup-properties) t)
(set-variable 'truncate-lines 't)
+ (add-hook 'after-save-hook 'stgit-update-saved-file)
(run-hooks 'stgit-mode-hook))
-(defun stgit-add-mark (patch)
- (let ((patchsym (intern patch)))
- (setq stgit-marked-patches (cons patchsym stgit-marked-patches))))
+(defun stgit-update-saved-file ()
+ (let* ((file (expand-file-name buffer-file-name))
+ (dir (file-name-directory file))
+ (gitdir (condition-case nil (git-get-top-dir dir)
+ (error nil)))
+ (buffer (and gitdir (stgit-find-buffer gitdir))))
+ (when buffer
+ (with-current-buffer buffer
+ (stgit-refresh-worktree)))))
-(defun stgit-remove-mark (patch)
- (let ((patchsym (intern patch)))
- (setq stgit-marked-patches (delq patchsym stgit-marked-patches))))
+(defun stgit-add-mark (patchsym)
+ "Mark the patch PATCHSYM."
+ (setq stgit-marked-patches (cons patchsym stgit-marked-patches)))
-(defun stgit-marked-patches ()
- "Return the names of the marked patches."
- (mapcar 'symbol-name stgit-marked-patches))
+(defun stgit-remove-mark (patchsym)
+ "Unmark the patch PATCHSYM."
+ (setq stgit-marked-patches (delq patchsym stgit-marked-patches)))
-(defun stgit-patch-at-point ()
- "Return the patch name on the current line"
- (save-excursion
- (beginning-of-line)
- (if (looking-at "[>+-][ *]\\([^ ]*\\)")
- (match-string-no-properties 1)
- nil)))
+(defun stgit-clear-marks ()
+ "Unmark all patches."
+ (setq stgit-marked-patches '()))
-(defun stgit-patches-marked-or-at-point ()
- "Return the names of the marked patches, or the patch on the current line."
+(defun stgit-patch-at-point (&optional cause-error)
+ (get-text-property (point) 'patch-data))
+
+(defun stgit-patch-name-at-point (&optional cause-error only-patches)
+ "Return the patch name on the current line as a symbol.
+If CAUSE-ERROR is not nil, signal an error if none found.
+If ONLY-PATCHES is not nil, only allow real patches, and not
+index or work tree."
+ (let ((patch (stgit-patch-at-point)))
+ (and patch
+ only-patches
+ (memq (stgit-patch-status patch) '(work index))
+ (setq patch nil))
+ (cond (patch
+ (stgit-patch-name patch))
+ (cause-error
+ (error "No patch on this line")))))
+
+(defun stgit-patched-file-at-point ()
+ (get-text-property (point) 'file-data))
+
+(defun stgit-patches-marked-or-at-point (&optional cause-error only-patches)
+ "Return the symbols of the marked patches, or the patch on the current line.
+If CAUSE-ERRROR is not nil, signal an error if none found.
+If ONLY-PATCHES is not nil, do not include index or work tree."
(if stgit-marked-patches
- (stgit-marked-patches)
- (let ((patch (stgit-patch-at-point)))
- (if patch
- (list patch)
- '()))))
-
-(defun stgit-goto-patch (patch)
- "Move point to the line containing PATCH"
- (let ((p (point)))
- (goto-char (point-min))
- (if (re-search-forward (concat "^[>+-][ *]" (regexp-quote patch) " ") nil t)
- (progn (move-to-column goal-column)
- t)
- (goto-char p)
- nil)))
+ stgit-marked-patches
+ (let ((patch (stgit-patch-name-at-point nil only-patches)))
+ (cond (patch (list patch))
+ (cause-error (error "No patches marked or at this line"))
+ (t nil)))))
+
+(defun stgit-goto-patch (patchsym &optional file)
+ "Move point to the line containing patch PATCHSYM.
+If that patch cannot be found, do nothing.
+
+If the patch was found and FILE is not nil, instead move to that
+file's line. If FILE cannot be found, stay on the line of
+PATCHSYM."
+ (let ((node (ewoc-nth stgit-ewoc 0)))
+ (while (and node (not (eq (stgit-patch-name (ewoc-data node))
+ patchsym)))
+ (setq node (ewoc-next stgit-ewoc node)))
+ (when (and node file)
+ (let* ((file-ewoc (stgit-patch-files-ewoc (ewoc-data node)))
+ (file-node (ewoc-nth file-ewoc 0)))
+ (while (and file-node (not (equal (stgit-file-file (ewoc-data file-node)) file)))
+ (setq file-node (ewoc-next file-ewoc file-node)))
+ (when file-node
+ (ewoc-goto-node file-ewoc file-node)
+ (move-to-column (stgit-goal-column))
+ (setq node nil))))
+ (when node
+ (ewoc-goto-node stgit-ewoc node)
+ (move-to-column goal-column))))
+
+(defun stgit-init ()
+ "Run stg init."
+ (interactive)
+ (stgit-assert-mode)
+ (stgit-capture-output nil
+ (stgit-run "init"))
+ (stgit-reload))
+
+(defun stgit-toggle-mark ()
+ "Toggle mark on the patch under point."
+ (interactive)
+ (stgit-assert-mode)
+ (if (memq (stgit-patch-name-at-point t t) stgit-marked-patches)
+ (stgit-unmark)
+ (stgit-mark)))
(defun stgit-mark ()
- "Mark the patch under point"
+ "Mark the patch under point."
(interactive)
- (let ((patch (stgit-patch-at-point)))
- (stgit-add-mark patch)
- (stgit-refresh))
- (next-line))
+ (stgit-assert-mode)
+ (let* ((node (ewoc-locate stgit-ewoc))
+ (patch (ewoc-data node))
+ (name (stgit-patch-name patch)))
+ (when (eq name :work)
+ (error "Cannot mark the work tree"))
+ (when (eq name :index)
+ (error "Cannot mark the index"))
+ (stgit-add-mark (stgit-patch-name patch))
+ (let ((column (current-column)))
+ (ewoc-invalidate stgit-ewoc node)
+ (move-to-column column))))
+
+(defun stgit-mark-down ()
+ "Mark the patch under point and move to the next patch."
+ (interactive)
+ (stgit-mark)
+ (stgit-next-patch))
(defun stgit-unmark ()
- "Mark the patch on the previous line"
+ "Remove mark from the patch on the current line."
(interactive)
- (forward-line -1)
- (let ((patch (stgit-patch-at-point)))
- (stgit-remove-mark patch)
- (stgit-refresh)))
+ (stgit-assert-mode)
+ (let* ((node (ewoc-locate stgit-ewoc))
+ (patch (ewoc-data node)))
+ (stgit-remove-mark (stgit-patch-name patch))
+ (let ((column (current-column)))
+ (ewoc-invalidate stgit-ewoc node)
+ (move-to-column column))))
+
+(defun stgit-unmark-up ()
+ "Remove mark from the patch on the previous line."
+ (interactive)
+ (stgit-assert-mode)
+ (stgit-previous-patch)
+ (stgit-unmark))
+
+(defun stgit-unmark-down ()
+ "Remove mark from the patch on the current line."
+ (interactive)
+ (stgit-assert-mode)
+ (stgit-unmark)
+ (stgit-next-patch))
(defun stgit-rename (name)
- "Rename the patch under point"
- (interactive (list (read-string "Patch name: " (stgit-patch-at-point))))
- (let ((old-name (stgit-patch-at-point)))
- (unless old-name
- (error "No patch on this line"))
+ "Rename the patch under point to NAME."
+ (interactive (list
+ (read-string "Patch name: "
+ (symbol-name (stgit-patch-name-at-point t t)))))
+ (stgit-assert-mode)
+ (let ((old-patchsym (stgit-patch-name-at-point t t)))
(stgit-capture-output nil
- (stgit-run "rename" old-name name))
- (stgit-refresh)
- (stgit-goto-patch name)))
+ (stgit-run "rename" old-patchsym name))
+ (let ((name-sym (intern name)))
+ (when (memq old-patchsym stgit-expanded-patches)
+ (setq stgit-expanded-patches
+ (cons name-sym (delq old-patchsym stgit-expanded-patches))))
+ (when (memq old-patchsym stgit-marked-patches)
+ (setq stgit-marked-patches
+ (cons name-sym (delq old-patchsym stgit-marked-patches))))
+ (stgit-reload)
+ (stgit-goto-patch name-sym))))
+
+(defun stgit-reload-or-repair (repair)
+ "Update the contents of the StGit buffer (`stgit-reload').
+
+With a prefix argument, repair the StGit metadata if the branch
+was modified with git commands (`stgit-repair')."
+ (interactive "P")
+ (stgit-assert-mode)
+ (if repair
+ (stgit-repair)
+ (stgit-reload)))
(defun stgit-repair ()
- "Run stg repair"
+ "Run stg repair."
(interactive)
+ (stgit-assert-mode)
(stgit-capture-output nil
- (stgit-run "repair"))
- (stgit-refresh))
+ (stgit-run "repair"))
+ (stgit-reload))
-(defun stgit-commit ()
- "Run stg commit."
- (interactive)
- (stgit-capture-output nil (stgit-run "commit"))
- (stgit-refresh))
+(defun stgit-available-branches ()
+ "Returns a list of the available stg branches"
+ (let ((output (with-output-to-string
+ (stgit-run "branch" "--list")))
+ (start 0)
+ result)
+ (while (string-match "^>?\\s-+s\\s-+\\(\\S-+\\)" output start)
+ (setq result (cons (match-string 1 output) result))
+ (setq start (match-end 0)))
+ result))
+
+(defun stgit-branch (branch)
+ "Switch to branch BRANCH."
+ (interactive (list (completing-read "Switch to branch: "
+ (stgit-available-branches))))
+ (stgit-assert-mode)
+ (stgit-capture-output nil (stgit-run "branch" "--" branch))
+ (stgit-reload))
+
+(defun stgit-available-refs (&optional omit-stgit)
+ "Returns a list of the available git refs.
+If OMIT-STGIT is not nil, filter out \"resf/heads/*.stgit\"."
+ (let* ((output (with-output-to-string
+ (stgit-run-git-silent "for-each-ref" "--format=%(refname)"
+ "refs/tags" "refs/heads"
+ "refs/remotes")))
+ (result (split-string output "\n" t)))
+ (mapcar (lambda (s)
+ (if (string-match "^refs/\\(heads\\|tags\\|remotes\\)/" s)
+ (substring s (match-end 0))
+ s))
+ (if omit-stgit
+ (delete-if (lambda (s)
+ (string-match "^refs/heads/.*\\.stgit$" s))
+ result)
+ result))))
-(defun stgit-uncommit (arg)
- "Run stg uncommit. Numeric arg determines number of patches to uncommit."
+(defun stgit-rebase (new-base)
+ "Rebase to NEW-BASE."
+ (interactive (list (completing-read "Rebase to: "
+ (stgit-available-refs t))))
+ (stgit-assert-mode)
+ (stgit-capture-output nil (stgit-run "rebase" new-base))
+ (stgit-reload))
+
+(defun stgit-commit (count)
+ "Run stg commit on COUNT commits.
+Interactively, the prefix argument is used as COUNT.
+A negative COUNT will uncommit instead."
+ (interactive "p")
+ (stgit-assert-mode)
+ (if (< count 0)
+ (stgit-uncommit (- count))
+ (stgit-capture-output nil (stgit-run "commit" "-n" count))
+ (stgit-reload)))
+
+(defun stgit-uncommit (count)
+ "Run stg uncommit on COUNT commits.
+Interactively, the prefix argument is used as COUNT.
+A negative COUNT will commit instead."
(interactive "p")
- (stgit-capture-output nil (stgit-run "uncommit" "-n" (number-to-string arg)))
- (stgit-refresh))
+ (stgit-assert-mode)
+ (if (< count 0)
+ (stgit-commit (- count))
+ (stgit-capture-output nil (stgit-run "uncommit" "-n" count))
+ (stgit-reload)))
+
+(defun stgit-neighbour-file ()
+ "Return the file name of the next file after point, or the
+previous file if point is at the last file within a patch."
+ (let ((old-point (point))
+ neighbour-file)
+ (and (zerop (forward-line 1))
+ (let ((f (stgit-patched-file-at-point)))
+ (and f (setq neighbour-file (stgit-file-file f)))))
+ (goto-char old-point)
+ (unless neighbour-file
+ (and (zerop (forward-line -1))
+ (let ((f (stgit-patched-file-at-point)))
+ (and f (setq neighbour-file (stgit-file-file f)))))
+ (goto-char old-point))
+ neighbour-file))
-(defun stgit-push-next ()
- "Push the first unapplied patch"
+(defun stgit-revert-file ()
+ "Revert the file at point, which must be in the index or the
+working tree."
(interactive)
- (stgit-capture-output nil (stgit-run "push"))
- (stgit-refresh))
+ (stgit-assert-mode)
+ (let* ((patched-file (or (stgit-patched-file-at-point)
+ (error "No file on the current line")))
+ (patch-name (stgit-patch-name-at-point))
+ (file-status (stgit-file-status patched-file))
+ (rm-file (cond ((stgit-file-copy-or-rename patched-file)
+ (stgit-file-cr-to patched-file))
+ ((eq file-status 'add)
+ (stgit-file-file patched-file))))
+ (co-file (cond ((eq file-status 'rename)
+ (stgit-file-cr-from patched-file))
+ ((not (memq file-status '(copy add)))
+ (stgit-file-file patched-file))))
+ (next-file (stgit-neighbour-file)))
+
+ (unless (memq patch-name '(:work :index))
+ (error "No index or working tree file on this line"))
+
+ (when (eq file-status 'ignore)
+ (error "Cannot revert ignored files"))
+
+ (when (eq file-status 'unknown)
+ (error "Cannot revert unknown files"))
-(defun stgit-pop-next ()
- "Pop the topmost applied patch"
+ (let ((nfiles (+ (if rm-file 1 0) (if co-file 1 0))))
+ (when (yes-or-no-p (format "Revert %d file%s? "
+ nfiles
+ (if (= nfiles 1) "" "s")))
+ (stgit-capture-output nil
+ (when rm-file
+ (stgit-run-git "rm" "-f" "-q" "--" rm-file))
+ (when co-file
+ (stgit-run-git "checkout" "HEAD" co-file)))
+ (stgit-reload)
+ (stgit-goto-patch patch-name next-file)))))
+
+(defun stgit-revert ()
+ "Revert the change at point, which must be the index, the work
+tree, or a single change in either."
(interactive)
- (stgit-capture-output nil (stgit-run "pop"))
- (stgit-refresh))
+ (stgit-assert-mode)
+ (let ((patched-file (stgit-patched-file-at-point)))
+ (if patched-file
+ (stgit-revert-file)
+ (let* ((patch-name (or (stgit-patch-name-at-point)
+ (error "No patch or file at point")))
+ (patch-desc (case patch-name
+ (:index "index")
+ (:work "work tree")
+ (t (error (substitute-command-keys
+ "Use \\[stgit-delete] to delete a patch"))))))
+ (when (if (eq patch-name :work)
+ (stgit-work-tree-empty-p)
+ (stgit-index-empty-p))
+ (error (format "There are no changes in the %s to revert"
+ patch-desc)))
+ (and (eq patch-name :index)
+ (not (stgit-work-tree-empty-p))
+ (error "Cannot revert index as work tree contains unstaged changes"))
-(defun stgit-applied-at-point ()
- "Is the patch on the current line applied?"
- (save-excursion
- (beginning-of-line)
- (looking-at "[>+]")))
+ (when (yes-or-no-p (format "Revert all changes in the %s? "
+ patch-desc))
+ (if (eq patch-name :index)
+ (stgit-run-git-silent "reset" "--hard" "-q")
+ (stgit-run-git-silent "checkout" "--" "."))
+ (stgit-refresh-index)
+ (stgit-refresh-worktree)
+ (stgit-goto-patch patch-name))))))
+
+(defun stgit-resolve-file ()
+ "Resolve conflict in the file at point."
+ (interactive)
+ (stgit-assert-mode)
+ (let* ((patched-file (stgit-patched-file-at-point))
+ (patch (stgit-patch-at-point))
+ (patch-name (and patch (stgit-patch-name patch)))
+ (status (and patched-file (stgit-file-status patched-file))))
+
+ (unless (memq patch-name '(:work :index))
+ (error "No index or working tree file on this line"))
+
+ (unless (eq status 'unmerged)
+ (error "No conflict to resolve at the current line"))
+
+ (stgit-capture-output nil
+ (stgit-move-change-to-index (stgit-file-file patched-file)))
+
+ (stgit-reload)))
+
+(defun stgit-push-next (npatches)
+ "Push the first unapplied patch.
+With numeric prefix argument, push that many patches."
+ (interactive "p")
+ (stgit-assert-mode)
+ (stgit-capture-output nil (stgit-run "push" "-n" npatches))
+ (stgit-reload)
+ (stgit-refresh-git-status))
+
+(defun stgit-pop-next (npatches)
+ "Pop the topmost applied patch.
+With numeric prefix argument, pop that many patches."
+ (interactive "p")
+ (stgit-assert-mode)
+ (stgit-capture-output nil (stgit-run "pop" "-n" npatches))
+ (stgit-reload)
+ (stgit-refresh-git-status))
+
+(defun stgit-applied-patches (&optional only-patches)
+ "Return a list of the applied patches.
+
+If ONLY-PATCHES is not nil, exclude index and work tree."
+ (let ((states (if only-patches
+ '(applied top)
+ '(applied top index work)))
+ result)
+ (ewoc-map (lambda (patch) (when (memq (stgit-patch-status patch) states)
+ (setq result (cons patch result))))
+ stgit-ewoc)
+ result))
+
+(defun stgit-applied-patchsyms (&optional only-patches)
+ "Return a list of the symbols of the applied patches.
+
+If ONLY-PATCHES is not nil, exclude index and work tree."
+ (mapcar #'stgit-patch-name (stgit-applied-patches only-patches)))
(defun stgit-push-or-pop ()
- "Push or pop the patch on the current line"
+ "Push or pop the marked patches."
(interactive)
- (let ((patch (stgit-patch-at-point))
- (applied (stgit-applied-at-point)))
+ (stgit-assert-mode)
+ (let* ((patchsyms (stgit-patches-marked-or-at-point t t))
+ (applied-syms (stgit-applied-patchsyms t))
+ (unapplied (set-difference patchsyms applied-syms)))
(stgit-capture-output nil
- (stgit-run (if applied "pop" "push") patch))
- (stgit-refresh)))
+ (apply 'stgit-run
+ (if unapplied "push" "pop")
+ "--"
+ (stgit-sort-patches (if unapplied unapplied patchsyms)))))
+ (stgit-reload))
(defun stgit-goto ()
- "Go to the patch on the current line"
+ "Go to the patch on the current line.
+
+Pops or pushes patches to make this patch topmost."
(interactive)
- (let ((patch (stgit-patch-at-point)))
+ (stgit-assert-mode)
+ (let ((patchsym (stgit-patch-name-at-point t)))
(stgit-capture-output nil
- (stgit-run "goto" patch))
- (stgit-refresh)))
+ (stgit-run "goto" patchsym))
+ (stgit-reload)))
+
+(defun stgit-id (patchsym)
+ "Return the git commit id for PATCHSYM.
+If PATCHSYM is a keyword, returns PATCHSYM unmodified."
+ (if (keywordp patchsym)
+ patchsym
+ (let ((result (with-output-to-string
+ (stgit-run-silent "id" patchsym))))
+ (unless (string-match "^\\([0-9A-Fa-f]\\{40\\}\\)$" result)
+ (error "Cannot find commit id for %s" patchsym))
+ (match-string 1 result))))
+
+(defun stgit-show-patch (unmerged-stage ignore-whitespace)
+ "Show the patch on the current line.
+
+UNMERGED-STAGE is the argument to `git-diff' that that selects
+which stage to diff against in the case of unmerged files."
+ (let ((space-arg (when (numberp ignore-whitespace)
+ (cond ((> ignore-whitespace 4)
+ "--ignore-all-space")
+ ((> ignore-whitespace 1)
+ "--ignore-space-change"))))
+ (patch-name (stgit-patch-name-at-point t)))
+ (stgit-capture-output "*StGit patch*"
+ (case (get-text-property (point) 'entry-type)
+ ('file
+ (let* ((patched-file (stgit-patched-file-at-point))
+ (patch-id (let ((id (stgit-id patch-name)))
+ (if (and (eq id :index)
+ (eq (stgit-file-status patched-file)
+ 'unmerged))
+ :work
+ id)))
+ (args (append (and space-arg (list space-arg))
+ (and (stgit-file-cr-from patched-file)
+ (list (stgit-find-copies-harder-diff-arg)))
+ (cond ((eq patch-id :index)
+ '("--cached"))
+ ((eq patch-id :work)
+ (list unmerged-stage))
+ (t
+ (list (concat patch-id "^") patch-id)))
+ '("--")
+ (if (stgit-file-copy-or-rename patched-file)
+ (list (stgit-file-cr-from patched-file)
+ (stgit-file-cr-to patched-file))
+ (list (stgit-file-file patched-file))))))
+ (apply 'stgit-run-git "diff" args)))
+ ('patch
+ (let* ((patch-id (stgit-id patch-name)))
+ (if (or (eq patch-id :index) (eq patch-id :work))
+ (apply 'stgit-run-git "diff"
+ (stgit-find-copies-harder-diff-arg)
+ (append (and space-arg (list space-arg))
+ (if (eq patch-id :index)
+ '("--cached")
+ (list unmerged-stage))))
+ (let ((args (append '("show" "-O" "--patch-with-stat" "-O" "-M")
+ (and space-arg (list "-O" space-arg))
+ (list (stgit-patch-name-at-point)))))
+ (apply 'stgit-run args)))))
+ (t
+ (error "No patch or file at point")))
+ (with-current-buffer standard-output
+ (goto-char (point-min))
+ (diff-mode)))))
+
+(defmacro stgit-define-diff (name diff-arg &optional unmerged-action)
+ `(defun ,name (&optional ignore-whitespace)
+ ,(format "Show the patch on the current line.
+
+%sWith a prefix argument, ignore whitespace. With a prefix argument
+greater than four (e.g., \\[universal-argument] \
+\\[universal-argument] \\[%s]), ignore all whitespace."
+ (if unmerged-action
+ (format "For unmerged files, %s.\n\n" unmerged-action)
+ "")
+ name)
+ (interactive "p")
+ (stgit-assert-mode)
+ (stgit-show-patch ,diff-arg ignore-whitespace)))
+
+(stgit-define-diff stgit-diff
+ "--ours" nil)
+(stgit-define-diff stgit-diff-ours
+ "--ours"
+ "diff against our branch")
+(stgit-define-diff stgit-diff-theirs
+ "--theirs"
+ "diff against their branch")
+(stgit-define-diff stgit-diff-base
+ "--base"
+ "diff against the merge base")
+(stgit-define-diff stgit-diff-combined
+ "--cc"
+ "show a combined diff")
+
+(defun stgit-move-change-to-index (file &optional force)
+ "Copies the work tree state of FILE to index, using git add or git rm.
+
+If FORCE is not nil, use --force."
+ (let ((op (if (or (file-exists-p file) (file-symlink-p file))
+ '("add") '("rm" "-q"))))
+ (stgit-capture-output "*git output*"
+ (apply 'stgit-run-git (append op (and force '("--force"))
+ '("--") (list file))))))
+
+(defun stgit-remove-change-from-index (file)
+ "Unstages the change in FILE from the index"
+ (stgit-capture-output "*git output*"
+ (stgit-run-git "reset" "-q" "--" file)))
+
+(defun stgit-git-index-unmerged-p ()
+ (let (result)
+ (with-output-to-string
+ (setq result (not (zerop (stgit-run-git-silent "diff-index" "--cached"
+ "--diff-filter=U"
+ "--quiet" "HEAD")))))
+ result))
+
+(defun stgit-file-toggle-index ()
+ "Move modified file in or out of the index.
-(defun stgit-show ()
- "Show the patch on the current line"
+Leaves the point where it is, but moves the mark to where the
+file ended up. You can then jump to the file with \
+\\[exchange-point-and-mark]."
(interactive)
- (stgit-capture-output "*StGit patch*"
- (stgit-run "show" (stgit-patch-at-point))
- (with-current-buffer standard-output
- (goto-char (point-min))
- (diff-mode))))
+ (stgit-assert-mode)
+ (let* ((patched-file (or (stgit-patched-file-at-point)
+ (error "No file on the current line")))
+ (patched-status (stgit-file-status patched-file)))
+ (when (eq patched-status 'unmerged)
+ (error (substitute-command-keys "Use \\[stgit-resolve-file] to move an unmerged file to the index")))
+ (let* ((patch (stgit-patch-at-point))
+ (patch-name (stgit-patch-name patch))
+ (mark-file (if (eq patched-status 'rename)
+ (stgit-file-cr-to patched-file)
+ (stgit-file-file patched-file)))
+ (point-file (if (eq patched-status 'rename)
+ (stgit-file-cr-from patched-file)
+ (stgit-neighbour-file))))
+
+ (cond ((eq patch-name :work)
+ (stgit-move-change-to-index (stgit-file-file patched-file)
+ (eq patched-status 'ignore)))
+ ((eq patch-name :index)
+ (stgit-remove-change-from-index (stgit-file-file patched-file)))
+ (t
+ (error "Can only move files between working tree and index")))
+ (stgit-refresh-worktree)
+ (stgit-refresh-index)
+ (stgit-goto-patch (if (eq patch-name :index) :work :index) mark-file)
+ (push-mark nil t t)
+ (stgit-goto-patch patch-name point-file))))
+
+(defun stgit-toggle-index ()
+ "Move change in or out of the index.
+
+Works on index and work tree, as well as files in either.
+
+Leaves the point where it is, but moves the mark to where the
+file ended up. You can then jump to the file with \
+\\[exchange-point-and-mark]."
+ (interactive)
+ (stgit-assert-mode)
+ (if (stgit-patched-file-at-point)
+ (stgit-file-toggle-index)
+ (let ((patch-name (stgit-patch-name-at-point)))
+ (unless (memq patch-name '(:index :work))
+ (error "Can only move changes between working tree and index"))
+ (when (stgit-git-index-unmerged-p)
+ (error "Resolve unmerged changes with \\[stgit-resolve-file] first"))
+ (if (if (eq patch-name :index)
+ (stgit-index-empty-p)
+ (stgit-work-tree-empty-p))
+ (message "No changes to be moved")
+ (stgit-capture-output nil
+ (if (eq patch-name :work)
+ (stgit-run-git "add" "--update")
+ (stgit-run-git "reset" "--mixed" "-q")))
+ (stgit-refresh-worktree)
+ (stgit-refresh-index))
+ (stgit-goto-patch (if (eq patch-name :index) :work :index)))))
(defun stgit-edit ()
- "Edit the patch on the current line"
+ "Edit the patch on the current line."
(interactive)
- (let ((patch (stgit-patch-at-point))
+ (stgit-assert-mode)
+ (let ((patchsym (stgit-patch-name-at-point t t))
(edit-buf (get-buffer-create "*StGit edit*"))
(dir default-directory))
(log-edit 'stgit-confirm-edit t nil edit-buf)
- (set (make-local-variable 'stgit-edit-patch) patch)
+ (set (make-local-variable 'stgit-edit-patchsym) patchsym)
(setq default-directory dir)
(let ((standard-output edit-buf))
- (stgit-run "edit" "--save-template=-" patch))))
+ (stgit-run-silent "edit" "--save-template=-" patchsym))))
(defun stgit-confirm-edit ()
(interactive)
(let ((file (make-temp-file "stgit-edit-")))
(write-region (point-min) (point-max) file)
(stgit-capture-output nil
- (stgit-run "edit" "-f" file stgit-edit-patch))
+ (stgit-run "edit" "-f" file stgit-edit-patchsym))
(with-current-buffer log-edit-parent-buffer
- (stgit-refresh))))
+ (stgit-reload))))
-(defun stgit-new ()
- "Create a new patch"
- (interactive)
- (let ((edit-buf (get-buffer-create "*StGit edit*")))
- (log-edit 'stgit-confirm-new t nil edit-buf)))
+(defun stgit-new (add-sign &optional refresh)
+ "Create a new patch.
+With a prefix argument, include a \"Signed-off-by:\" line at the
+end of the patch."
+ (interactive "P")
+ (stgit-assert-mode)
+ (let ((edit-buf (get-buffer-create "*StGit edit*"))
+ (dir default-directory))
+ (log-edit 'stgit-confirm-new t nil edit-buf)
+ (setq default-directory dir)
+ (set (make-local-variable 'stgit-refresh-after-new) refresh)
+ (when add-sign
+ (save-excursion
+ (let ((standard-output (current-buffer)))
+ (stgit-run-silent "new" "--sign" "--save-template=-"))))))
(defun stgit-confirm-new ()
(interactive)
- (let ((file (make-temp-file "stgit-edit-")))
+ (let ((file (make-temp-file "stgit-edit-"))
+ (refresh stgit-refresh-after-new))
(write-region (point-min) (point-max) file)
(stgit-capture-output nil
(stgit-run "new" "-f" file))
(with-current-buffer log-edit-parent-buffer
- (stgit-refresh))))
+ (if refresh
+ (stgit-refresh)
+ (stgit-reload)))))
+
+(defun stgit-new-and-refresh (add-sign)
+ "Create a new patch and refresh it with the current changes.
+
+With a prefix argument, include a \"Signed-off-by:\" line at the
+end of the patch.
+
+This works just like running `stgit-new' followed by `stgit-refresh'."
+ (interactive "P")
+ (stgit-assert-mode)
+ (stgit-new add-sign t))
(defun stgit-create-patch-name (description)
"Create a patch name from a long description"
(let ((patch ""))
(while (> (length description) 0)
(cond ((string-match "\\`[a-zA-Z_-]+" description)
- (setq patch (downcase (concat patch (match-string 0 description))))
+ (setq patch (downcase (concat patch
+ (match-string 0 description))))
(setq description (substring description (match-end 0))))
((string-match "\\` +" description)
(setq patch (concat patch "-"))
(substring patch 0 20))
(t patch))))
-(defun stgit-delete (patch-names)
- "Delete the named patches"
- (interactive (list (stgit-patches-marked-or-at-point)))
- (if (zerop (length patch-names))
- (error "No patches to delete")
- (when (yes-or-no-p (format "Really delete %d patches? "
- (length patch-names)))
- (stgit-capture-output nil
- (apply 'stgit-run "delete" patch-names))
- (stgit-refresh))))
-
-(defun stgit-coalesce (patch-names)
- "Run stg coalesce on the named patches"
- (interactive (list (stgit-marked-patches)))
- (let ((edit-buf (get-buffer-create "*StGit edit*"))
- (dir default-directory))
- (log-edit 'stgit-confirm-coalesce t nil edit-buf)
- (set (make-local-variable 'stgit-patches) patch-names)
+(defun stgit-delete (patchsyms &optional spill-p)
+ "Delete the patches in PATCHSYMS.
+Interactively, delete the marked patches, or the patch at point.
+
+With a prefix argument, or SPILL-P, spill the patch contents to
+the work tree and index."
+ (interactive (list (stgit-patches-marked-or-at-point t t)
+ current-prefix-arg))
+ (stgit-assert-mode)
+ (unless patchsyms
+ (error "No patches to delete"))
+ (when (memq :index patchsyms)
+ (error "Cannot delete the index"))
+ (when (memq :work patchsyms)
+ (error "Cannot delete the work tree"))
+
+ (let ((npatches (length patchsyms)))
+ (when (yes-or-no-p (format "Really delete %d patch%s%s? "
+ npatches
+ (if (= 1 npatches) "" "es")
+ (if spill-p
+ " (spilling contents to index)"
+ "")))
+ (let ((args (if spill-p
+ (cons "--spill" patchsyms)
+ patchsyms)))
+ (stgit-capture-output nil
+ (apply 'stgit-run "delete" args))
+ (stgit-reload)))))
+
+(defun stgit-move-patches-target ()
+ "Return the patchsym indicating a target patch for
+`stgit-move-patches'.
+
+This is either the first unmarked patch at or after point, or one
+of :top and :bottom if the point is after or before the applied
+patches."
+
+ (save-excursion
+ (let (result)
+ (while (not result)
+ (let ((patchsym (stgit-patch-name-at-point)))
+ (cond ((memq patchsym '(:work :index)) (setq result :top))
+ (patchsym (if (memq patchsym stgit-marked-patches)
+ (stgit-next-patch)
+ (setq result patchsym)))
+ ((re-search-backward "^>" nil t) (setq result :top))
+ (t (setq result :bottom)))))
+ result)))
+
+(defun stgit-sort-patches (patchsyms)
+ "Returns the list of patches in PATCHSYMS sorted according to
+their position in the patch series, bottommost first.
+
+PATCHSYMS must not contain duplicate entries."
+ (let (sorted-patchsyms
+ (series (with-output-to-string
+ (with-current-buffer standard-output
+ (stgit-run-silent "series" "--noprefix"))))
+ start)
+ (while (string-match "^\\(.+\\)" series start)
+ (let ((patchsym (intern (match-string 1 series))))
+ (when (memq patchsym patchsyms)
+ (setq sorted-patchsyms (cons patchsym sorted-patchsyms))))
+ (setq start (match-end 0)))
+ (setq sorted-patchsyms (nreverse sorted-patchsyms))
+
+ (unless (= (length patchsyms) (length sorted-patchsyms))
+ (error "Internal error"))
+
+ sorted-patchsyms))
+
+(defun stgit-move-patches (patchsyms target-patch)
+ "Move the patches in PATCHSYMS to below TARGET-PATCH.
+If TARGET-PATCH is :bottom or :top, move the patches to the
+bottom or top of the stack, respectively.
+
+Interactively, move the marked patches to where the point is."
+ (interactive (list stgit-marked-patches
+ (stgit-move-patches-target)))
+ (stgit-assert-mode)
+ (unless patchsyms
+ (error "Need at least one patch to move"))
+
+ (unless target-patch
+ (error "Point not at a patch"))
+
+ ;; need to have patchsyms sorted by position in the stack
+ (let ((sorted-patchsyms (stgit-sort-patches patchsyms)))
+ (stgit-capture-output nil
+ (if (eq target-patch :top)
+ (apply 'stgit-run "float" sorted-patchsyms)
+ (apply 'stgit-run
+ "sink"
+ (append (unless (eq target-patch :bottom)
+ (list "--to" target-patch))
+ '("--")
+ sorted-patchsyms)))))
+ (stgit-reload))
+
+(defun stgit-squash (patchsyms)
+ "Squash the patches in PATCHSYMS.
+Interactively, squash the marked patches.
+
+Unless there are any conflicts, the patches will be merged into
+one patch, which will occupy the same spot in the series as the
+deepest patch had before the squash."
+ (interactive (list stgit-marked-patches))
+ (stgit-assert-mode)
+ (when (< (length patchsyms) 2)
+ (error "Need at least two patches to squash"))
+ (let ((stgit-buffer (current-buffer))
+ (edit-buf (get-buffer-create "*StGit edit*"))
+ (dir default-directory)
+ (sorted-patchsyms (stgit-sort-patches patchsyms)))
+ (log-edit 'stgit-confirm-squash t nil edit-buf)
+ (set (make-local-variable 'stgit-patchsyms) sorted-patchsyms)
(setq default-directory dir)
- (let ((standard-output edit-buf))
- (apply 'stgit-run "coalesce" "--save-template=-" patch-names))))
+ (let ((result (let ((standard-output edit-buf))
+ (apply 'stgit-run-silent "squash"
+ "--save-template=-" sorted-patchsyms))))
-(defun stgit-confirm-coalesce ()
+ ;; stg squash may have reordered the patches or caused conflicts
+ (with-current-buffer stgit-buffer
+ (stgit-reload))
+
+ (unless (eq 0 result)
+ (fundamental-mode)
+ (rename-buffer "*StGit error*")
+ (resize-temp-buffer-window)
+ (switch-to-buffer-other-window stgit-buffer)
+ (error "stg squash failed")))))
+
+(defun stgit-confirm-squash ()
(interactive)
(let ((file (make-temp-file "stgit-edit-")))
(write-region (point-min) (point-max) file)
(stgit-capture-output nil
- (apply 'stgit-run "coalesce" "-f" file stgit-patches))
+ (apply 'stgit-run "squash" "-f" file stgit-patchsyms))
(with-current-buffer log-edit-parent-buffer
- (stgit-refresh))))
+ (stgit-clear-marks)
+ ;; Go to first marked patch and stay there
+ (goto-char (point-min))
+ (re-search-forward (concat "^[>+-]\\*") nil t)
+ (move-to-column goal-column)
+ (let ((pos (point)))
+ (stgit-reload)
+ (goto-char pos)))))
(defun stgit-help ()
"Display help for the StGit mode."
(interactive)
(describe-function 'stgit-mode))
+(defun stgit-undo (&optional arg)
+ "Run stg undo.
+With prefix argument, run it with the --hard flag.
+
+See also `stgit-redo'."
+ (interactive "P")
+ (stgit-assert-mode)
+ (stgit-capture-output nil
+ (if arg
+ (stgit-run "undo" "--hard")
+ (stgit-run "undo")))
+ (stgit-reload))
+
+(defun stgit-redo (&optional arg)
+ "Run stg redo.
+With prefix argument, run it with the --hard flag.
+
+See also `stgit-undo'."
+ (interactive "P")
+ (stgit-assert-mode)
+ (stgit-capture-output nil
+ (if arg
+ (stgit-run "redo" "--hard")
+ (stgit-run "redo")))
+ (stgit-reload))
+
+(defun stgit-refresh (&optional arg)
+ "Run stg refresh.
+If the index contains any changes, only refresh from index.
+
+With prefix argument, refresh the marked patch or the patch under point."
+ (interactive "P")
+ (stgit-assert-mode)
+ (let ((patchargs (if arg
+ (let ((patches (stgit-patches-marked-or-at-point nil t)))
+ (when (> (length patches) 1)
+ (error "Too many patches marked"))
+ (cons "-p" patches))
+ nil)))
+ (unless (stgit-index-empty-p)
+ (setq patchargs (cons "--index" patchargs)))
+ (stgit-capture-output nil
+ (apply 'stgit-run "refresh" patchargs))
+ (stgit-refresh-git-status))
+ (stgit-reload))
+
+(defvar stgit-show-worktree nil
+ "If nil, inhibit showing work tree and index in the stgit buffer.
+
+See also `stgit-show-worktree-mode'.")
+
+(defvar stgit-show-ignored nil
+ "If nil, inhibit showing files ignored by git.")
+
+(defvar stgit-show-unknown nil
+ "If nil, inhibit showing files not registered with git.")
+
+(defun stgit-toggle-worktree (&optional arg)
+ "Toggle the visibility of the work tree.
+With ARG, show the work tree if ARG is positive.
+
+Its initial setting is controlled by `stgit-default-show-worktree'.
+
+`stgit-show-worktree-mode' controls where on screen the index and
+work tree will show up."
+ (interactive)
+ (stgit-assert-mode)
+ (setq stgit-show-worktree
+ (if (numberp arg)
+ (> arg 0)
+ (not stgit-show-worktree)))
+ (stgit-reload))
+
+(defun stgit-toggle-ignored (&optional arg)
+ "Toggle the visibility of files ignored by git in the work
+tree. With ARG, show these files if ARG is positive.
+
+Use \\[stgit-toggle-worktree] to show the work tree."
+ (interactive)
+ (stgit-assert-mode)
+ (setq stgit-show-ignored
+ (if (numberp arg)
+ (> arg 0)
+ (not stgit-show-ignored)))
+ (stgit-reload))
+
+(defun stgit-toggle-unknown (&optional arg)
+ "Toggle the visibility of files not registered with git in the
+work tree. With ARG, show these files if ARG is positive.
+
+Use \\[stgit-toggle-worktree] to show the work tree."
+ (interactive)
+ (stgit-assert-mode)
+ (setq stgit-show-unknown
+ (if (numberp arg)
+ (> arg 0)
+ (not stgit-show-unknown)))
+ (stgit-reload))
+
(provide 'stgit)