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