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