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