;; To start: `M-x stgit'
(require 'git nil t)
+(require 'cl)
+(require 'ewoc)
(defun stgit (dir)
"Manage StGit patches for the tree in DIR."
(with-current-buffer git-status-buffer
(git-refresh-status))))))
-(defun switch-to-stgit-buffer (dir)
- "Switch to a (possibly new) buffer displaying StGit patches for DIR."
+(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)))
+ (case name
+ (:index (insert (propertize " Index" 'face 'italic)))
+ (:work (insert (propertize " Work tree" 'face 'italic)))
+ (t (insert (case status
+ ('applied "+")
+ ('top ">")
+ ('unapplied "-"))
+ (if (memq name stgit-marked-patches)
+ "*" " ")
+ (propertize (format "%-30s"
+ (symbol-name name))
+ 'face (case status
+ ('applied 'stgit-applied-patch-face)
+ ('top 'stgit-top-patch-face)
+ ('unapplied 'stgit-unapplied-patch-face)
+ ('index nil)
+ ('work nil)))
+ " "
+ (if (stgit-patch-empty patch) "(empty) " "")
+ (propertize (or (stgit-patch-desc patch) "")
+ 'face 'stgit-description-face))))
+ (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" "--"))
(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-make-run-args (args)
"Return a copy of ARGS with its elements converted to strings."
(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")))
+
+(defvar stgit-index-node nil)
+(defvar stgit-worktree-node nil)
+
+(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 (ewoc)
+ (let ((first-line t))
+ (with-temp-buffer
+ (let ((exit-status (stgit-run-silent "series" "--description" "--empty")))
+ (goto-char (point-min))
+ (if (not (zerop exit-status))
+ (cond ((looking-at "stg series: \\(.*\\)")
+ (ewoc-set-hf ewoc (car (ewoc-get-hf ewoc))
+ "-- not initialized (run M-x 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))))
+ (ewoc-enter-last ewoc
+ (make-stgit-patch
+ :status state
+ :name (intern (match-string 4))
+ :desc (match-string 5)
+ :empty (string= (match-string 1) "0"))))
+ (setq first-line nil)
+ (forward-line 1)))))
+ (if stgit-show-worktree
+ (setq stgit-index-node (cons ewoc (ewoc-enter-last ewoc
+ (make-stgit-patch
+ :status 'index
+ :name :index
+ :desc nil
+ :empty nil)))
+ stgit-worktree-node (cons ewoc (ewoc-enter-last ewoc
+ (make-stgit-patch
+ :status 'work
+ :name :work
+ :desc nil
+ :empty nil))))
+ (setq stgit-worktree-node nil))))
+
+
(defun stgit-reload ()
"Update the contents of the StGit buffer."
(interactive)
(let ((inhibit-read-only t)
(curline (line-number-at-pos))
- (curpatch (stgit-patch-at-point)))
- (erase-buffer)
- (insert "Branch: ")
- (stgit-run-silent "branch")
- (stgit-run-silent "series" "--description")
- (stgit-rescan)
+ (curpatch (stgit-patch-name-at-point)))
+ (ewoc-filter stgit-ewoc #'(lambda (x) nil))
+ (ewoc-set-hf stgit-ewoc
+ (concat "Branch: "
+ (propertize
+ (with-temp-buffer
+ (stgit-run-silent "branch")
+ (buffer-substring (point-min) (1- (point-max))))
+ 'face 'bold)
+ "\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)))
(unknown "Unknown" stgit-unknown-file-face)))
"Alist of code symbols to description strings")
-(defun stgit-file-status-code-as-string (code)
- "Return stgit status code as string"
- (let ((str (assq (if (consp code) (car code) code)
- stgit-file-status-code-strings)))
- (when str
+(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 str (consp code) (/= (cdr code) 100))
- (format "%s %s" (cdr str)
- (propertize (format "%d%%" (cdr code))
+ (if (and score (/= score 100))
+ (format "%s %s" (cdr code)
+ (propertize (format "%d%%" score)
'face 'stgit-description-face))
- (cdr str))))))
+ (cdr code))))))
(defun stgit-file-status-code (str &optional score)
"Return stgit status code from git status string"
(propertize (format "%o" new-perm)
'face 'stgit-file-permission-face)))))))
-(defun stgit-expand-patch (patchsym)
- "Expand (show modification of) the patch with name PATCHSYM (a
-symbol) at point.
-`stgit-expand-find-copies-harder' controls how hard to try to
-find copied files."
- (save-excursion
- (forward-line)
- (let* ((start (point))
- (result (with-output-to-string
- (stgit-run-git "diff-tree" "-r" "-z"
- (if stgit-expand-find-copies-harder
- "--find-copies-harder"
- "-C")
- (stgit-id patchsym)))))
- (let (mstart)
- (while (string-match "\0:\\([0-7]+\\) \\([0-7]+\\) [0-9A-Fa-f]\\{40\\} [0-9A-Fa-f]\\{40\\} \\(\\([CR]\\)\\([0-9]*\\)\0\\([^\0]*\\)\0\\([^\0]*\\)\\|\\([ABD-QS-Z]\\)\0\\([^\0]*\\)\\)"
- result mstart)
- (let ((copy-or-rename (match-string 4 result))
- (old-perm (read (format "#o%s" (match-string 1 result))))
- (new-perm (read (format "#o%s" (match-string 2 result))))
- (line-start (point))
- status
- change
- properties)
- (insert " ")
- (if copy-or-rename
- (let ((cr-score (match-string 5 result))
- (cr-from-file (match-string 6 result))
- (cr-to-file (match-string 7 result)))
- (setq status (stgit-file-status-code copy-or-rename
- cr-score)
- properties (list 'stgit-old-file cr-from-file
- 'stgit-new-file cr-to-file)
- change (concat
- cr-from-file
- (propertize " -> "
- 'face 'stgit-description-face)
- cr-to-file)))
- (setq status (stgit-file-status-code (match-string 8 result))
- properties (list 'stgit-file (match-string 9 result))
- change (match-string 9 result)))
-
- (let ((mode-change (stgit-file-mode-change-string old-perm
- new-perm)))
- (insert (format "%-12s" (stgit-file-status-code-as-string
- status))
- mode-change
- (if (> (length mode-change) 0) " " "")
- change
- (propertize (stgit-file-type-change-string old-perm
- new-perm)
- 'face 'stgit-description-face)
- ?\n))
- (add-text-properties line-start (point) properties))
- (setq mstart (match-end 0))))
- (when (= start (point))
- (insert " <no files>\n"))
- (put-text-property start (point) 'stgit-file-patchsym patchsym))))
-
-(defun stgit-rescan ()
- "Rescan the status buffer."
- (save-excursion
- (let ((marked ()))
+(defstruct (stgit-file)
+ old-perm new-perm copy-or-rename cr-score cr-from cr-to status file)
+
+(defun stgit-file-pp (file)
+ (let ((status (stgit-file-status file))
+ (name (if (stgit-file-copy-or-rename file)
+ (concat (stgit-file-cr-from file)
+ (propertize " -> "
+ 'face 'stgit-description-face)
+ (stgit-file-cr-to 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%1s%s%s\n"
+ (stgit-file-status-code-as-string file)
+ 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-insert-patch-files (patch)
+ "Expand (show modification of) the patch PATCH after the line
+at point."
+ (let* ((patchsym (stgit-patch-name patch))
+ (end (progn (insert "#") (prog1 (point-marker) (forward-char -1))))
+ (args (list "-z" (if stgit-expand-find-copies-harder
+ "--find-copies-harder"
+ "-C")))
+ (ewoc (ewoc-create #'stgit-file-pp nil nil t)))
+ (setf (stgit-patch-files-ewoc patch) ewoc)
+ (with-temp-buffer
+ (apply 'stgit-run-git
+ (cond ((eq patchsym :work)
+ `("diff-files" ,@args))
+ ((eq patchsym :index)
+ `("diff-index" ,@args "--cached" "HEAD"))
+ (t
+ `("diff-tree" ,@args "-r" ,(stgit-id patchsym)))))
(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)))
- (put-text-property (match-beginning 0) (match-end 0)
- 'stgit-patchsym patchsym)
- (when (memq patchsym stgit-expanded-patches)
- (stgit-expand-patch patchsym))
- ))
- ((or (looking-at "stg series: Branch \".*\" not initialised")
- (looking-at "stg series: .*: branch not initialized"))
- (forward-line 1)
- (insert "Run M-x stgit-init to initialise")))
- (forward-line 1))
- (setq stgit-marked-patches (nreverse marked)))))
+ (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")
+ (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 (match-string 3)))
+ ((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))))))
+ (ewoc-enter-last ewoc file))
+ (goto-char (match-end 0))))
+ (unless (ewoc-nth ewoc 0)
+ (ewoc-set-hf ewoc "" (propertize " <no files>\n"
+ 'face 'stgit-description-face))))
+ (goto-char end)
+ (delete-char -2)))
+
+(defun stgit-select-file ()
+ (let ((filename (expand-file-name
+ (stgit-file-file (stgit-patched-file-at-point)))))
+ (unless (file-exists-p filename)
+ (error "File does not exist"))
+ (find-file filename)))
+
+(defun stgit-select-patch ()
+ (let ((patchname (stgit-patch-name-at-point)))
+ (if (memq patchname stgit-expanded-patches)
+ (setq stgit-expanded-patches (delq patchname stgit-expanded-patches))
+ (setq stgit-expanded-patches (cons patchname stgit-expanded-patches)))
+ (ewoc-invalidate stgit-ewoc (ewoc-locate stgit-ewoc)))
+ (move-to-column (stgit-goal-column)))
(defun stgit-select ()
"Expand or collapse the current entry"
(interactive)
- (let ((curpatch (stgit-patch-at-point)))
- (if (not curpatch)
- (let ((patched-file (stgit-patched-file-at-point)))
- (unless patched-file
- (error "No patch or file on the current line"))
- (let ((filename (expand-file-name (cdr patched-file))))
- (unless (file-exists-p filename)
- (error "File does not exist"))
- (find-file filename)))
- (setq stgit-expanded-patches
- (if (memq curpatch stgit-expanded-patches)
- (delq curpatch stgit-expanded-patches)
- (cons curpatch stgit-expanded-patches)))
- (stgit-reload))))
+ (case (get-text-property (point) 'entry-type)
+ ('patch
+ (stgit-select-patch))
+ ('file
+ (stgit-select-file))
+ (t
+ (error "No patch or file on line"))))
(defun stgit-find-file-other-window ()
"Open file at point in other window"
(let ((patched-file (stgit-patched-file-at-point)))
(unless patched-file
(error "No file on the current line"))
- (let ((filename (expand-file-name (cdr patched-file))))
+ (let ((filename (expand-file-name (stgit-file-file patched-file))))
(unless (file-exists-p filename)
(error "File does not exist"))
(find-file-other-window filename))))
(pop-to-buffer nil)
(git-status dir))))
-(defun stgit-next-line (&optional arg try-vscroll)
+(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\np")
- (next-line arg try-vscroll)
- (when (looking-at " \\S-")
- (forward-char 2)))
+ (interactive "p")
+ (next-line arg)
+ (move-to-column (stgit-goal-column)))
-(defun stgit-previous-line (&optional arg try-vscroll)
+(defun stgit-previous-line (&optional arg)
"Move cursor vertically up ARG lines"
- (interactive "p\np")
- (previous-line arg try-vscroll)
- (when (looking-at " \\S-")
- (forward-char 2)))
+ (interactive "p")
+ (previous-line arg)
+ (move-to-column (stgit-goal-column)))
(defun stgit-next-patch (&optional arg)
- "Move cursor down ARG patches"
+ "Move cursor down ARG patches."
(interactive "p")
- (unless arg
- (setq arg 1))
- (if (< arg 0)
- (stgit-previous-patch (- arg))
- (while (not (zerop arg))
- (setq arg (1- arg))
- (while (progn (stgit-next-line)
- (not (stgit-patch-at-point)))))))
+ (ewoc-goto-next stgit-ewoc (or arg 1))
+ (move-to-column goal-column))
(defun stgit-previous-patch (&optional arg)
- "Move cursor up ARG patches"
+ "Move cursor up ARG patches."
(interactive "p")
- (unless arg
- (setq arg 1))
- (if (< arg 0)
- (stgit-next-patch (- arg))
- (while (not (zerop arg))
- (setq arg (1- arg))
- (while (progn (stgit-previous-line)
- (not (stgit-patch-at-point)))))))
+ (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)
- (mapc (lambda (arg) (define-key stgit-mode-map (car arg) (cdr arg)))
- '((" " . stgit-mark)
- ("m" . stgit-mark)
- ("\d" . stgit-unmark-up)
- ("u" . stgit-unmark-down)
- ("?" . stgit-help)
- ("h" . stgit-help)
- ("p" . stgit-previous-line)
- ("n" . stgit-next-line)
- ("\C-p" . stgit-previous-patch)
- ("\C-n" . stgit-next-patch)
- ("\M-{" . stgit-previous-patch)
- ("\M-}" . stgit-next-patch)
- ("s" . stgit-git-status)
- ("g" . stgit-reload)
- ("r" . stgit-refresh)
- ("\C-c\C-r" . stgit-rename)
- ("e" . stgit-edit)
- ("c" . stgit-coalesce)
- ("N" . stgit-new)
- ("R" . stgit-repair)
- ("C" . stgit-commit)
- ("U" . stgit-uncommit)
- ("\r" . stgit-select)
- ("o" . stgit-find-file-other-window)
- (">" . stgit-push-next)
- ("<" . stgit-pop-next)
- ("P" . stgit-push-or-pop)
- ("G" . stgit-goto)
- ("=" . stgit-show)
- ("D" . stgit-delete)
- ([(control ?/)] . stgit-undo)
- ("\C-_" . stgit-undo)
- ("q" . stgit-quit))))
+ (let ((toggle-map (make-keymap)))
+ (suppress-keymap toggle-map)
+ (mapc (lambda (arg) (define-key toggle-map (car arg) (cdr arg)))
+ '(("t" . stgit-toggle-worktree)))
+ (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)
+ ("m" . stgit-mark)
+ ("\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)
+ ("r" . stgit-refresh)
+ ("\C-c\C-r" . stgit-rename)
+ ("e" . stgit-edit)
+ ("M" . stgit-move-patches)
+ ("S" . stgit-squash)
+ ("N" . stgit-new)
+ ("R" . stgit-repair)
+ ("C" . stgit-commit)
+ ("U" . stgit-uncommit)
+ ("\r" . stgit-select)
+ ("o" . stgit-find-file-other-window)
+ ("i" . stgit-file-toggle-index)
+ (">" . stgit-push-next)
+ ("<" . stgit-pop-next)
+ ("P" . stgit-push-or-pop)
+ ("G" . stgit-goto)
+ ("=" . stgit-show)
+ ("D" . stgit-delete)
+ ([(control ?/)] . stgit-undo)
+ ("\C-_" . stgit-undo)
+ ("B" . stgit-branch)
+ ("t" . ,toggle-map)
+ ("q" . stgit-quit)))))
(defun stgit-mode ()
"Major mode for interacting with StGit.
(set (make-local-variable 'list-buffers-directory) default-directory)
(set (make-local-variable 'stgit-marked-patches) nil)
(set (make-local-variable 'stgit-expanded-patches) nil)
+ (set (make-local-variable 'stgit-show-worktree) stgit-default-show-worktree)
(set-variable 'truncate-lines 't)
+ (add-hook 'after-save-hook 'stgit-update-saved-file)
(run-hooks 'stgit-mode-hook))
+(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-add-mark (patchsym)
"Mark the patch PATCHSYM."
(setq stgit-marked-patches (cons patchsym stgit-marked-patches)))
"Unmark all patches."
(setq stgit-marked-patches '()))
-(defun stgit-patch-at-point (&optional cause-error allow-file)
+(defun stgit-patch-at-point (&optional cause-error)
+ (get-text-property (point) 'patch-data))
+
+(defun stgit-patch-name-at-point (&optional cause-error)
"Return the patch name on the current line as a symbol.
-If CAUSE-ERROR is not nil, signal an error if none found.
-If ALLOW-FILE is not nil, also handle when point is on a file of
-a patch."
- (or (get-text-property (point) 'stgit-patchsym)
- (and allow-file
- (get-text-property (point) 'stgit-file-patchsym))
- (when cause-error
- (error "No patch on this line"))))
-
-(defun stgit-patched-file-at-point (&optional both-files)
- "Returns a cons of the patchsym and file name at point. For
-copies and renames, return the new file if the patch is either
-applied. If BOTH-FILES is non-nil, return a cons of the old and
-the new file names instead of just one name."
- (let ((patchsym (get-text-property (point) 'stgit-file-patchsym))
- (file (get-text-property (point) 'stgit-file)))
- (cond ((not patchsym) nil)
- (file (cons patchsym file))
- (both-files
- (cons patchsym (cons (get-text-property (point) 'stgit-old-file)
- (get-text-property (point) 'stgit-new-file))))
- (t
- (let ((file-sym (save-excursion
- (stgit-previous-patch)
- (unless (eq (stgit-patch-at-point)
- patchsym)
- (error "Cannot find the %s patch" patchsym))
- (beginning-of-line)
- (if (= (char-after) ?-)
- 'stgit-old-file
- 'stgit-new-file))))
- (cons patchsym (get-text-property (point) file-sym)))))))
+If CAUSE-ERROR is not nil, signal an error if none found."
+ (let ((patch (stgit-patch-at-point)))
+ (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 ()
"Return the symbols of the marked patches, or the patch on the current line."
(if stgit-marked-patches
stgit-marked-patches
- (let ((patch (stgit-patch-at-point)))
+ (let ((patch (stgit-patch-name-at-point)))
(if patch
(list patch)
'()))))
(defun stgit-goto-patch (patchsym)
"Move point to the line containing patch PATCHSYM.
-If that patch cannot be found, return nil."
- (let ((p (text-property-any (point-min) (point-max)
- 'stgit-patchsym patchsym)))
- (when p
- (goto-char p)
+If that patch cannot be found, do nothing."
+ (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 node
+ (ewoc-goto-node stgit-ewoc node)
(move-to-column goal-column))))
(defun stgit-init ()
(defun stgit-mark ()
"Mark the patch under point."
(interactive)
- (let ((patch (stgit-patch-at-point t)))
- (stgit-add-mark patch)
- (stgit-reload))
+ (let* ((node (ewoc-locate stgit-ewoc))
+ (patch (ewoc-data node)))
+ (stgit-add-mark (stgit-patch-name patch))
+ (ewoc-invalidate stgit-ewoc node))
(stgit-next-patch))
(defun stgit-unmark-up ()
"Remove mark from the patch on the previous line."
(interactive)
(stgit-previous-patch)
- (stgit-remove-mark (stgit-patch-at-point t))
- (stgit-reload))
+ (let* ((node (ewoc-locate stgit-ewoc))
+ (patch (ewoc-data node)))
+ (stgit-remove-mark (stgit-patch-name patch))
+ (ewoc-invalidate stgit-ewoc node))
+ (move-to-column (stgit-goal-column)))
(defun stgit-unmark-down ()
"Remove mark from the patch on the current line."
(interactive)
- (stgit-remove-mark (stgit-patch-at-point t))
- (stgit-reload)
+ (let* ((node (ewoc-locate stgit-ewoc))
+ (patch (ewoc-data node)))
+ (stgit-remove-mark (stgit-patch-name patch))
+ (ewoc-invalidate stgit-ewoc node))
(stgit-next-patch))
(defun stgit-rename (name)
"Rename the patch under point to NAME."
(interactive (list (read-string "Patch name: "
- (symbol-name (stgit-patch-at-point t)))))
- (let ((old-patchsym (stgit-patch-at-point t)))
+ (symbol-name (stgit-patch-name-at-point t)))))
+ (let ((old-patchsym (stgit-patch-name-at-point t)))
(stgit-capture-output nil
(stgit-run "rename" old-patchsym name))
(let ((name-sym (intern name)))
(stgit-run "repair"))
(stgit-reload))
-(defun stgit-commit ()
- "Run stg commit."
- (interactive)
- (stgit-capture-output nil (stgit-run "commit"))
+(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-capture-output nil (stgit-run "branch" "--" branch))
(stgit-reload))
-(defun stgit-uncommit (arg)
- "Run stg uncommit. Numeric arg determines number of patches to uncommit."
+(defun stgit-commit (count)
+ "Run stg commit on COUNT commits.
+Interactively, the prefix argument is used as COUNT."
(interactive "p")
- (stgit-capture-output nil (stgit-run "uncommit" "-n" arg))
+ (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."
+ (interactive "p")
+ (stgit-capture-output nil (stgit-run "uncommit" "-n" count))
(stgit-reload))
(defun stgit-push-next (npatches)
(defun stgit-push-or-pop ()
"Push or pop the patch on the current line."
(interactive)
- (let ((patchsym (stgit-patch-at-point t))
+ (let ((patchsym (stgit-patch-name-at-point t))
(applied (stgit-applied-at-point)))
(stgit-capture-output nil
(stgit-run (if applied "pop" "push") patchsym))
(defun stgit-goto ()
"Go to the patch on the current line."
(interactive)
- (let ((patchsym (stgit-patch-at-point t)))
+ (let ((patchsym (stgit-patch-name-at-point t)))
(stgit-capture-output nil
(stgit-run "goto" patchsym))
(stgit-reload)))
(defun stgit-id (patchsym)
- "Return the git commit id for 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)))
+ "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 ()
"Show the patch on the current line."
(interactive)
(stgit-capture-output "*StGit patch*"
- (let ((patchsym (stgit-patch-at-point)))
- (if (not patchsym)
- (let ((patched-file (stgit-patched-file-at-point t)))
- (unless patched-file
- (error "No patch or file at point"))
- (let ((id (stgit-id (car patched-file))))
- (with-output-to-temp-buffer "*StGit diff*"
- (if (consp (cdr patched-file))
- ;; two files (copy or rename)
- (stgit-run-git "diff" "-C" "-C" (concat id "^") id "--"
- (cadr patched-file) (cddr patched-file))
- ;; just one file
- (stgit-run-git "diff" (concat id "^") id "--"
- (cdr patched-file)))
- (with-current-buffer standard-output
- (diff-mode)))))
- (stgit-run "show" patchsym)
- (with-current-buffer standard-output
- (goto-char (point-min))
- (diff-mode))))))
+ (case (get-text-property (point) 'entry-type)
+ ('file
+ (let* ((patched-file (stgit-patched-file-at-point))
+ (patch-name (stgit-patch-name-at-point))
+ (patch-id (stgit-id patch-name))
+ (args (append (and (stgit-file-cr-from patched-file)
+ (if stgit-expand-find-copies-harder
+ '("--find-copies-harder")
+ '("-C")))
+ (cond ((eq patch-id :index)
+ '("--cached"))
+ ((eq patch-id :work)
+ nil)
+ (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
+ (stgit-run "show" "-O" "--patch-with-stat" "-O" "-M"
+ (stgit-patch-name-at-point)))
+ (t
+ (error "No patch or file at point")))
+ (with-current-buffer standard-output
+ (goto-char (point-min))
+ (diff-mode))))
+
+(defun stgit-move-change-to-index (file)
+ "Copies the workspace state of FILE to index, using git add or git rm"
+ (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 '("--") (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-file-toggle-index ()
+ "Move modified file in or out of the index."
+ (interactive)
+ (let ((patched-file (stgit-patched-file-at-point)))
+ (unless patched-file
+ (error "No file on the current line"))
+ (let ((patch-name (stgit-patch-name-at-point)))
+ (cond ((eq patch-name :work)
+ (stgit-move-change-to-index (stgit-file-file patched-file)))
+ ((eq patch-name :index)
+ (stgit-remove-change-from-index (stgit-file-file patched-file)))
+ (t
+ (error "Can only move files in the working tree to index")))))
+ (stgit-refresh-worktree)
+ (stgit-refresh-index))
(defun stgit-edit ()
"Edit the patch on the current line."
(interactive)
- (let ((patchsym (stgit-patch-at-point t))
+ (let ((patchsym (stgit-patch-name-at-point t))
(edit-buf (get-buffer-create "*StGit edit*"))
(dir default-directory))
(log-edit 'stgit-confirm-edit t nil edit-buf)
(substring patch 0 20))
(t patch))))
-(defun stgit-delete (patchsyms)
+(defun stgit-delete (patchsyms &optional spill-p)
"Delete the patches in PATCHSYMS.
-Interactively, delete the marked patches, or the patch at point."
- (interactive (list (stgit-patches-marked-or-at-point)))
+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)
+ current-prefix-arg))
+ (unless patchsyms
+ (error "No patches to delete"))
(let ((npatches (length patchsyms)))
- (if (zerop npatches)
- (error "No patches to delete")
- (when (yes-or-no-p (format "Really delete %d patch%s? "
- npatches
- (if (= 1 npatches) "" "es")))
+ (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" patchsyms))
+ (apply 'stgit-run "delete" args))
(stgit-reload)))))
-(defun stgit-coalesce (patchsyms)
- "Coalesce the patches in PATCHSYMS.
-Interactively, coalesce the marked patches."
+(defun stgit-move-patches-target ()
+ "Return the patchsym indicating a target patch for
+`stgit-move-patches'.
+
+This is either the patch at point, or one of :top and :bottom, if
+the point is after or before the applied patches."
+
+ (let ((patchsym (stgit-patch-name-at-point)))
+ (cond (patchsym patchsym)
+ ((save-excursion (re-search-backward "^>" nil t)) :top)
+ (t :bottom))))
+
+(defun stgit-sort-patches (patchsyms)
+ "Returns the list of patches in PATCHSYMS sorted according to
+their position in the patch series, bottommost first.
+
+PATCHSYMS may 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)))
+ (unless patchsyms
+ (error "Need at least one patch to move"))
+
+ (unless target-patch
+ (error "Point not at a patch"))
+
+ (if (eq target-patch :top)
+ (stgit-capture-output nil
+ (apply 'stgit-run "float" patchsyms))
+
+ ;; need to have patchsyms sorted by position in the stack
+ (let ((sorted-patchsyms (stgit-sort-patches patchsyms)))
+ (while sorted-patchsyms
+ (setq sorted-patchsyms
+ (and (stgit-capture-output nil
+ (if (eq target-patch :bottom)
+ (stgit-run "sink" "--" (car sorted-patchsyms))
+ (stgit-run "sink" "--to" target-patch "--"
+ (car sorted-patchsyms))))
+ (cdr 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))
(when (< (length patchsyms) 2)
- (error "Need at least two patches to coalesce"))
- (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-patchsyms) patchsyms)
+ (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-silent "coalesce" "--save-template=-" patchsyms))))
-
-(defun stgit-confirm-coalesce ()
+ (let ((result (let ((standard-output edit-buf))
+ (apply 'stgit-run-silent "squash"
+ "--save-template=-" sorted-patchsyms))))
+
+ ;; 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-patchsyms))
+ (apply 'stgit-run "squash" "-f" file stgit-patchsyms))
(with-current-buffer log-edit-parent-buffer
(stgit-clear-marks)
;; Go to first marked patch and stay there
(stgit-refresh-git-status))
(stgit-reload))
+(defcustom stgit-default-show-worktree
+ nil
+ "Set to non-nil to by default show the working tree in a new stgit buffer.
+
+This value is used as the default value for `stgit-show-worktree'."
+ :type 'boolean
+ :group 'stgit)
+
+(defvar stgit-show-worktree nil
+ "Show work tree and index in the stgit buffer.
+
+See `stgit-default-show-worktree' for its default value.")
+
+(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'."
+ (interactive)
+ (setq stgit-show-worktree
+ (if (numberp arg)
+ (> arg 0)
+ (not stgit-show-worktree)))
+ (stgit-reload))
+
(provide 'stgit)
~mdw / stgit / blobdiff