+ (goto-line curline)))
+ (stgit-refresh-git-status))
+
+(defgroup stgit nil
+ "A user interface for the StGit patch maintenance tool."
+ :group 'tools)
+
+(defface stgit-description-face
+ '((((background dark)) (:foreground "tan"))
+ (((background light)) (:foreground "dark red")))
+ "The face used for StGit descriptions"
+ :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"
+ :group 'stgit)
+
+(defface stgit-applied-patch-face
+ '((((background dark)) (:foreground "light yellow"))
+ (((background light)) (:foreground "purple"))
+ (t ()))
+ "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"
+ :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)
+
+(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-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)
+
+(defcustom stgit-expand-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)
+
+(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)))
+ "Alist of code symbols to description strings")
+
+(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)
+ ("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-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))
+ (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)
+ (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"
+ (interactive)
+ (let ((patched-file (stgit-patched-file-at-point)))
+ (unless patched-file
+ (error "No file on the current line"))
+ (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))))
+
+(defun stgit-quit ()
+ "Hide the stgit buffer."
+ (interactive)
+ (bury-buffer))
+
+(defun stgit-git-status ()
+ "Show status using `git-status'."
+ (interactive)
+ (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")
+ (next-line arg)
+ (move-to-column (stgit-goal-column)))
+
+(defun stgit-previous-line (&optional arg)
+ "Move cursor vertically up ARG lines"
+ (interactive "p")
+ (previous-line arg)
+ (move-to-column (stgit-goal-column)))
+
+(defun stgit-next-patch (&optional arg)
+ "Move cursor down ARG patches."
+ (interactive "p")
+ (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")
+ (ewoc-goto-prev stgit-ewoc (or arg 1))
+ (move-to-column goal-column))