mdw@git.distorted.org.uk Git - stgit/blob - contrib/stgit.el

   1 ;; stgit.el: An emacs mode for StGit
   2 ;;
   3 ;; Copyright (C) 2007 David Kågedal <davidk@lysator.liu.se>
   4 ;;
   5 ;; To install: put this file on the load-path and place the following
   6 ;; in your .emacs file:
   7 ;;
   8 ;;    (require 'stgit)
   9 ;;
  10 ;; To start: `M-x stgit'
  11
  12 (when (< emacs-major-version 22)
  13   (error "Emacs older than 22 is not supported by stgit.el"))
  14
  15 (require 'git nil t)
  16 (require 'cl)
  17 (require 'ewoc)
  18
  19 (defun stgit (dir)
  20   "Manage StGit patches for the tree in DIR.
  21
  22 See `stgit-mode' for commands available."
  23   (interactive "DDirectory: \n")
  24   (switch-to-stgit-buffer (git-get-top-dir dir))
  25   (stgit-reload))
  26
  27 (unless (fboundp 'git-get-top-dir)
  28   (defun git-get-top-dir (dir)
  29     "Retrieve the top-level directory of a git tree."
  30     (let ((cdup (with-output-to-string
  31                   (with-current-buffer standard-output
  32                     (cd dir)
  33                     (unless (eq 0 (call-process "git" nil t nil
  34                                                 "rev-parse" "--show-cdup"))
  35                       (error "Cannot find top-level git tree for %s" dir))))))
  36       (expand-file-name (concat (file-name-as-directory dir)
  37                                 (car (split-string cdup "\n")))))))
  38
  39 (defun stgit-refresh-git-status (&optional dir)
  40   "If it exists, refresh the `git-status' buffer belonging to
  41 directory DIR or `default-directory'"
  42   (when (and (fboundp 'git-find-status-buffer)
  43              (fboundp 'git-refresh-status))
  44     (let* ((top-dir (git-get-top-dir (or dir default-directory)))
  45            (git-status-buffer (and top-dir (git-find-status-buffer top-dir))))
  46       (when git-status-buffer
  47         (with-current-buffer git-status-buffer
  48           (git-refresh-status))))))
  49
  50 (defun stgit-find-buffer (dir)
  51   "Return the buffer displaying StGit patches for DIR, or nil if none."
  52   (setq dir (file-name-as-directory dir))
  53   (let ((buffers (buffer-list)))
  54     (while (and buffers
  55                 (not (with-current-buffer (car buffers)
  56                        (and (eq major-mode 'stgit-mode)
  57                             (string= default-directory dir)))))
  58       (setq buffers (cdr buffers)))
  59     (and buffers (car buffers))))
  60
  61 (defun switch-to-stgit-buffer (dir)
  62   "Switch to a (possibly new) buffer displaying StGit patches for DIR."
  63   (setq dir (file-name-as-directory dir))
  64   (let ((buffer (stgit-find-buffer dir)))
  65     (switch-to-buffer (or buffer
  66                           (create-stgit-buffer dir)))))
  67
  68 (defstruct (stgit-patch)
  69   status name desc empty files-ewoc)
  70
  71 (defun stgit-patch-pp (patch)
  72   (let* ((status (stgit-patch-status patch))
  73          (start (point))
  74          (name (stgit-patch-name patch))
  75          (face (cdr (assq status stgit-patch-status-face-alist))))
  76     (insert (case status
  77               ('applied "+")
  78               ('top ">")
  79               ('unapplied "-")
  80               (t " "))
  81             (if (memq name stgit-marked-patches)
  82                 "*" " "))
  83     (if (memq status '(index work))
  84         (insert (propertize (if (eq status 'index) "Index" "Work tree")
  85                             'face face))
  86       (insert (format "%-30s"
  87                       (propertize (symbol-name name)
  88                                   'face face
  89                                   'syntax-table (string-to-syntax "w")))
  90               "  "
  91               (if (stgit-patch-empty patch) "(empty) " "")
  92               (propertize (or (stgit-patch-desc patch) "")
  93                           'face 'stgit-description-face)))
  94     (insert "\n")
  95     (put-text-property start (point) 'entry-type 'patch)
  96     (when (memq name stgit-expanded-patches)
  97       (stgit-insert-patch-files patch))
  98     (put-text-property start (point) 'patch-data patch)))
  99
 100 (defun create-stgit-buffer (dir)
 101   "Create a buffer for showing StGit patches.
 102 Argument DIR is the repository path."
 103   (let ((buf (create-file-buffer (concat dir "*stgit*")))
 104         (inhibit-read-only t))
 105     (with-current-buffer buf
 106       (setq default-directory dir)
 107       (stgit-mode)
 108       (set (make-local-variable 'stgit-ewoc)
 109            (ewoc-create #'stgit-patch-pp "Branch:\n\n" "--\n" t))
 110       (setq buffer-read-only t))
 111     buf))
 112
 113 (defmacro stgit-capture-output (name &rest body)
 114   "Capture StGit output and, if there was any output, show it in a window
 115 at the end.
 116 Returns nil if there was no output."
 117   (declare (debug ([&or stringp null] body))
 118            (indent 1))
 119   `(let ((output-buf (get-buffer-create ,(or name "*StGit output*")))
 120          (stgit-dir default-directory)
 121          (inhibit-read-only t))
 122      (with-current-buffer output-buf
 123        (erase-buffer)
 124        (setq default-directory stgit-dir)
 125        (setq buffer-read-only t))
 126      (let ((standard-output output-buf))
 127        ,@body)
 128      (with-current-buffer output-buf
 129        (set-buffer-modified-p nil)
 130        (setq buffer-read-only t)
 131        (if (< (point-min) (point-max))
 132            (display-buffer output-buf t)))))
 133
 134 (defun stgit-make-run-args (args)
 135   "Return a copy of ARGS with its elements converted to strings."
 136   (mapcar (lambda (x)
 137             ;; don't use (format "%s" ...) to limit type errors
 138             (cond ((stringp x) x)
 139                   ((integerp x) (number-to-string x))
 140                   ((symbolp x) (symbol-name x))
 141                   (t
 142                    (error "Bad element in stgit-make-run-args args: %S" x))))
 143           args))
 144
 145 (defun stgit-run-silent (&rest args)
 146   (setq args (stgit-make-run-args args))
 147   (apply 'call-process "stg" nil standard-output nil args))
 148
 149 (defun stgit-run (&rest args)
 150   (setq args (stgit-make-run-args args))
 151   (let ((msgcmd (mapconcat #'identity args " ")))
 152     (message "Running stg %s..." msgcmd)
 153     (apply 'call-process "stg" nil standard-output nil args)
 154     (message "Running stg %s...done" msgcmd)))
 155
 156 (defun stgit-run-git (&rest args)
 157   (setq args (stgit-make-run-args args))
 158   (let ((msgcmd (mapconcat #'identity args " ")))
 159     (message "Running git %s..." msgcmd)
 160     (apply 'call-process "git" nil standard-output nil args)
 161     (message "Running git %s...done" msgcmd)))
 162
 163 (defun stgit-run-git-silent (&rest args)
 164   (setq args (stgit-make-run-args args))
 165   (apply 'call-process "git" nil standard-output nil args))
 166
 167 (defun stgit-index-empty-p ()
 168   "Returns non-nil if the index contains no changes from HEAD."
 169   (zerop (stgit-run-git-silent "diff-index" "--cached" "--quiet" "HEAD")))
 170
 171 (defvar stgit-index-node)
 172 (defvar stgit-worktree-node)
 173
 174 (defun stgit-refresh-index ()
 175   (when stgit-index-node
 176     (ewoc-invalidate (car stgit-index-node) (cdr stgit-index-node))))
 177
 178 (defun stgit-refresh-worktree ()
 179   (when stgit-worktree-node
 180     (ewoc-invalidate (car stgit-worktree-node) (cdr stgit-worktree-node))))
 181
 182 (defun stgit-run-series-insert-index (ewoc)
 183   (setq index-node    (cons ewoc (ewoc-enter-last ewoc
 184                                                   (make-stgit-patch
 185                                                    :status 'index
 186                                                    :name :index
 187                                                    :desc nil
 188                                                    :empty nil)))
 189         worktree-node (cons ewoc (ewoc-enter-last ewoc
 190                                                   (make-stgit-patch
 191                                                    :status 'work
 192                                                    :name :work
 193                                                    :desc nil
 194                                                    :empty nil)))))
 195
 196 (defun stgit-run-series (ewoc)
 197   (setq stgit-index-node nil
 198         stgit-worktree-node nil)
 199   (let ((inserted-index (not stgit-show-worktree))
 200         index-node
 201         worktree-node
 202         all-patchsyms)
 203     (with-temp-buffer
 204       (let ((exit-status (stgit-run-silent "series" "--description" "--empty")))
 205         (goto-char (point-min))
 206         (if (not (zerop exit-status))
 207             (cond ((looking-at "stg series: \\(.*\\)")
 208                    (setq inserted-index t)
 209                    (ewoc-set-hf ewoc (car (ewoc-get-hf ewoc))
 210                                 (substitute-command-keys
 211                                  "-- not initialized; run \\[stgit-init]")))
 212                   ((looking-at ".*")
 213                    (error "Error running stg: %s"
 214                           (match-string 0))))
 215           (while (not (eobp))
 216             (unless (looking-at
 217                      "\\([0 ]\\)\\([>+-]\\)\\( \\)\\([^ ]+\\) *[|#] \\(.*\\)")
 218               (error "Syntax error in output from stg series"))
 219             (let* ((state-str (match-string 2))
 220                    (state (cond ((string= state-str ">") 'top)
 221                                 ((string= state-str "+") 'applied)
 222                                 ((string= state-str "-") 'unapplied)))
 223                    (name (intern (match-string 4)))
 224                    (desc (match-string 5))
 225                    (empty (string= (match-string 1) "0")))
 226               (unless inserted-index
 227                 (when (or (eq stgit-show-worktree-mode 'top)
 228                           (and (eq stgit-show-worktree-mode 'center)
 229                                (eq state 'unapplied)))
 230                   (setq inserted-index t)
 231                   (stgit-run-series-insert-index ewoc)))
 232               (setq all-patchsyms (cons name all-patchsyms))
 233               (ewoc-enter-last ewoc
 234                                (make-stgit-patch
 235                                 :status state
 236                                 :name   name
 237                                 :desc   desc
 238                                 :empty  empty)))
 239             (forward-line 1))))
 240       (unless inserted-index
 241         (stgit-run-series-insert-index ewoc)))
 242     (setq stgit-index-node    index-node
 243           stgit-worktree-node worktree-node
 244           stgit-marked-patches (intersection stgit-marked-patches
 245                                              all-patchsyms))))
 246
 247 (defun stgit-reload ()
 248   "Update the contents of the StGit buffer."
 249   (interactive)
 250   (let ((inhibit-read-only t)
 251         (curline (line-number-at-pos))
 252         (curpatch (stgit-patch-name-at-point))
 253         (curfile (stgit-patched-file-at-point)))
 254     (ewoc-filter stgit-ewoc #'(lambda (x) nil))
 255     (ewoc-set-hf stgit-ewoc
 256                  (concat "Branch: "
 257                          (propertize
 258                           (with-temp-buffer
 259                             (stgit-run-silent "branch")
 260                             (buffer-substring (point-min) (1- (point-max))))
 261                           'face 'stgit-branch-name-face)
 262                          "\n\n")
 263                  (if stgit-show-worktree
 264                      "--"
 265                    (propertize
 266                     (substitute-command-keys "--\n\"\\[stgit-toggle-worktree]\"\
 267  shows the working tree\n")
 268                    'face 'stgit-description-face)))
 269     (stgit-run-series stgit-ewoc)
 270     (if curpatch
 271         (stgit-goto-patch curpatch (and curfile (stgit-file-file curfile)))
 272       (goto-line curline)))
 273   (stgit-refresh-git-status))
 274
 275 (defgroup stgit nil
 276   "A user interface for the StGit patch maintenance tool.
 277
 278 See `stgit-mode' for more information."
 279   :group 'tools)
 280
 281 (defface stgit-description-face
 282   '((((background dark)) (:foreground "tan"))
 283     (((background light)) (:foreground "dark red")))
 284   "The face used for StGit descriptions"
 285   :group 'stgit)
 286
 287 (defface stgit-branch-name-face
 288   '((t :inherit bold))
 289   "The face used for the StGit branch name"
 290   :group 'stgit)
 291
 292 (defface stgit-top-patch-face
 293   '((((background dark)) (:weight bold :foreground "yellow"))
 294     (((background light)) (:weight bold :foreground "purple"))
 295     (t (:weight bold)))
 296   "The face used for the top patch names"
 297   :group 'stgit)
 298
 299 (defface stgit-applied-patch-face
 300   '((((background dark)) (:foreground "light yellow"))
 301     (((background light)) (:foreground "purple"))
 302     (t ()))
 303   "The face used for applied patch names"
 304   :group 'stgit)
 305
 306 (defface stgit-unapplied-patch-face
 307   '((((background dark)) (:foreground "gray80"))
 308     (((background light)) (:foreground "orchid"))
 309     (t ()))
 310   "The face used for unapplied patch names"
 311   :group 'stgit)
 312
 313 (defface stgit-modified-file-face
 314   '((((class color) (background light)) (:foreground "purple"))
 315     (((class color) (background dark)) (:foreground "salmon")))
 316   "StGit mode face used for modified file status"
 317   :group 'stgit)
 318
 319 (defface stgit-unmerged-file-face
 320   '((((class color) (background light)) (:foreground "red" :bold t))
 321     (((class color) (background dark)) (:foreground "red" :bold t)))
 322   "StGit mode face used for unmerged file status"
 323   :group 'stgit)
 324
 325 (defface stgit-unknown-file-face
 326   '((((class color) (background light)) (:foreground "goldenrod" :bold t))
 327     (((class color) (background dark)) (:foreground "goldenrod" :bold t)))
 328   "StGit mode face used for unknown file status"
 329   :group 'stgit)
 330
 331 (defface stgit-ignored-file-face
 332   '((((class color) (background light)) (:foreground "grey60"))
 333     (((class color) (background dark)) (:foreground "grey40")))
 334   "StGit mode face used for ignored files")
 335
 336 (defface stgit-file-permission-face
 337   '((((class color) (background light)) (:foreground "green" :bold t))
 338     (((class color) (background dark)) (:foreground "green" :bold t)))
 339   "StGit mode face used for permission changes."
 340   :group 'stgit)
 341
 342 (defface stgit-index-work-tree-title-face
 343   '((((supports :slant italic)) :slant italic)
 344     (t :inherit bold))
 345   "StGit mode face used for the \"Index\" and \"Work tree\" titles"
 346   :group 'stgit)
 347
 348
 349 (defcustom stgit-find-copies-harder
 350   nil
 351   "Try harder to find copied files when listing patches.
 352
 353 When not nil, runs git diff-tree with the --find-copies-harder
 354 flag, which reduces performance."
 355   :type 'boolean
 356   :group 'stgit)
 357
 358 (defconst stgit-file-status-code-strings
 359   (mapcar (lambda (arg)
 360             (cons (car arg)
 361                   (propertize (cadr arg) 'face (car (cddr arg)))))
 362           '((add         "Added"       stgit-modified-file-face)
 363             (copy        "Copied"      stgit-modified-file-face)
 364             (delete      "Deleted"     stgit-modified-file-face)
 365             (modify      "Modified"    stgit-modified-file-face)
 366             (rename      "Renamed"     stgit-modified-file-face)
 367             (mode-change "Mode change" stgit-modified-file-face)
 368             (unmerged    "Unmerged"    stgit-unmerged-file-face)
 369             (unknown     "Unknown"     stgit-unknown-file-face)
 370             (ignore      "Ignored"     stgit-ignored-file-face)))
 371   "Alist of code symbols to description strings")
 372
 373 (defconst stgit-patch-status-face-alist
 374   '((applied   . stgit-applied-patch-face)
 375     (top       . stgit-top-patch-face)
 376     (unapplied . stgit-unapplied-patch-face)
 377     (index     . stgit-index-work-tree-title-face)
 378     (work      . stgit-index-work-tree-title-face))
 379   "Alist of face to use for a given patch status")
 380
 381 (defun stgit-file-status-code-as-string (file)
 382   "Return stgit status code for FILE as a string"
 383   (let* ((code (assq (stgit-file-status file)
 384                      stgit-file-status-code-strings))
 385          (score (stgit-file-cr-score file)))
 386     (when code
 387       (format "%-11s  "
 388               (if (and score (/= score 100))
 389                   (format "%s %s" (cdr code)
 390                           (propertize (format "%d%%" score)
 391                                       'face 'stgit-description-face))
 392                 (cdr code))))))
 393
 394 (defun stgit-file-status-code (str &optional score)
 395   "Return stgit status code from git status string"
 396   (let ((code (assoc str '(("A" . add)
 397                            ("C" . copy)
 398                            ("D" . delete)
 399                            ("I" . ignore)
 400                            ("M" . modify)
 401                            ("R" . rename)
 402                            ("T" . mode-change)
 403                            ("U" . unmerged)
 404                            ("X" . unknown)))))
 405     (setq code (if code (cdr code) 'unknown))
 406     (when (stringp score)
 407       (if (> (length score) 0)
 408           (setq score (string-to-number score))
 409         (setq score nil)))
 410     (if score (cons code score) code)))
 411
 412 (defconst stgit-file-type-strings
 413   '((#o100 . "file")
 414     (#o120 . "symlink")
 415     (#o160 . "subproject"))
 416   "Alist of names of file types")
 417
 418 (defun stgit-file-type-string (type)
 419   "Return string describing file type TYPE (the high bits of file permission).
 420 Cf. `stgit-file-type-strings' and `stgit-file-type-change-string'."
 421   (let ((type-str (assoc type stgit-file-type-strings)))
 422     (or (and type-str (cdr type-str))
 423         (format "unknown type %o" type))))
 424
 425 (defun stgit-file-type-change-string (old-perm new-perm)
 426   "Return string describing file type change from OLD-PERM to NEW-PERM.
 427 Cf. `stgit-file-type-string'."
 428   (let ((old-type (lsh old-perm -9))
 429         (new-type (lsh new-perm -9)))
 430     (cond ((= old-type new-type) "")
 431           ((zerop new-type) "")
 432           ((zerop old-type)
 433            (if (= new-type #o100)
 434                ""
 435              (format "   (%s)" (stgit-file-type-string new-type))))
 436           (t (format "   (%s -> %s)"
 437                      (stgit-file-type-string old-type)
 438                      (stgit-file-type-string new-type))))))
 439
 440 (defun stgit-file-mode-change-string (old-perm new-perm)
 441   "Return string describing file mode change from OLD-PERM to NEW-PERM.
 442 Cf. `stgit-file-type-change-string'."
 443   (setq old-perm (logand old-perm #o777)
 444         new-perm (logand new-perm #o777))
 445   (if (or (= old-perm new-perm)
 446           (zerop old-perm)
 447           (zerop new-perm))
 448       ""
 449     (let* ((modified       (logxor old-perm new-perm))
 450            (not-x-modified (logand (logxor old-perm new-perm) #o666)))
 451       (cond ((zerop modified) "")
 452             ((and (zerop not-x-modified)
 453                   (or (and (eq #o111 (logand old-perm #o111))
 454                            (propertize "-x" 'face 'stgit-file-permission-face))
 455                       (and (eq #o111 (logand new-perm #o111))
 456                            (propertize "+x" 'face
 457                                        'stgit-file-permission-face)))))
 458             (t (concat (propertize (format "%o" old-perm)
 459                                    'face 'stgit-file-permission-face)
 460                        (propertize " -> "
 461                                    'face 'stgit-description-face)
 462                        (propertize (format "%o" new-perm)
 463                                    'face 'stgit-file-permission-face)))))))
 464
 465 (defstruct (stgit-file)
 466   old-perm new-perm copy-or-rename cr-score cr-from cr-to status file)
 467
 468 (defun stgit-describe-copy-or-rename (file)
 469   (let (from to common-head common-tail
 470         (arrow (concat " "
 471                        (propertize "->" 'face 'stgit-description-face)
 472                        " ")))
 473
 474     (when stgit-abbreviate-copies-and-renames
 475       (setq from (split-string (stgit-file-cr-from file) "/")
 476             to   (split-string (stgit-file-cr-to   file) "/"))
 477
 478       (while (and from to (cdr from) (cdr to)
 479                   (string-equal (car from) (car to)))
 480         (setq common-head (cons (car from) common-head)
 481               from        (cdr from)
 482               to          (cdr to)))
 483       (setq common-head (nreverse common-head)
 484             from        (nreverse from)
 485             to          (nreverse to))
 486       (while (and from to (cdr from) (cdr to)
 487                   (string-equal (car from) (car to)))
 488         (setq common-tail (cons (car from) common-tail)
 489               from        (cdr from)
 490               to          (cdr to)))
 491       (setq from (nreverse from)
 492             to   (nreverse to)))
 493
 494     (if (or common-head common-tail)
 495         (concat (if common-head
 496                     (mapconcat #'identity common-head "/")
 497                   "")
 498                 (if common-head "/" "")
 499                 (propertize "{" 'face 'stgit-description-face)
 500                 (mapconcat #'identity from "/")
 501                 arrow
 502                 (mapconcat #'identity to "/")
 503                 (propertize "}" 'face 'stgit-description-face)
 504                 (if common-tail "/" "")
 505                 (if common-tail
 506                     (mapconcat #'identity common-tail "/")
 507                   ""))
 508       (concat (stgit-file-cr-from file) arrow (stgit-file-cr-to file)))))
 509
 510 (defun stgit-file-pp (file)
 511   (let ((status (stgit-file-status file))
 512         (name (if (stgit-file-copy-or-rename file)
 513                   (stgit-describe-copy-or-rename file)
 514                 (stgit-file-file file)))
 515         (mode-change (stgit-file-mode-change-string
 516                       (stgit-file-old-perm file)
 517                       (stgit-file-new-perm file)))
 518         (start (point)))
 519     (insert (format "    %-12s%s%s%s%s\n"
 520                     (stgit-file-status-code-as-string file)
 521                     mode-change
 522                     (if (zerop (length mode-change)) "" " ")
 523                     name
 524                     (propertize (stgit-file-type-change-string
 525                                  (stgit-file-old-perm file)
 526                                  (stgit-file-new-perm file))
 527                                 'face 'stgit-description-face)))
 528     (add-text-properties start (point)
 529                          (list 'entry-type 'file
 530                                'file-data file))))
 531
 532 (defun stgit-find-copies-harder-diff-arg ()
 533   "Return the flag to use with `git-diff' depending on the
 534 `stgit-find-copies-harder' flag."
 535   (if stgit-find-copies-harder "--find-copies-harder" "-C"))
 536
 537 (defun stgit-insert-ls-files (args file-flag)
 538   (let ((start (point)))
 539     (apply 'stgit-run-git
 540            (append '("ls-files" "--exclude-standard" "-z") args))
 541     (goto-char start)
 542     (while (looking-at "\\([^\0]*\\)\0")
 543       (let ((name-len (- (match-end 0) (match-beginning 0))))
 544         (insert ":0 0 0000000000000000000000000000000000000000 0000000000000000000000000000000000000000 " file-flag "\0")
 545         (forward-char name-len)))))
 546
 547 (defun stgit-insert-patch-files (patch)
 548   "Expand (show modification of) the patch PATCH after the line
 549 at point."
 550   (let* ((patchsym (stgit-patch-name patch))
 551          (end      (point-marker))
 552          (args     (list "-z" (stgit-find-copies-harder-diff-arg)))
 553          (ewoc     (ewoc-create #'stgit-file-pp nil nil t)))
 554     (set-marker-insertion-type end t)
 555     (setf (stgit-patch-files-ewoc patch) ewoc)
 556     (with-temp-buffer
 557       (apply 'stgit-run-git
 558              (cond ((eq patchsym :work)
 559                     `("diff-files" "-0" ,@args))
 560                    ((eq patchsym :index)
 561                     `("diff-index" ,@args "--cached" "HEAD"))
 562                    (t
 563                     `("diff-tree" ,@args "-r" ,(stgit-id patchsym)))))
 564
 565       (when (and (eq patchsym :work))
 566         (when stgit-show-ignored
 567           (stgit-insert-ls-files '("--ignored" "--others") "I"))
 568         (when stgit-show-unknown
 569           (stgit-insert-ls-files '("--others") "X"))
 570         (sort-regexp-fields nil ":[^\0]*\0\\([^\0]*\\)\0" "\\1"
 571                             (point-min) (point-max)))
 572
 573       (goto-char (point-min))
 574       (unless (or (eobp) (memq patchsym '(:work :index)))
 575         (forward-char 41))
 576       (while (looking-at ":\\([0-7]+\\) \\([0-7]+\\) [0-9A-Fa-f]\\{40\\} [0-9A-Fa-f]\\{40\\} ")
 577         (let ((old-perm (string-to-number (match-string 1) 8))
 578               (new-perm (string-to-number (match-string 2) 8)))
 579           (goto-char (match-end 0))
 580           (let ((file
 581                  (cond ((looking-at
 582                          "\\([CR]\\)\\([0-9]*\\)\0\\([^\0]*\\)\0\\([^\0]*\\)\0")
 583                         (let* ((patch-status (stgit-patch-status patch))
 584                                (file-subexp  (if (eq patch-status 'unapplied)
 585                                                  3
 586                                                4))
 587                                (file         (match-string file-subexp)))
 588                           (make-stgit-file
 589                            :old-perm       old-perm
 590                            :new-perm       new-perm
 591                            :copy-or-rename t
 592                            :cr-score       (string-to-number (match-string 2))
 593                            :cr-from        (match-string 3)
 594                            :cr-to          (match-string 4)
 595                            :status         (stgit-file-status-code
 596                                             (match-string 1))
 597                            :file           file)))
 598                        ((looking-at "\\([ABD-QS-Z]\\)\0\\([^\0]*\\)\0")
 599                         (make-stgit-file
 600                          :old-perm       old-perm
 601                          :new-perm       new-perm
 602                          :copy-or-rename nil
 603                          :cr-score       nil
 604                          :cr-from        nil
 605                          :cr-to          nil
 606                          :status         (stgit-file-status-code
 607                                           (match-string 1))
 608                          :file           (match-string 2))))))
 609             (goto-char (match-end 0))
 610             (ewoc-enter-last ewoc file))))
 611
 612       (unless (ewoc-nth ewoc 0)
 613         (ewoc-set-hf ewoc ""
 614                      (concat "    "
 615                              (propertize "<no files>"
 616                                          'face 'stgit-description-face)
 617                              "\n"))))
 618     (goto-char end)))
 619
 620 (defun stgit-find-file (&optional other-window)
 621   (let* ((file (or (stgit-patched-file-at-point)
 622                    (error "No file at point")))
 623          (filename (expand-file-name (stgit-file-file file))))
 624     (unless (file-exists-p filename)
 625       (error "File does not exist"))
 626     (funcall (if other-window 'find-file-other-window 'find-file)
 627              filename)
 628     (when (eq (stgit-file-status file) 'unmerged)
 629       (smerge-mode 1))))
 630
 631 (defun stgit-select-patch ()
 632   (let ((patchname (stgit-patch-name-at-point)))
 633     (if (memq patchname stgit-expanded-patches)
 634         (setq stgit-expanded-patches (delq patchname stgit-expanded-patches))
 635       (setq stgit-expanded-patches (cons patchname stgit-expanded-patches)))
 636     (ewoc-invalidate stgit-ewoc (ewoc-locate stgit-ewoc)))
 637   (move-to-column (stgit-goal-column)))
 638
 639 (defun stgit-select ()
 640   "With point on a patch, toggle showing files in the patch.
 641
 642 With point on a file, open the associated file. Opens the target
 643 file for (applied) copies and renames."
 644   (interactive)
 645   (case (get-text-property (point) 'entry-type)
 646     ('patch
 647      (stgit-select-patch))
 648     ('file
 649      (stgit-find-file))
 650     (t
 651      (error "No patch or file on line"))))
 652
 653 (defun stgit-find-file-other-window ()
 654   "Open file at point in other window"
 655   (interactive)
 656   (stgit-find-file t))
 657
 658 (defun stgit-find-file-merge ()
 659   "Open file at point and merge it using `smerge-ediff'."
 660   (interactive)
 661   (stgit-find-file t)
 662   (smerge-ediff))
 663
 664 (defun stgit-quit ()
 665   "Hide the stgit buffer."
 666   (interactive)
 667   (bury-buffer))
 668
 669 (defun stgit-git-status ()
 670   "Show status using `git-status'."
 671   (interactive)
 672   (unless (fboundp 'git-status)
 673     (error "The stgit-git-status command requires git-status"))
 674   (let ((dir default-directory))
 675     (save-selected-window
 676       (pop-to-buffer nil)
 677       (git-status dir))))
 678
 679 (defun stgit-goal-column ()
 680   "Return goal column for the current line"
 681   (case (get-text-property (point) 'entry-type)
 682     ('patch 2)
 683     ('file 4)
 684     (t 0)))
 685
 686 (defun stgit-next-line (&optional arg)
 687   "Move cursor vertically down ARG lines"
 688   (interactive "p")
 689   (next-line arg)
 690   (move-to-column (stgit-goal-column)))
 691
 692 (defun stgit-previous-line (&optional arg)
 693   "Move cursor vertically up ARG lines"
 694   (interactive "p")
 695   (previous-line arg)
 696   (move-to-column (stgit-goal-column)))
 697
 698 (defun stgit-next-patch (&optional arg)
 699   "Move cursor down ARG patches."
 700   (interactive "p")
 701   (ewoc-goto-next stgit-ewoc (or arg 1))
 702   (move-to-column goal-column))
 703
 704 (defun stgit-previous-patch (&optional arg)
 705   "Move cursor up ARG patches."
 706   (interactive "p")
 707   (ewoc-goto-prev stgit-ewoc (or arg 1))
 708   (move-to-column goal-column))
 709
 710 (defvar stgit-mode-hook nil
 711   "Run after `stgit-mode' is setup.")
 712
 713 (defvar stgit-mode-map nil
 714   "Keymap for StGit major mode.")
 715
 716 (unless stgit-mode-map
 717   (let ((diff-map   (make-keymap))
 718         (toggle-map (make-keymap)))
 719     (suppress-keymap diff-map)
 720     (mapc (lambda (arg) (define-key diff-map (car arg) (cdr arg)))
 721           '(("b" .        stgit-diff-base)
 722             ("c" .        stgit-diff-combined)
 723             ("m" .        stgit-find-file-merge)
 724             ("o" .        stgit-diff-ours)
 725             ("t" .        stgit-diff-theirs)))
 726     (suppress-keymap toggle-map)
 727     (mapc (lambda (arg) (define-key toggle-map (car arg) (cdr arg)))
 728           '(("t" .        stgit-toggle-worktree)
 729             ("i" .        stgit-toggle-ignored)
 730             ("u" .        stgit-toggle-unknown)))
 731     (setq stgit-mode-map (make-keymap))
 732     (suppress-keymap stgit-mode-map)
 733     (mapc (lambda (arg) (define-key stgit-mode-map (car arg) (cdr arg)))
 734           `((" " .        stgit-mark)
 735             ("m" .        stgit-mark)
 736             ("\d" .       stgit-unmark-up)
 737             ("u" .        stgit-unmark-down)
 738             ("?" .        stgit-help)
 739             ("h" .        stgit-help)
 740             ("\C-p" .     stgit-previous-line)
 741             ("\C-n" .     stgit-next-line)
 742             ([up] .       stgit-previous-line)
 743             ([down] .     stgit-next-line)
 744             ("p" .        stgit-previous-patch)
 745             ("n" .        stgit-next-patch)
 746             ("\M-{" .     stgit-previous-patch)
 747             ("\M-}" .     stgit-next-patch)
 748             ("s" .        stgit-git-status)
 749             ("g" .        stgit-reload-or-repair)
 750             ("r" .        stgit-refresh)
 751             ("\C-c\C-r" . stgit-rename)
 752             ("e" .        stgit-edit)
 753             ("M" .        stgit-move-patches)
 754             ("S" .        stgit-squash)
 755             ("N" .        stgit-new)
 756             ("\C-c\C-c" . stgit-commit)
 757             ("\C-c\C-u" . stgit-uncommit)
 758             ("U" .        stgit-revert-file)
 759             ("R" .        stgit-resolve-file)
 760             ("\r" .       stgit-select)
 761             ("o" .        stgit-find-file-other-window)
 762             ("i" .        stgit-file-toggle-index)
 763             (">" .        stgit-push-next)
 764             ("<" .        stgit-pop-next)
 765             ("P" .        stgit-push-or-pop)
 766             ("G" .        stgit-goto)
 767             ("=" .        stgit-diff)
 768             ("D" .        stgit-delete)
 769             ([?\C-/] .    stgit-undo)
 770             ("\C-_" .     stgit-undo)
 771             ([?\C-c ?\C-/] . stgit-redo)
 772             ("\C-c\C-_" . stgit-redo)
 773             ("B" .        stgit-branch)
 774             ("\C-c\C-b" . stgit-rebase)
 775             ("t" .        ,toggle-map)
 776             ("d" .        ,diff-map)
 777             ("q" .        stgit-quit)))))
 778
 779 (defun stgit-mode ()
 780   "Major mode for interacting with StGit.
 781
 782 Start StGit using \\[stgit].
 783
 784 Basic commands:
 785 \\<stgit-mode-map>\
 786 \\[stgit-help]  Show this help text
 787 \\[stgit-quit]  Hide the StGit buffer
 788 \\[describe-bindings]   Show all key bindings
 789
 790 \\[stgit-reload-or-repair]      Reload the StGit buffer
 791 \\[universal-argument] \\[stgit-reload-or-repair]       Repair StGit metadata
 792
 793 \\[stgit-undo]  Undo most recent StGit operation
 794 \\[stgit-redo]  Undo recent undo
 795
 796 \\[stgit-git-status]    Run `git-status' (if available)
 797
 798 Movement commands:
 799 \\[stgit-previous-line] Move to previous line
 800 \\[stgit-next-line]     Move to next line
 801 \\[stgit-previous-patch]        Move to previous patch
 802 \\[stgit-next-patch]    Move to next patch
 803
 804 \\[stgit-mark]  Mark patch
 805 \\[stgit-unmark-up]     Unmark patch and move up
 806 \\[stgit-unmark-down]   Unmark patch and move down
 807
 808 Commands for patches:
 809 \\[stgit-select]        Toggle showing changed files in patch
 810 \\[stgit-refresh]       Refresh patch with changes in index or work tree
 811 \\[stgit-diff]  Show the patch log and diff
 812
 813 \\[stgit-new]   Create a new, empty patch
 814 \\[stgit-rename]        Rename patch
 815 \\[stgit-edit]  Edit patch description
 816 \\[stgit-delete]        Delete patch(es)
 817
 818 \\[stgit-push-next]     Push next patch onto stack
 819 \\[stgit-pop-next]      Pop current patch from stack
 820 \\[stgit-push-or-pop]   Push or pop patch at point
 821 \\[stgit-goto]  Make current patch current by popping or pushing
 822
 823 \\[stgit-squash]        Squash (meld together) patches
 824 \\[stgit-move-patches]  Move patch(es) to point
 825
 826 \\[stgit-commit]        Commit patch(es)
 827 \\[stgit-uncommit]      Uncommit patch(es)
 828
 829 Commands for files:
 830 \\[stgit-select]        Open the file in this window
 831 \\[stgit-find-file-other-window]        Open the file in another window
 832 \\[stgit-diff]  Show the file's diff
 833
 834 \\[stgit-file-toggle-index]     Toggle change between index and work tree
 835 \\[stgit-revert-file]   Revert changes to file
 836
 837 Display commands:
 838 \\[stgit-toggle-worktree]       Toggle showing index and work tree
 839 \\[stgit-toggle-unknown]        Toggle showing unknown files
 840 \\[stgit-toggle-ignored]        Toggle showing ignored files
 841
 842 Commands for diffs:
 843 \\[stgit-diff]  Show diff of patch or file
 844 \\[stgit-diff-base]     Show diff against the merge base
 845 \\[stgit-diff-ours]     Show diff against our branch
 846 \\[stgit-diff-theirs]   Show diff against their branch
 847
 848   With one prefix argument (e.g., \\[universal-argument] \\[stgit-diff]), \
 849 ignore space changes.
 850   With two prefix arguments (e.g., \\[universal-argument] \
 851 \\[universal-argument] \\[stgit-diff]), ignore all space changes.
 852
 853 Commands for merge conflicts:
 854 \\[stgit-find-file-merge]       Resolve conflicts using `smerge-ediff'
 855 \\[stgit-resolve-file]  Mark unmerged file as resolved
 856
 857 Commands for branches:
 858 \\[stgit-branch]        Switch to another branch
 859 \\[stgit-rebase]        Rebase the current branch
 860
 861 Customization variables:
 862 `stgit-abbreviate-copies-and-renames'
 863 `stgit-default-show-worktree'
 864 `stgit-find-copies-harder'
 865 `stgit-show-worktree-mode'
 866
 867 See also \\[customize-group] for the \"stgit\" group."
 868   (kill-all-local-variables)
 869   (buffer-disable-undo)
 870   (setq mode-name "StGit"
 871         major-mode 'stgit-mode
 872         goal-column 2)
 873   (use-local-map stgit-mode-map)
 874   (set (make-local-variable 'list-buffers-directory) default-directory)
 875   (set (make-local-variable 'stgit-marked-patches) nil)
 876   (set (make-local-variable 'stgit-expanded-patches) (list :work :index))
 877   (set (make-local-variable 'stgit-show-worktree) stgit-default-show-worktree)
 878   (set (make-local-variable 'stgit-index-node) nil)
 879   (set (make-local-variable 'stgit-worktree-node) nil)
 880   (set (make-local-variable 'parse-sexp-lookup-properties) t)
 881   (set-variable 'truncate-lines 't)
 882   (add-hook 'after-save-hook 'stgit-update-saved-file)
 883   (run-hooks 'stgit-mode-hook))
 884
 885 (defun stgit-update-saved-file ()
 886   (let* ((file (expand-file-name buffer-file-name))
 887          (dir (file-name-directory file))
 888          (gitdir (condition-case nil (git-get-top-dir dir)
 889                    (error nil)))
 890          (buffer (and gitdir (stgit-find-buffer gitdir))))
 891     (when buffer
 892       (with-current-buffer buffer
 893         (stgit-refresh-worktree)))))
 894
 895 (defun stgit-add-mark (patchsym)
 896   "Mark the patch PATCHSYM."
 897   (setq stgit-marked-patches (cons patchsym stgit-marked-patches)))
 898
 899 (defun stgit-remove-mark (patchsym)
 900   "Unmark the patch PATCHSYM."
 901   (setq stgit-marked-patches (delq patchsym stgit-marked-patches)))
 902
 903 (defun stgit-clear-marks ()
 904   "Unmark all patches."
 905   (setq stgit-marked-patches '()))
 906
 907 (defun stgit-patch-at-point (&optional cause-error)
 908   (get-text-property (point) 'patch-data))
 909
 910 (defun stgit-patch-name-at-point (&optional cause-error only-patches)
 911   "Return the patch name on the current line as a symbol.
 912 If CAUSE-ERROR is not nil, signal an error if none found.
 913 If ONLY-PATCHES is not nil, only allow real patches, and not
 914 index or work tree."
 915   (let ((patch (stgit-patch-at-point)))
 916     (and patch
 917          only-patches
 918          (memq (stgit-patch-status patch) '(work index))
 919          (setq patch nil))
 920     (cond (patch
 921            (stgit-patch-name patch))
 922           (cause-error
 923            (error "No patch on this line")))))
 924
 925 (defun stgit-patched-file-at-point ()
 926   (get-text-property (point) 'file-data))
 927
 928 (defun stgit-patches-marked-or-at-point ()
 929   "Return the symbols of the marked patches, or the patch on the current line."
 930   (if stgit-marked-patches
 931       stgit-marked-patches
 932     (let ((patch (stgit-patch-name-at-point)))
 933       (if patch
 934           (list patch)
 935         '()))))
 936
 937 (defun stgit-goto-patch (patchsym &optional file)
 938   "Move point to the line containing patch PATCHSYM.
 939 If that patch cannot be found, do nothing.
 940
 941 If the patch was found and FILE is not nil, instead move to that
 942 file's line. If FILE cannot be found, stay on the line of
 943 PATCHSYM."
 944   (let ((node (ewoc-nth stgit-ewoc 0)))
 945     (while (and node (not (eq (stgit-patch-name (ewoc-data node))
 946                               patchsym)))
 947       (setq node (ewoc-next stgit-ewoc node)))
 948     (when (and node file)
 949       (let* ((file-ewoc (stgit-patch-files-ewoc (ewoc-data node)))
 950              (file-node (ewoc-nth file-ewoc 0)))
 951         (while (and file-node (not (equal (stgit-file-file (ewoc-data file-node)) file)))
 952           (setq file-node (ewoc-next file-ewoc file-node)))
 953         (when file-node
 954           (ewoc-goto-node file-ewoc file-node)
 955           (move-to-column (stgit-goal-column))
 956           (setq node nil))))
 957     (when node
 958       (ewoc-goto-node stgit-ewoc node)
 959       (move-to-column goal-column))))
 960
 961 (defun stgit-init ()
 962   "Run stg init."
 963   (interactive)
 964   (stgit-capture-output nil
 965     (stgit-run "init"))
 966   (stgit-reload))
 967
 968 (defun stgit-mark ()
 969   "Mark the patch under point."
 970   (interactive)
 971   (let* ((node (ewoc-locate stgit-ewoc))
 972          (patch (ewoc-data node))
 973          (name (stgit-patch-name patch)))
 974     (when (eq name :work)
 975       (error "Cannot mark the work tree"))
 976     (when (eq name :index)
 977       (error "Cannot mark the index"))
 978     (stgit-add-mark (stgit-patch-name patch))
 979     (ewoc-invalidate stgit-ewoc node))
 980   (stgit-next-patch))
 981
 982 (defun stgit-unmark-up ()
 983   "Remove mark from the patch on the previous line."
 984   (interactive)
 985   (stgit-previous-patch)
 986   (let* ((node (ewoc-locate stgit-ewoc))
 987          (patch (ewoc-data node)))
 988     (stgit-remove-mark (stgit-patch-name patch))
 989     (ewoc-invalidate stgit-ewoc node))
 990   (move-to-column (stgit-goal-column)))
 991
 992 (defun stgit-unmark-down ()
 993   "Remove mark from the patch on the current line."
 994   (interactive)
 995   (let* ((node (ewoc-locate stgit-ewoc))
 996          (patch (ewoc-data node)))
 997     (stgit-remove-mark (stgit-patch-name patch))
 998     (ewoc-invalidate stgit-ewoc node))
 999   (stgit-next-patch))
1000
1001 (defun stgit-rename (name)
1002   "Rename the patch under point to NAME."
1003   (interactive (list
1004                 (read-string "Patch name: "
1005                              (symbol-name (stgit-patch-name-at-point t t)))))
1006   (let ((old-patchsym (stgit-patch-name-at-point t t)))
1007     (stgit-capture-output nil
1008       (stgit-run "rename" old-patchsym name))
1009     (let ((name-sym (intern name)))
1010       (when (memq old-patchsym stgit-expanded-patches)
1011         (setq stgit-expanded-patches
1012             (cons name-sym (delq old-patchsym stgit-expanded-patches))))
1013       (when (memq old-patchsym stgit-marked-patches)
1014         (setq stgit-marked-patches
1015             (cons name-sym (delq old-patchsym stgit-marked-patches))))
1016       (stgit-reload)
1017       (stgit-goto-patch name-sym))))
1018
1019 (defun stgit-reload-or-repair (repair)
1020   "Update the contents of the StGit buffer (`stgit-reload').
1021
1022 With a prefix argument, repair the StGit metadata if the branch
1023 was modified with git commands (`stgit-repair')."
1024   (interactive "P")
1025   (if repair
1026       (stgit-repair)
1027     (stgit-reload)))
1028
1029 (defun stgit-repair ()
1030   "Run stg repair."
1031   (interactive)
1032   (stgit-capture-output nil
1033     (stgit-run "repair"))
1034   (stgit-reload))
1035
1036 (defun stgit-available-branches ()
1037   "Returns a list of the available stg branches"
1038   (let ((output (with-output-to-string
1039                   (stgit-run "branch" "--list")))
1040         (start 0)
1041         result)
1042     (while (string-match "^>?\\s-+s\\s-+\\(\\S-+\\)" output start)
1043       (setq result (cons (match-string 1 output) result))
1044       (setq start (match-end 0)))
1045     result))
1046
1047 (defun stgit-branch (branch)
1048   "Switch to branch BRANCH."
1049   (interactive (list (completing-read "Switch to branch: "
1050                                       (stgit-available-branches))))
1051   (stgit-capture-output nil (stgit-run "branch" "--" branch))
1052   (stgit-reload))
1053
1054 (defun stgit-available-refs (&optional omit-stgit)
1055   "Returns a list of the available git refs.
1056 If OMIT-STGIT is not nil, filter out \"resf/heads/*.stgit\"."
1057   (let* ((output (with-output-to-string
1058                    (stgit-run-git-silent "for-each-ref" "--format=%(refname)"
1059                                          "refs/tags" "refs/heads"
1060                                          "refs/remotes")))
1061          (result (split-string output "\n" t)))
1062     (mapcar (lambda (s)
1063               (if (string-match "^refs/\\(heads\\|tags\\|remotes\\)/" s)
1064                   (substring s (match-end 0))
1065                 s))
1066             (if omit-stgit
1067                 (delete-if (lambda (s)
1068                              (string-match "^refs/heads/.*\\.stgit$" s))
1069                            result)
1070               result))))
1071
1072 (defun stgit-rebase (new-base)
1073   "Rebase to NEW-BASE."
1074   (interactive (list (completing-read "Rebase to: "
1075                                       (stgit-available-refs t))))
1076   (stgit-capture-output nil (stgit-run "rebase" new-base))
1077   (stgit-reload))
1078
1079 (defun stgit-commit (count)
1080   "Run stg commit on COUNT commits.
1081 Interactively, the prefix argument is used as COUNT.
1082 A negative COUNT will uncommit instead."
1083   (interactive "p")
1084   (if (< count 0)
1085       (stgit-uncommit (- count))
1086     (stgit-capture-output nil (stgit-run "commit" "-n" count))
1087     (stgit-reload)))
1088
1089 (defun stgit-uncommit (count)
1090   "Run stg uncommit on COUNT commits.
1091 Interactively, the prefix argument is used as COUNT.
1092 A negative COUNT will commit instead."
1093   (interactive "p")
1094   (if (< count 0)
1095       (stgit-commit (- count))
1096     (stgit-capture-output nil (stgit-run "uncommit" "-n" count))
1097     (stgit-reload)))
1098
1099 (defun stgit-neighbour-file ()
1100   "Return the file name of the next file after point, or the
1101 previous file if point is at the last file within a patch."
1102   (let ((old-point (point))
1103         neighbour-file)
1104     (and (zerop (forward-line 1))
1105          (let ((f (stgit-patched-file-at-point)))
1106            (and f (setq neighbour-file (stgit-file-file f)))))
1107     (goto-char old-point)
1108     (unless neighbour-file
1109       (and (zerop (forward-line -1))
1110            (let ((f (stgit-patched-file-at-point)))
1111              (and f (setq neighbour-file (stgit-file-file f)))))
1112       (goto-char old-point))
1113     neighbour-file))
1114
1115 (defun stgit-revert-file ()
1116   "Revert the file at point, which must be in the index or the
1117 working tree."
1118   (interactive)
1119   (let* ((patched-file (or (stgit-patched-file-at-point)
1120                            (error "No file on the current line")))
1121          (patch-name   (stgit-patch-name-at-point))
1122          (file-status  (stgit-file-status patched-file))
1123          (rm-file      (cond ((stgit-file-copy-or-rename patched-file)
1124                               (stgit-file-cr-to patched-file))
1125                              ((eq file-status 'add)
1126                               (stgit-file-file patched-file))))
1127          (co-file      (cond ((eq file-status 'rename)
1128                               (stgit-file-cr-from patched-file))
1129                              ((not (memq file-status '(copy add)))
1130                               (stgit-file-file patched-file))))
1131          (next-file    (stgit-neighbour-file)))
1132
1133     (unless (memq patch-name '(:work :index))
1134       (error "No index or working tree file on this line"))
1135
1136     (when (eq file-status 'ignore)
1137       (error "Cannot revert ignored files"))
1138
1139     (when (eq file-status 'unknown)
1140       (error "Cannot revert unknown files"))
1141
1142     (let ((nfiles (+ (if rm-file 1 0) (if co-file 1 0))))
1143       (when (yes-or-no-p (format "Revert %d file%s? "
1144                                  nfiles
1145                                  (if (= nfiles 1) "" "s")))
1146         (stgit-capture-output nil
1147           (when rm-file
1148             (stgit-run-git "rm" "-f" "-q" "--" rm-file))
1149           (when co-file
1150             (stgit-run-git "checkout" "HEAD" co-file)))
1151         (stgit-reload)
1152         (stgit-goto-patch patch-name next-file)))))
1153
1154 (defun stgit-resolve-file ()
1155   "Resolve conflict in the file at point."
1156   (interactive)
1157   (let* ((patched-file (stgit-patched-file-at-point))
1158          (patch        (stgit-patch-at-point))
1159          (patch-name   (and patch (stgit-patch-name patch)))
1160          (status       (and patched-file (stgit-file-status patched-file))))
1161
1162     (unless (memq patch-name '(:work :index))
1163       (error "No index or working tree file on this line"))
1164
1165     (unless (eq status 'unmerged)
1166       (error "No conflict to resolve at the current line"))
1167
1168     (stgit-capture-output nil
1169       (stgit-move-change-to-index (stgit-file-file patched-file)))
1170
1171     (stgit-reload)))
1172
1173 (defun stgit-push-next (npatches)
1174   "Push the first unapplied patch.
1175 With numeric prefix argument, push that many patches."
1176   (interactive "p")
1177   (stgit-capture-output nil (stgit-run "push" "-n" npatches))
1178   (stgit-reload)
1179   (stgit-refresh-git-status))
1180
1181 (defun stgit-pop-next (npatches)
1182   "Pop the topmost applied patch.
1183 With numeric prefix argument, pop that many patches."
1184   (interactive "p")
1185   (stgit-capture-output nil (stgit-run "pop" "-n" npatches))
1186   (stgit-reload)
1187   (stgit-refresh-git-status))
1188
1189 (defun stgit-applied-at-point ()
1190   "Is the patch on the current line applied?"
1191   (save-excursion
1192     (beginning-of-line)
1193     (looking-at "[>+]")))
1194
1195 (defun stgit-push-or-pop ()
1196   "Push or pop the patch on the current line."
1197   (interactive)
1198   (let ((patchsym (stgit-patch-name-at-point t))
1199         (applied (stgit-applied-at-point)))
1200     (stgit-capture-output nil
1201       (stgit-run (if applied "pop" "push") patchsym))
1202     (stgit-reload)))
1203
1204 (defun stgit-goto ()
1205   "Go to the patch on the current line."
1206   (interactive)
1207   (let ((patchsym (stgit-patch-name-at-point t)))
1208     (stgit-capture-output nil
1209       (stgit-run "goto" patchsym))
1210     (stgit-reload)))
1211
1212 (defun stgit-id (patchsym)
1213   "Return the git commit id for PATCHSYM.
1214 If PATCHSYM is a keyword, returns PATCHSYM unmodified."
1215   (if (keywordp patchsym)
1216       patchsym
1217     (let ((result (with-output-to-string
1218                     (stgit-run-silent "id" patchsym))))
1219       (unless (string-match "^\\([0-9A-Fa-f]\\{40\\}\\)$" result)
1220         (error "Cannot find commit id for %s" patchsym))
1221       (match-string 1 result))))
1222
1223 (defun stgit-show-patch (unmerged-stage ignore-whitespace)
1224   "Show the patch on the current line.
1225
1226 UNMERGED-STAGE is the argument to `git-diff' that that selects
1227 which stage to diff against in the case of unmerged files."
1228   (let ((space-arg (when (numberp ignore-whitespace)
1229                      (cond ((> ignore-whitespace 4)
1230                             "--ignore-all-space")
1231                            ((> ignore-whitespace 1)
1232                             "--ignore-space-change"))))
1233         (patch-name (stgit-patch-name-at-point t)))
1234     (stgit-capture-output "*StGit patch*"
1235       (case (get-text-property (point) 'entry-type)
1236         ('file
1237          (let* ((patched-file (stgit-patched-file-at-point))
1238                 (patch-id (let ((id (stgit-id patch-name)))
1239                             (if (and (eq id :index)
1240                                      (eq (stgit-file-status patched-file)
1241                                          'unmerged))
1242                                 :work
1243                               id)))
1244                 (args (append (and space-arg (list space-arg))
1245                               (and (stgit-file-cr-from patched-file)
1246                                    (list (stgit-find-copies-harder-diff-arg)))
1247                               (cond ((eq patch-id :index)
1248                                      '("--cached"))
1249                                     ((eq patch-id :work)
1250                                      (list unmerged-stage))
1251                                     (t
1252                                      (list (concat patch-id "^") patch-id)))
1253                               '("--")
1254                               (if (stgit-file-copy-or-rename patched-file)
1255                                   (list (stgit-file-cr-from patched-file)
1256                                         (stgit-file-cr-to patched-file))
1257                                 (list (stgit-file-file patched-file))))))
1258            (apply 'stgit-run-git "diff" args)))
1259         ('patch
1260          (let* ((patch-id (stgit-id patch-name)))
1261            (if (or (eq patch-id :index) (eq patch-id :work))
1262                (apply 'stgit-run-git "diff"
1263                       (stgit-find-copies-harder-diff-arg)
1264                       (append (and space-arg (list space-arg))
1265                               (if (eq patch-id :index)
1266                                   '("--cached")
1267                                 (list unmerged-stage))))
1268              (let ((args (append '("show" "-O" "--patch-with-stat" "-O" "-M")
1269                                  (and space-arg (list "-O" space-arg))
1270                                  (list (stgit-patch-name-at-point)))))
1271                (apply 'stgit-run args)))))
1272          (t
1273           (error "No patch or file at point")))
1274       (with-current-buffer standard-output
1275         (goto-char (point-min))
1276         (diff-mode)))))
1277
1278 (defmacro stgit-define-diff (name diff-arg &optional unmerged-action)
1279   `(defun ,name (&optional ignore-whitespace)
1280      ,(format "Show the patch on the current line.
1281
1282 %sWith a prefix argument, ignore whitespace. With a prefix argument
1283 greater than four (e.g., \\[universal-argument] \
1284 \\[universal-argument] \\[%s]), ignore all whitespace."
1285               (if unmerged-action
1286                   (format "For unmerged files, %s.\n\n" unmerged-action)
1287                 "")
1288               name)
1289      (interactive "p")
1290      (stgit-show-patch ,diff-arg ignore-whitespace)))
1291
1292 (stgit-define-diff stgit-diff
1293                    "--ours" nil)
1294 (stgit-define-diff stgit-diff-ours
1295                    "--ours"
1296                    "diff against our branch")
1297 (stgit-define-diff stgit-diff-theirs
1298                    "--theirs"
1299                    "diff against their branch")
1300 (stgit-define-diff stgit-diff-base
1301                    "--base"
1302                    "diff against the merge base")
1303 (stgit-define-diff stgit-diff-combined
1304                    "--cc"
1305                    "show a combined diff")
1306
1307 (defun stgit-move-change-to-index (file &optional force)
1308   "Copies the work tree state of FILE to index, using git add or git rm.
1309
1310 If FORCE is not nil, use --force."
1311   (let ((op (if (or (file-exists-p file) (file-symlink-p file))
1312                 '("add") '("rm" "-q"))))
1313     (stgit-capture-output "*git output*"
1314       (apply 'stgit-run-git (append op (and force '("--force"))
1315                                     '("--") (list file))))))
1316
1317 (defun stgit-remove-change-from-index (file)
1318   "Unstages the change in FILE from the index"
1319   (stgit-capture-output "*git output*"
1320     (stgit-run-git "reset" "-q" "--" file)))
1321
1322 (defun stgit-file-toggle-index ()
1323   "Move modified file in or out of the index.
1324
1325 Leaves the point where it is, but moves the mark to where the
1326 file ended up. You can then jump to the file with \
1327 \\[exchange-point-and-mark]."
1328   (interactive)
1329   (let* ((patched-file   (or (stgit-patched-file-at-point)
1330                              (error "No file on the current line")))
1331          (patched-status (stgit-file-status patched-file)))
1332     (when (eq patched-status 'unmerged)
1333       (error (substitute-command-keys "Use \\[stgit-resolve-file] to move an unmerged file to the index")))
1334     (let* ((patch      (stgit-patch-at-point))
1335            (patch-name (stgit-patch-name patch))
1336            (mark-file  (if (eq patched-status 'rename)
1337                            (stgit-file-cr-to patched-file)
1338                          (stgit-file-file patched-file)))
1339            (point-file  (if (eq patched-status 'rename)
1340                            (stgit-file-cr-from patched-file)
1341                          (stgit-neighbour-file))))
1342
1343       (cond ((eq patch-name :work)
1344              (stgit-move-change-to-index (stgit-file-file patched-file)
1345                                          (eq patched-status 'ignore)))
1346             ((eq patch-name :index)
1347              (stgit-remove-change-from-index (stgit-file-file patched-file)))
1348             (t
1349              (error "Can only move files between working tree and index")))
1350       (stgit-refresh-worktree)
1351       (stgit-refresh-index)
1352       (stgit-goto-patch (if (eq patch-name :index) :work :index) mark-file)
1353       (push-mark nil t t)
1354       (stgit-goto-patch patch-name point-file))))
1355
1356 (defun stgit-edit ()
1357   "Edit the patch on the current line."
1358   (interactive)
1359   (let ((patchsym (stgit-patch-name-at-point t t))
1360         (edit-buf (get-buffer-create "*StGit edit*"))
1361         (dir default-directory))
1362     (log-edit 'stgit-confirm-edit t nil edit-buf)
1363     (set (make-local-variable 'stgit-edit-patchsym) patchsym)
1364     (setq default-directory dir)
1365     (let ((standard-output edit-buf))
1366       (stgit-run-silent "edit" "--save-template=-" patchsym))))
1367
1368 (defun stgit-confirm-edit ()
1369   (interactive)
1370   (let ((file (make-temp-file "stgit-edit-")))
1371     (write-region (point-min) (point-max) file)
1372     (stgit-capture-output nil
1373       (stgit-run "edit" "-f" file stgit-edit-patchsym))
1374     (with-current-buffer log-edit-parent-buffer
1375       (stgit-reload))))
1376
1377 (defun stgit-new (add-sign)
1378   "Create a new patch.
1379 With a prefix argument, include a \"Signed-off-by:\" line at the
1380 end of the patch."
1381   (interactive "P")
1382   (let ((edit-buf (get-buffer-create "*StGit edit*"))
1383         (dir default-directory))
1384     (log-edit 'stgit-confirm-new t nil edit-buf)
1385     (setq default-directory dir)
1386     (when add-sign
1387       (save-excursion
1388         (let ((standard-output (current-buffer)))
1389           (stgit-run-silent "new" "--sign" "--save-template=-"))))))
1390
1391 (defun stgit-confirm-new ()
1392   (interactive)
1393   (let ((file (make-temp-file "stgit-edit-")))
1394     (write-region (point-min) (point-max) file)
1395     (stgit-capture-output nil
1396       (stgit-run "new" "-f" file))
1397     (with-current-buffer log-edit-parent-buffer
1398       (stgit-reload))))
1399
1400 (defun stgit-create-patch-name (description)
1401   "Create a patch name from a long description"
1402   (let ((patch ""))
1403     (while (> (length description) 0)
1404       (cond ((string-match "\\`[a-zA-Z_-]+" description)
1405              (setq patch (downcase (concat patch
1406                                            (match-string 0 description))))
1407              (setq description (substring description (match-end 0))))
1408             ((string-match "\\` +" description)
1409              (setq patch (concat patch "-"))
1410              (setq description (substring description (match-end 0))))
1411             ((string-match "\\`[^a-zA-Z_-]+" description)
1412              (setq description (substring description (match-end 0))))))
1413     (cond ((= (length patch) 0)
1414            "patch")
1415           ((> (length patch) 20)
1416            (substring patch 0 20))
1417           (t patch))))
1418
1419 (defun stgit-delete (patchsyms &optional spill-p)
1420   "Delete the patches in PATCHSYMS.
1421 Interactively, delete the marked patches, or the patch at point.
1422
1423 With a prefix argument, or SPILL-P, spill the patch contents to
1424 the work tree and index."
1425   (interactive (list (stgit-patches-marked-or-at-point)
1426                      current-prefix-arg))
1427   (unless patchsyms
1428     (error "No patches to delete"))
1429   (when (memq :index patchsyms)
1430     (error "Cannot delete the index"))
1431   (when (memq :work  patchsyms)
1432     (error "Cannot delete the work tree"))
1433
1434   (let ((npatches (length patchsyms)))
1435     (when (yes-or-no-p (format "Really delete %d patch%s%s? "
1436                                npatches
1437                                (if (= 1 npatches) "" "es")
1438                                (if spill-p
1439                                    " (spilling contents to index)"
1440                                  "")))
1441       (let ((args (if spill-p
1442                       (cons "--spill" patchsyms)
1443                     patchsyms)))
1444         (stgit-capture-output nil
1445           (apply 'stgit-run "delete" args))
1446         (stgit-reload)))))
1447
1448 (defun stgit-move-patches-target ()
1449   "Return the patchsym indicating a target patch for
1450 `stgit-move-patches'.
1451
1452 This is either the patch at point, or one of :top and :bottom, if
1453 the point is after or before the applied patches."
1454
1455   (let ((patchsym (stgit-patch-name-at-point)))
1456     (cond (patchsym patchsym)
1457           ((save-excursion (re-search-backward "^>" nil t)) :top)
1458           (t :bottom))))
1459
1460 (defun stgit-sort-patches (patchsyms)
1461   "Returns the list of patches in PATCHSYMS sorted according to
1462 their position in the patch series, bottommost first.
1463
1464 PATCHSYMS must not contain duplicate entries."
1465   (let (sorted-patchsyms
1466         (series (with-output-to-string
1467                   (with-current-buffer standard-output
1468                     (stgit-run-silent "series" "--noprefix"))))
1469         start)
1470     (while (string-match "^\\(.+\\)" series start)
1471       (let ((patchsym (intern (match-string 1 series))))
1472         (when (memq patchsym patchsyms)
1473           (setq sorted-patchsyms (cons patchsym sorted-patchsyms))))
1474       (setq start (match-end 0)))
1475     (setq sorted-patchsyms (nreverse sorted-patchsyms))
1476
1477     (unless (= (length patchsyms) (length sorted-patchsyms))
1478       (error "Internal error"))
1479
1480     sorted-patchsyms))
1481
1482 (defun stgit-move-patches (patchsyms target-patch)
1483   "Move the patches in PATCHSYMS to below TARGET-PATCH.
1484 If TARGET-PATCH is :bottom or :top, move the patches to the
1485 bottom or top of the stack, respectively.
1486
1487 Interactively, move the marked patches to where the point is."
1488   (interactive (list stgit-marked-patches
1489                      (stgit-move-patches-target)))
1490   (unless patchsyms
1491     (error "Need at least one patch to move"))
1492
1493   (unless target-patch
1494     (error "Point not at a patch"))
1495
1496   (if (eq target-patch :top)
1497       (stgit-capture-output nil
1498         (apply 'stgit-run "float" patchsyms))
1499
1500     ;; need to have patchsyms sorted by position in the stack
1501     (let ((sorted-patchsyms (stgit-sort-patches patchsyms)))
1502       (while sorted-patchsyms
1503         (setq sorted-patchsyms
1504               (and (stgit-capture-output nil
1505                      (if (eq target-patch :bottom)
1506                          (stgit-run "sink" "--" (car sorted-patchsyms))
1507                        (stgit-run "sink" "--to" target-patch "--"
1508                                   (car sorted-patchsyms))))
1509                    (cdr sorted-patchsyms))))))
1510   (stgit-reload))
1511
1512 (defun stgit-squash (patchsyms)
1513   "Squash the patches in PATCHSYMS.
1514 Interactively, squash the marked patches.
1515
1516 Unless there are any conflicts, the patches will be merged into
1517 one patch, which will occupy the same spot in the series as the
1518 deepest patch had before the squash."
1519   (interactive (list stgit-marked-patches))
1520   (when (< (length patchsyms) 2)
1521     (error "Need at least two patches to squash"))
1522   (let ((stgit-buffer (current-buffer))
1523         (edit-buf (get-buffer-create "*StGit edit*"))
1524         (dir default-directory)
1525         (sorted-patchsyms (stgit-sort-patches patchsyms)))
1526     (log-edit 'stgit-confirm-squash t nil edit-buf)
1527     (set (make-local-variable 'stgit-patchsyms) sorted-patchsyms)
1528     (setq default-directory dir)
1529     (let ((result (let ((standard-output edit-buf))
1530                     (apply 'stgit-run-silent "squash"
1531                            "--save-template=-" sorted-patchsyms))))
1532
1533       ;; stg squash may have reordered the patches or caused conflicts
1534       (with-current-buffer stgit-buffer
1535         (stgit-reload))
1536
1537       (unless (eq 0 result)
1538         (fundamental-mode)
1539         (rename-buffer "*StGit error*")
1540         (resize-temp-buffer-window)
1541         (switch-to-buffer-other-window stgit-buffer)
1542         (error "stg squash failed")))))
1543
1544 (defun stgit-confirm-squash ()
1545   (interactive)
1546   (let ((file (make-temp-file "stgit-edit-")))
1547     (write-region (point-min) (point-max) file)
1548     (stgit-capture-output nil
1549       (apply 'stgit-run "squash" "-f" file stgit-patchsyms))
1550     (with-current-buffer log-edit-parent-buffer
1551       (stgit-clear-marks)
1552       ;; Go to first marked patch and stay there
1553       (goto-char (point-min))
1554       (re-search-forward (concat "^[>+-]\\*") nil t)
1555       (move-to-column goal-column)
1556       (let ((pos (point)))
1557         (stgit-reload)
1558         (goto-char pos)))))
1559
1560 (defun stgit-help ()
1561   "Display help for the StGit mode."
1562   (interactive)
1563   (describe-function 'stgit-mode))
1564
1565 (defun stgit-undo (&optional arg)
1566   "Run stg undo.
1567 With prefix argument, run it with the --hard flag.
1568
1569 See also `stgit-redo'."
1570   (interactive "P")
1571   (stgit-capture-output nil
1572     (if arg
1573         (stgit-run "undo" "--hard")
1574       (stgit-run "undo")))
1575   (stgit-reload))
1576
1577 (defun stgit-redo (&optional arg)
1578   "Run stg redo.
1579 With prefix argument, run it with the --hard flag.
1580
1581 See also `stgit-undo'."
1582   (interactive "P")
1583   (stgit-capture-output nil
1584     (if arg
1585         (stgit-run "redo" "--hard")
1586       (stgit-run "redo")))
1587   (stgit-reload))
1588
1589 (defun stgit-refresh (&optional arg)
1590   "Run stg refresh.
1591 If the index contains any changes, only refresh from index.
1592
1593 With prefix argument, refresh the marked patch or the patch under point."
1594   (interactive "P")
1595   (let ((patchargs (if arg
1596                        (let ((patches (stgit-patches-marked-or-at-point)))
1597                          (cond ((null patches)
1598                                 (error "No patch to update"))
1599                                ((> (length patches) 1)
1600                                 (error "Too many patches selected"))
1601                                (t
1602                                 (cons "-p" patches))))
1603                      nil)))
1604     (unless (stgit-index-empty-p)
1605       (setq patchargs (cons "--index" patchargs)))
1606     (stgit-capture-output nil
1607       (apply 'stgit-run "refresh" patchargs))
1608     (stgit-refresh-git-status))
1609   (stgit-reload))
1610
1611 (defcustom stgit-show-worktree-mode 'center
1612   "This variable controls where the \"Index\" and \"Work tree\"
1613 will be shown on in the buffer.
1614
1615 It can be set to 'top (above all patches), 'center (show between
1616 applied and unapplied patches), and 'bottom (below all patches).
1617
1618 See also `stgit-show-worktree'."
1619   :type '(radio (const :tag "above all patches (top)" top)
1620                 (const :tag "between applied and unapplied patches (center)"
1621                        center)
1622                 (const :tag "below all patches (bottom)" bottom))
1623   :group 'stgit)
1624
1625 (defcustom stgit-default-show-worktree
1626   t
1627   "Set to non-nil to by default show the working tree in a new stgit buffer.
1628
1629 This value is used as the default value for `stgit-show-worktree'."
1630   :type 'boolean
1631   :group 'stgit)
1632
1633 (defvar stgit-show-worktree nil
1634   "If nil, inhibit showing work tree and index in the stgit buffer.
1635
1636 See also `stgit-show-worktree-mode'.")
1637
1638 (defvar stgit-show-ignored nil
1639   "If nil, inhibit showing files ignored by git.")
1640
1641 (defvar stgit-show-unknown nil
1642   "If nil, inhibit showing files not registered with git.")
1643
1644 (defun stgit-toggle-worktree (&optional arg)
1645   "Toggle the visibility of the work tree.
1646 With ARG, show the work tree if ARG is positive.
1647
1648 Its initial setting is controlled by `stgit-default-show-worktree'.
1649
1650 `stgit-show-worktree-mode' controls where on screen the index and
1651 work tree will show up."
1652   (interactive)
1653   (setq stgit-show-worktree
1654         (if (numberp arg)
1655             (> arg 0)
1656           (not stgit-show-worktree)))
1657   (stgit-reload))
1658
1659 (defun stgit-toggle-ignored (&optional arg)
1660   "Toggle the visibility of files ignored by git in the work
1661 tree. With ARG, show these files if ARG is positive.
1662
1663 Use \\[stgit-toggle-worktree] to show the work tree."
1664   (interactive)
1665   (setq stgit-show-ignored
1666         (if (numberp arg)
1667             (> arg 0)
1668           (not stgit-show-ignored)))
1669   (stgit-reload))
1670
1671 (defun stgit-toggle-unknown (&optional arg)
1672   "Toggle the visibility of files not registered with git in the
1673 work tree. With ARG, show these files if ARG is positive.
1674
1675 Use \\[stgit-toggle-worktree] to show the work tree."
1676   (interactive)
1677   (setq stgit-show-unknown
1678         (if (numberp arg)
1679             (> arg 0)
1680           (not stgit-show-unknown)))
1681   (stgit-reload))
1682
1683 (defcustom stgit-abbreviate-copies-and-renames
1684   t
1685   "If non-nil, abbreviate copies and renames as \"dir/{old -> new}/file\"
1686 instead of \"dir/old/file -> dir/new/file\"."
1687   :type 'boolean
1688   :group 'stgit)
1689
1690 (provide 'stgit)