X-Git-Url: https://git.distorted.org.uk/~mdw/stgit/blobdiff_plain/d51722b71a1c75f91bfb8653bc6b1ba754a376dd..306b37a63112bf26cac29474116490376537f04f:/contrib/stgit.el diff --git a/contrib/stgit.el b/contrib/stgit.el index 9c88e60..c4ed958 100644 --- a/contrib/stgit.el +++ b/contrib/stgit.el @@ -10,6 +10,8 @@ ;; To start: `M-x stgit' (require 'git nil t) +(require 'cl) +(require 'ewoc) (defun stgit (dir) "Manage StGit patches for the tree in DIR." @@ -40,8 +42,8 @@ directory DIR or `default-directory'" (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 @@ -49,9 +51,47 @@ directory DIR or `default-directory'" (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. @@ -61,11 +101,17 @@ Argument DIR is the repository path." (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)) @@ -80,7 +126,6 @@ Argument DIR is the repository path." (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." @@ -115,17 +160,87 @@ Argument DIR is the repository path." (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))) @@ -209,17 +324,18 @@ flag, which reduces performance." (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" @@ -291,116 +407,113 @@ Cf. `stgit-file-type-change-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 " \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 " \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" @@ -408,7 +521,7 @@ find copied files." (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)))) @@ -428,43 +541,36 @@ find copied files." (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.") @@ -473,42 +579,52 @@ find copied files." "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. @@ -523,9 +639,21 @@ Commands: (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))) @@ -538,57 +666,39 @@ Commands: "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 () @@ -601,30 +711,36 @@ If that patch cannot be found, return nil." (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))) @@ -644,16 +760,36 @@ If that patch cannot be found, return nil." (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) @@ -681,7 +817,7 @@ With numeric prefix argument, pop that many patches." (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)) @@ -690,48 +826,88 @@ With numeric prefix argument, pop that many patches." (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) @@ -791,40 +967,132 @@ end of the patch." (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 @@ -868,4 +1136,29 @@ With prefix argument, refresh the marked patch or the patch under point." (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)