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