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 (require 'git nil t)
  13 (require 'cl)
  14 (require 'ewoc)
  15
  16 (defun stgit (dir)
  17   "Manage StGit patches for the tree in DIR."
  18   (interactive "DDirectory: \n")
  19   (switch-to-stgit-buffer (git-get-top-dir dir))
  20   (stgit-reload))
  21
  22 (unless (fboundp 'git-get-top-dir)
  23   (defun git-get-top-dir (dir)
  24     "Retrieve the top-level directory of a git tree."
  25     (let ((cdup (with-output-to-string
  26                   (with-current-buffer standard-output
  27                     (cd dir)
  28                     (unless (eq 0 (call-process "git" nil t nil
  29                                                 "rev-parse" "--show-cdup"))
  30                       (error "Cannot find top-level git tree for %s" dir))))))
  31       (expand-file-name (concat (file-name-as-directory dir)
  32                                 (car (split-string cdup "\n")))))))
  33
  34 (defun stgit-refresh-git-status (&optional dir)
  35   "If it exists, refresh the `git-status' buffer belonging to
  36 directory DIR or `default-directory'"
  37   (when (and (fboundp 'git-find-status-buffer)
  38              (fboundp 'git-refresh-status))
  39     (let* ((top-dir (git-get-top-dir (or dir default-directory)))
  40            (git-status-buffer (and top-dir (git-find-status-buffer top-dir))))
  41       (when git-status-buffer
  42         (with-current-buffer git-status-buffer
  43           (git-refresh-status))))))
  44
  45 (defun stgit-find-buffer (dir)
  46   "Return the buffer displaying StGit patches for DIR, or nil if none."
  47   (setq dir (file-name-as-directory dir))
  48   (let ((buffers (buffer-list)))
  49     (while (and buffers
  50                 (not (with-current-buffer (car buffers)
  51                        (and (eq major-mode 'stgit-mode)
  52                             (string= default-directory dir)))))
  53       (setq buffers (cdr buffers)))
  54     (and buffers (car buffers))))
  55
  56 (defun switch-to-stgit-buffer (dir)
  57   "Switch to a (possibly new) buffer displaying StGit patches for DIR."
  58   (setq dir (file-name-as-directory dir))
  59   (let ((buffer (stgit-find-buffer dir)))
  60     (switch-to-buffer (or buffer
  61                           (create-stgit-buffer dir)))))
  62
  63 (defstruct (stgit-patch)
  64   status name desc empty files-ewoc)
  65
  66 (defun stgit-patch-pp (patch)
  67   (let* ((status (stgit-patch-status patch))
  68          (start (point))
  69          (name (stgit-patch-name patch))
  70          (face (cdr (assq status stgit-patch-status-face-alist))))
  71     (insert (case status
  72               ('applied "+")
  73               ('top ">")
  74               ('unapplied "-")
  75               (t " "))
  76             (if (memq name stgit-marked-patches)
  77                 "*" " "))
  78     (if (memq status '(index work))
  79         (insert (propertize (if (eq status 'index) "Index" "Work tree")
  80                             'face face))
  81       (insert (format "%-30s"
  82                       (propertize (symbol-name name) 'face face))
  83               "  "
  84               (if (stgit-patch-empty patch) "(empty) " "")
  85               (propertize (or (stgit-patch-desc patch) "")
  86                           'face 'stgit-description-face)))
  87     (insert "\n")
  88     (put-text-property start (point) 'entry-type 'patch)
  89     (when (memq name stgit-expanded-patches)
  90       (stgit-insert-patch-files patch))
  91     (put-text-property start (point) 'patch-data patch)))
  92
  93 (defun create-stgit-buffer (dir)
  94   "Create a buffer for showing StGit patches.
  95 Argument DIR is the repository path."
  96   (let ((buf (create-file-buffer (concat dir "*stgit*")))
  97         (inhibit-read-only t))
  98     (with-current-buffer buf
  99       (setq default-directory dir)
 100       (stgit-mode)
 101       (set (make-local-variable 'stgit-ewoc)
 102            (ewoc-create #'stgit-patch-pp "Branch:\n\n" "--\n" t))
 103       (setq buffer-read-only t))
 104     buf))
 105
 106 (defmacro stgit-capture-output (name &rest body)
 107   "Capture StGit output and, if there was any output, show it in a window
 108 at the end.
 109 Returns nil if there was no output."
 110   (declare (debug ([&or stringp null] body))
 111            (indent 1))
 112   `(let ((output-buf (get-buffer-create ,(or name "*StGit output*")))
 113          (stgit-dir default-directory)
 114          (inhibit-read-only t))
 115      (with-current-buffer output-buf
 116        (erase-buffer)
 117        (setq default-directory stgit-dir)
 118        (setq buffer-read-only t))
 119      (let ((standard-output output-buf))
 120        ,@body)
 121      (with-current-buffer output-buf
 122        (set-buffer-modified-p nil)
 123        (setq buffer-read-only t)
 124        (if (< (point-min) (point-max))
 125            (display-buffer output-buf t)))))
 126
 127 (defun stgit-make-run-args (args)
 128   "Return a copy of ARGS with its elements converted to strings."
 129   (mapcar (lambda (x)
 130             ;; don't use (format "%s" ...) to limit type errors
 131             (cond ((stringp x) x)
 132                   ((integerp x) (number-to-string x))
 133                   ((symbolp x) (symbol-name x))
 134                   (t
 135                    (error "Bad element in stgit-make-run-args args: %S" x))))
 136           args))
 137
 138 (defun stgit-run-silent (&rest args)
 139   (setq args (stgit-make-run-args args))
 140   (apply 'call-process "stg" nil standard-output nil args))
 141
 142 (defun stgit-run (&rest args)
 143   (setq args (stgit-make-run-args args))
 144   (let ((msgcmd (mapconcat #'identity args " ")))
 145     (message "Running stg %s..." msgcmd)
 146     (apply 'call-process "stg" nil standard-output nil args)
 147     (message "Running stg %s...done" msgcmd)))
 148
 149 (defun stgit-run-git (&rest args)
 150   (setq args (stgit-make-run-args args))
 151   (let ((msgcmd (mapconcat #'identity args " ")))
 152     (message "Running git %s..." msgcmd)
 153     (apply 'call-process "git" nil standard-output nil args)
 154     (message "Running git %s...done" msgcmd)))
 155
 156 (defun stgit-run-git-silent (&rest args)
 157   (setq args (stgit-make-run-args args))
 158   (apply 'call-process "git" nil standard-output nil args))
 159
 160 (defun stgit-index-empty-p ()
 161   "Returns non-nil if the index contains no changes from HEAD."
 162   (zerop (stgit-run-git-silent "diff-index" "--cached" "--quiet" "HEAD")))
 163
 164 (defvar stgit-index-node)
 165 (defvar stgit-worktree-node)
 166
 167 (defun stgit-refresh-index ()
 168   (when stgit-index-node
 169     (ewoc-invalidate (car stgit-index-node) (cdr stgit-index-node))))
 170
 171 (defun stgit-refresh-worktree ()
 172   (when stgit-worktree-node
 173     (ewoc-invalidate (car stgit-worktree-node) (cdr stgit-worktree-node))))
 174
 175 (defun stgit-run-series-insert-index (ewoc)
 176   (setq index-node    (cons ewoc (ewoc-enter-last ewoc
 177                                                   (make-stgit-patch
 178                                                    :status 'index
 179                                                    :name :index
 180                                                    :desc nil
 181                                                    :empty nil)))
 182         worktree-node (cons ewoc (ewoc-enter-last ewoc
 183                                                   (make-stgit-patch
 184                                                    :status 'work
 185                                                    :name :work
 186                                                    :desc nil
 187                                                    :empty nil)))))
 188
 189 (defun stgit-run-series (ewoc)
 190   (setq stgit-index-node nil
 191         stgit-worktree-node nil)
 192   (let ((inserted-index (not stgit-show-worktree))
 193         index-node
 194         worktree-node
 195         all-patchsyms)
 196     (with-temp-buffer
 197       (let ((exit-status (stgit-run-silent "series" "--description" "--empty")))
 198         (goto-char (point-min))
 199         (if (not (zerop exit-status))
 200             (cond ((looking-at "stg series: \\(.*\\)")
 201                    (setq inserted-index t)
 202                    (ewoc-set-hf ewoc (car (ewoc-get-hf ewoc))
 203                                 (substitute-command-keys
 204                                  "-- not initialized; run \\[stgit-init]")))
 205                   ((looking-at ".*")
 206                    (error "Error running stg: %s"
 207                           (match-string 0))))
 208           (while (not (eobp))
 209             (unless (looking-at
 210                      "\\([0 ]\\)\\([>+-]\\)\\( \\)\\([^ ]+\\) *[|#] \\(.*\\)")
 211               (error "Syntax error in output from stg series"))
 212             (let* ((state-str (match-string 2))
 213                    (state (cond ((string= state-str ">") 'top)
 214                                 ((string= state-str "+") 'applied)
 215                                 ((string= state-str "-") 'unapplied)))
 216                    (name (intern (match-string 4)))
 217                    (desc (match-string 5))
 218                    (empty (string= (match-string 1) "0")))
 219               (unless inserted-index
 220                 (when (or (eq stgit-show-worktree-mode 'top)
 221                           (and (eq stgit-show-worktree-mode 'center)
 222                                (eq state 'unapplied)))
 223                   (setq inserted-index t)
 224                   (stgit-run-series-insert-index ewoc)))
 225               (setq all-patchsyms (cons name all-patchsyms))
 226               (ewoc-enter-last ewoc
 227                                (make-stgit-patch
 228                                 :status state
 229                                 :name   name
 230                                 :desc   desc
 231                                 :empty  empty)))
 232             (forward-line 1))))
 233       (unless inserted-index
 234         (stgit-run-series-insert-index ewoc)))
 235     (setq stgit-index-node    index-node
 236           stgit-worktree-node worktree-node
 237           stgit-marked-patches (intersection stgit-marked-patches
 238                                              all-patchsyms))))
 239
 240 (defun stgit-reload ()
 241   "Update the contents of the StGit buffer."
 242   (interactive)
 243   (let ((inhibit-read-only t)
 244         (curline (line-number-at-pos))
 245         (curpatch (stgit-patch-name-at-point)))
 246     (ewoc-filter stgit-ewoc #'(lambda (x) nil))
 247     (ewoc-set-hf stgit-ewoc
 248                  (concat "Branch: "
 249                          (propertize
 250                           (with-temp-buffer
 251                             (stgit-run-silent "branch")
 252                             (buffer-substring (point-min) (1- (point-max))))
 253                           'face 'stgit-branch-name-face)
 254                          "\n\n")
 255                  (if stgit-show-worktree
 256                      "--"
 257                    (propertize
 258                     (substitute-command-keys "--\n\"\\[stgit-toggle-worktree]\"\
 259  shows the working tree\n")
 260                    'face 'stgit-description-face)))
 261     (stgit-run-series stgit-ewoc)
 262     (if curpatch
 263         (stgit-goto-patch curpatch)
 264       (goto-line curline)))
 265   (stgit-refresh-git-status))
 266
 267 (defgroup stgit nil
 268   "A user interface for the StGit patch maintenance tool."
 269   :group 'tools)
 270
 271 (defface stgit-description-face
 272   '((((background dark)) (:foreground "tan"))
 273     (((background light)) (:foreground "dark red")))
 274   "The face used for StGit descriptions"
 275   :group 'stgit)
 276
 277 (defface stgit-branch-name-face
 278   '((t :inherit bold))
 279   "The face used for the StGit branch name"
 280   :group 'stgit)
 281
 282 (defface stgit-top-patch-face
 283   '((((background dark)) (:weight bold :foreground "yellow"))
 284     (((background light)) (:weight bold :foreground "purple"))
 285     (t (:weight bold)))
 286   "The face used for the top patch names"
 287   :group 'stgit)
 288
 289 (defface stgit-applied-patch-face
 290   '((((background dark)) (:foreground "light yellow"))
 291     (((background light)) (:foreground "purple"))
 292     (t ()))
 293   "The face used for applied patch names"
 294   :group 'stgit)
 295
 296 (defface stgit-unapplied-patch-face
 297   '((((background dark)) (:foreground "gray80"))
 298     (((background light)) (:foreground "orchid"))
 299     (t ()))
 300   "The face used for unapplied patch names"
 301   :group 'stgit)
 302
 303 (defface stgit-modified-file-face
 304   '((((class color) (background light)) (:foreground "purple"))
 305     (((class color) (background dark)) (:foreground "salmon")))
 306   "StGit mode face used for modified file status"
 307   :group 'stgit)
 308
 309 (defface stgit-unmerged-file-face
 310   '((((class color) (background light)) (:foreground "red" :bold t))
 311     (((class color) (background dark)) (:foreground "red" :bold t)))
 312   "StGit mode face used for unmerged file status"
 313   :group 'stgit)
 314
 315 (defface stgit-unknown-file-face
 316   '((((class color) (background light)) (:foreground "goldenrod" :bold t))
 317     (((class color) (background dark)) (:foreground "goldenrod" :bold t)))
 318   "StGit mode face used for unknown file status"
 319   :group 'stgit)
 320
 321 (defface stgit-file-permission-face
 322   '((((class color) (background light)) (:foreground "green" :bold t))
 323     (((class color) (background dark)) (:foreground "green" :bold t)))
 324   "StGit mode face used for permission changes."
 325   :group 'stgit)
 326
 327 (defface stgit-index-work-tree-title-face
 328   '((((supports :slant italic)) :slant italic)
 329     (t :inherit bold))
 330   "StGit mode face used for the \"Index\" and \"Work tree\" titles"
 331   :group 'stgit)
 332
 333
 334 (defcustom stgit-expand-find-copies-harder
 335   nil
 336   "Try harder to find copied files when listing patches.
 337
 338 When not nil, runs git diff-tree with the --find-copies-harder
 339 flag, which reduces performance."
 340   :type 'boolean
 341   :group 'stgit)
 342
 343 (defconst stgit-file-status-code-strings
 344   (mapcar (lambda (arg)
 345             (cons (car arg)
 346                   (propertize (cadr arg) 'face (car (cddr arg)))))
 347           '((add         "Added"       stgit-modified-file-face)
 348             (copy        "Copied"      stgit-modified-file-face)
 349             (delete      "Deleted"     stgit-modified-file-face)
 350             (modify      "Modified"    stgit-modified-file-face)
 351             (rename      "Renamed"     stgit-modified-file-face)
 352             (mode-change "Mode change" stgit-modified-file-face)
 353             (unmerged    "Unmerged"    stgit-unmerged-file-face)
 354             (unknown     "Unknown"     stgit-unknown-file-face)))
 355   "Alist of code symbols to description strings")
 356
 357 (defconst stgit-patch-status-face-alist
 358   '((applied   . stgit-applied-patch-face)
 359     (top       . stgit-top-patch-face)
 360     (unapplied . stgit-unapplied-patch-face)
 361     (index     . stgit-index-work-tree-title-face)
 362     (work      . stgit-index-work-tree-title-face))
 363   "Alist of face to use for a given patch status")
 364
 365 (defun stgit-file-status-code-as-string (file)
 366   "Return stgit status code for FILE as a string"
 367   (let* ((code (assq (stgit-file-status file)
 368                      stgit-file-status-code-strings))
 369          (score (stgit-file-cr-score file)))
 370     (when code
 371       (format "%-11s  "
 372               (if (and score (/= score 100))
 373                   (format "%s %s" (cdr code)
 374                           (propertize (format "%d%%" score)
 375                                       'face 'stgit-description-face))
 376                 (cdr code))))))
 377
 378 (defun stgit-file-status-code (str &optional score)
 379   "Return stgit status code from git status string"
 380   (let ((code (assoc str '(("A" . add)
 381                            ("C" . copy)
 382                            ("D" . delete)
 383                            ("M" . modify)
 384                            ("R" . rename)
 385                            ("T" . mode-change)
 386                            ("U" . unmerged)
 387                            ("X" . unknown)))))
 388     (setq code (if code (cdr code) 'unknown))
 389     (when (stringp score)
 390       (if (> (length score) 0)
 391           (setq score (string-to-number score))
 392         (setq score nil)))
 393     (if score (cons code score) code)))
 394
 395 (defconst stgit-file-type-strings
 396   '((#o100 . "file")
 397     (#o120 . "symlink")
 398     (#o160 . "subproject"))
 399   "Alist of names of file types")
 400
 401 (defun stgit-file-type-string (type)
 402   "Return string describing file type TYPE (the high bits of file permission).
 403 Cf. `stgit-file-type-strings' and `stgit-file-type-change-string'."
 404   (let ((type-str (assoc type stgit-file-type-strings)))
 405     (or (and type-str (cdr type-str))
 406         (format "unknown type %o" type))))
 407
 408 (defun stgit-file-type-change-string (old-perm new-perm)
 409   "Return string describing file type change from OLD-PERM to NEW-PERM.
 410 Cf. `stgit-file-type-string'."
 411   (let ((old-type (lsh old-perm -9))
 412         (new-type (lsh new-perm -9)))
 413     (cond ((= old-type new-type) "")
 414           ((zerop new-type) "")
 415           ((zerop old-type)
 416            (if (= new-type #o100)
 417                ""
 418              (format "   (%s)" (stgit-file-type-string new-type))))
 419           (t (format "   (%s -> %s)"
 420                      (stgit-file-type-string old-type)
 421                      (stgit-file-type-string new-type))))))
 422
 423 (defun stgit-file-mode-change-string (old-perm new-perm)
 424   "Return string describing file mode change from OLD-PERM to NEW-PERM.
 425 Cf. `stgit-file-type-change-string'."
 426   (setq old-perm (logand old-perm #o777)
 427         new-perm (logand new-perm #o777))
 428   (if (or (= old-perm new-perm)
 429           (zerop old-perm)
 430           (zerop new-perm))
 431       ""
 432     (let* ((modified       (logxor old-perm new-perm))
 433            (not-x-modified (logand (logxor old-perm new-perm) #o666)))
 434       (cond ((zerop modified) "")
 435             ((and (zerop not-x-modified)
 436                   (or (and (eq #o111 (logand old-perm #o111))
 437                            (propertize "-x" 'face 'stgit-file-permission-face))
 438                       (and (eq #o111 (logand new-perm #o111))
 439                            (propertize "+x" 'face
 440                                        'stgit-file-permission-face)))))
 441             (t (concat (propertize (format "%o" old-perm)
 442                                    'face 'stgit-file-permission-face)
 443                        (propertize " -> "
 444                                    'face 'stgit-description-face)
 445                        (propertize (format "%o" new-perm)
 446                                    'face 'stgit-file-permission-face)))))))
 447
 448 (defstruct (stgit-file)
 449   old-perm new-perm copy-or-rename cr-score cr-from cr-to status file)
 450
 451 (defun stgit-file-pp (file)
 452   (let ((status (stgit-file-status file))
 453         (name (if (stgit-file-copy-or-rename file)
 454                   (concat (stgit-file-cr-from file)
 455                           (propertize " -> "
 456                                       'face 'stgit-description-face)
 457                           (stgit-file-cr-to file))
 458                 (stgit-file-file file)))
 459         (mode-change (stgit-file-mode-change-string
 460                       (stgit-file-old-perm file)
 461                       (stgit-file-new-perm file)))
 462         (start (point)))
 463     (insert (format "    %-12s%1s%s%s\n"
 464                     (stgit-file-status-code-as-string file)
 465                     mode-change
 466                     name
 467                     (propertize (stgit-file-type-change-string
 468                                  (stgit-file-old-perm file)
 469                                  (stgit-file-new-perm file))
 470                                 'face 'stgit-description-face)))
 471     (add-text-properties start (point)
 472                          (list 'entry-type 'file
 473                                'file-data file))))
 474
 475 (defun stgit-find-copies-harder-diff-arg ()
 476   "Return the flag to use with `git-diff' depending on the
 477 `stgit-expand-find-copies-harder' flag."
 478   (if stgit-expand-find-copies-harder
 479       "--find-copies-harder"
 480     "-C"))
 481
 482 (defun stgit-insert-patch-files (patch)
 483   "Expand (show modification of) the patch PATCH after the line
 484 at point."
 485   (let* ((patchsym (stgit-patch-name patch))
 486          (end      (point-marker))
 487          (args     (list "-z" (stgit-find-copies-harder-diff-arg)))
 488          (ewoc     (ewoc-create #'stgit-file-pp nil nil t)))
 489     (set-marker-insertion-type end t)
 490     (setf (stgit-patch-files-ewoc patch) ewoc)
 491     (with-temp-buffer
 492       (apply 'stgit-run-git
 493              (cond ((eq patchsym :work)
 494                     `("diff-files" ,@args))
 495                    ((eq patchsym :index)
 496                     `("diff-index" ,@args "--cached" "HEAD"))
 497                    (t
 498                     `("diff-tree" ,@args "-r" ,(stgit-id patchsym)))))
 499       (goto-char (point-min))
 500       (unless (or (eobp) (memq patchsym '(:work :index)))
 501         (forward-char 41))
 502       (while (looking-at ":\\([0-7]+\\) \\([0-7]+\\) [0-9A-Fa-f]\\{40\\} [0-9A-Fa-f]\\{40\\} ")
 503         (let ((old-perm (string-to-number (match-string 1) 8))
 504               (new-perm (string-to-number (match-string 2) 8)))
 505           (goto-char (match-end 0))
 506           (let ((file
 507                  (cond ((looking-at
 508                          "\\([CR]\\)\\([0-9]*\\)\0\\([^\0]*\\)\0\\([^\0]*\\)\0")
 509                         (let* ((patch-status (stgit-patch-status patch))
 510                                (file-subexp  (if (eq patch-status 'unapplied)
 511                                                  3
 512                                                4))
 513                                (file         (match-string file-subexp)))
 514                           (make-stgit-file
 515                            :old-perm       old-perm
 516                            :new-perm       new-perm
 517                            :copy-or-rename t
 518                            :cr-score       (string-to-number (match-string 2))
 519                            :cr-from        (match-string 3)
 520                            :cr-to          (match-string 4)
 521                            :status         (stgit-file-status-code
 522                                             (match-string 1))
 523                            :file           file)))
 524                        ((looking-at "\\([ABD-QS-Z]\\)\0\\([^\0]*\\)\0")
 525                         (make-stgit-file
 526                          :old-perm       old-perm
 527                          :new-perm       new-perm
 528                          :copy-or-rename nil
 529                          :cr-score       nil
 530                          :cr-from        nil
 531                          :cr-to          nil
 532                          :status         (stgit-file-status-code
 533                                           (match-string 1))
 534                          :file           (match-string 2))))))
 535             (ewoc-enter-last ewoc file))
 536           (goto-char (match-end 0))))
 537       (unless (ewoc-nth ewoc 0)
 538         (ewoc-set-hf ewoc ""
 539                      (concat "    "
 540                              (propertize "<no files>"
 541                                          'face 'stgit-description-face)
 542                              "\n"))))
 543     (goto-char end)))
 544
 545 (defun stgit-select-file ()
 546   (let ((filename (expand-file-name
 547                    (stgit-file-file (stgit-patched-file-at-point)))))
 548     (unless (file-exists-p filename)
 549       (error "File does not exist"))
 550     (find-file filename)))
 551
 552 (defun stgit-select-patch ()
 553   (let ((patchname (stgit-patch-name-at-point)))
 554     (if (memq patchname stgit-expanded-patches)
 555         (setq stgit-expanded-patches (delq patchname stgit-expanded-patches))
 556       (setq stgit-expanded-patches (cons patchname stgit-expanded-patches)))
 557     (ewoc-invalidate stgit-ewoc (ewoc-locate stgit-ewoc)))
 558   (move-to-column (stgit-goal-column)))
 559
 560 (defun stgit-select ()
 561   "With point on a patch, toggle showing files in the patch.
 562
 563 With point on a file, open the associated file. Opens the target
 564 file for (applied) copies and renames."
 565   (interactive)
 566   (case (get-text-property (point) 'entry-type)
 567     ('patch
 568      (stgit-select-patch))
 569     ('file
 570      (stgit-select-file))
 571     (t
 572      (error "No patch or file on line"))))
 573
 574 (defun stgit-find-file-other-window ()
 575   "Open file at point in other window"
 576   (interactive)
 577   (let ((patched-file (stgit-patched-file-at-point)))
 578     (unless patched-file
 579       (error "No file on the current line"))
 580     (let ((filename (expand-file-name (stgit-file-file patched-file))))
 581       (unless (file-exists-p filename)
 582         (error "File does not exist"))
 583       (find-file-other-window filename))))
 584
 585 (defun stgit-quit ()
 586   "Hide the stgit buffer."
 587   (interactive)
 588   (bury-buffer))
 589
 590 (defun stgit-git-status ()
 591   "Show status using `git-status'."
 592   (interactive)
 593   (unless (fboundp 'git-status)
 594     (error "The stgit-git-status command requires git-status"))
 595   (let ((dir default-directory))
 596     (save-selected-window
 597       (pop-to-buffer nil)
 598       (git-status dir))))
 599
 600 (defun stgit-goal-column ()
 601   "Return goal column for the current line"
 602   (case (get-text-property (point) 'entry-type)
 603     ('patch 2)
 604     ('file 4)
 605     (t 0)))
 606
 607 (defun stgit-next-line (&optional arg)
 608   "Move cursor vertically down ARG lines"
 609   (interactive "p")
 610   (next-line arg)
 611   (move-to-column (stgit-goal-column)))
 612
 613 (defun stgit-previous-line (&optional arg)
 614   "Move cursor vertically up ARG lines"
 615   (interactive "p")
 616   (previous-line arg)
 617   (move-to-column (stgit-goal-column)))
 618
 619 (defun stgit-next-patch (&optional arg)
 620   "Move cursor down ARG patches."
 621   (interactive "p")
 622   (ewoc-goto-next stgit-ewoc (or arg 1))
 623   (move-to-column goal-column))
 624
 625 (defun stgit-previous-patch (&optional arg)
 626   "Move cursor up ARG patches."
 627   (interactive "p")
 628   (ewoc-goto-prev stgit-ewoc (or arg 1))
 629   (move-to-column goal-column))
 630
 631 (defvar stgit-mode-hook nil
 632   "Run after `stgit-mode' is setup.")
 633
 634 (defvar stgit-mode-map nil
 635   "Keymap for StGit major mode.")
 636
 637 (unless stgit-mode-map
 638   (let ((toggle-map (make-keymap)))
 639     (suppress-keymap toggle-map)
 640     (mapc (lambda (arg) (define-key toggle-map (car arg) (cdr arg)))
 641           '(("t" .        stgit-toggle-worktree)))
 642     (setq stgit-mode-map (make-keymap))
 643     (suppress-keymap stgit-mode-map)
 644     (mapc (lambda (arg) (define-key stgit-mode-map (car arg) (cdr arg)))
 645           `((" " .        stgit-mark)
 646             ("m" .        stgit-mark)
 647             ("\d" .       stgit-unmark-up)
 648             ("u" .        stgit-unmark-down)
 649             ("?" .        stgit-help)
 650             ("h" .        stgit-help)
 651             ("\C-p" .     stgit-previous-line)
 652             ("\C-n" .     stgit-next-line)
 653             ([up] .       stgit-previous-line)
 654             ([down] .     stgit-next-line)
 655             ("p" .        stgit-previous-patch)
 656             ("n" .        stgit-next-patch)
 657             ("\M-{" .     stgit-previous-patch)
 658             ("\M-}" .     stgit-next-patch)
 659             ("s" .        stgit-git-status)
 660             ("g" .        stgit-reload-or-repair)
 661             ("r" .        stgit-refresh)
 662             ("\C-c\C-r" . stgit-rename)
 663             ("e" .        stgit-edit)
 664             ("M" .        stgit-move-patches)
 665             ("S" .        stgit-squash)
 666             ("N" .        stgit-new)
 667             ("\C-c\C-c" . stgit-commit)
 668             ("\C-c\C-u" . stgit-uncommit)
 669             ("U" .        stgit-revert-file)
 670             ("R" .        stgit-resolve-file)
 671             ("\r" .       stgit-select)
 672             ("o" .        stgit-find-file-other-window)
 673             ("i" .        stgit-file-toggle-index)
 674             (">" .        stgit-push-next)
 675             ("<" .        stgit-pop-next)
 676             ("P" .        stgit-push-or-pop)
 677             ("G" .        stgit-goto)
 678             ("=" .        stgit-show)
 679             ("D" .        stgit-delete)
 680             ([(control ?/)] . stgit-undo)
 681             ("\C-_" .     stgit-undo)
 682             ("B" .        stgit-branch)
 683             ("t" .        ,toggle-map)
 684             ("q" .        stgit-quit)))))
 685
 686 (defun stgit-mode ()
 687   "Major mode for interacting with StGit.
 688 Commands:
 689 \\{stgit-mode-map}"
 690   (kill-all-local-variables)
 691   (buffer-disable-undo)
 692   (setq mode-name "StGit"
 693         major-mode 'stgit-mode
 694         goal-column 2)
 695   (use-local-map stgit-mode-map)
 696   (set (make-local-variable 'list-buffers-directory) default-directory)
 697   (set (make-local-variable 'stgit-marked-patches) nil)
 698   (set (make-local-variable 'stgit-expanded-patches) (list :work :index))
 699   (set (make-local-variable 'stgit-show-worktree) stgit-default-show-worktree)
 700   (set (make-local-variable 'stgit-index-node) nil)
 701   (set (make-local-variable 'stgit-worktree-node) nil)
 702   (set-variable 'truncate-lines 't)
 703   (add-hook 'after-save-hook 'stgit-update-saved-file)
 704   (run-hooks 'stgit-mode-hook))
 705
 706 (defun stgit-update-saved-file ()
 707   (let* ((file (expand-file-name buffer-file-name))
 708          (dir (file-name-directory file))
 709          (gitdir (condition-case nil (git-get-top-dir dir)
 710                    (error nil)))
 711          (buffer (and gitdir (stgit-find-buffer gitdir))))
 712     (when buffer
 713       (with-current-buffer buffer
 714         (stgit-refresh-worktree)))))
 715
 716 (defun stgit-add-mark (patchsym)
 717   "Mark the patch PATCHSYM."
 718   (setq stgit-marked-patches (cons patchsym stgit-marked-patches)))
 719
 720 (defun stgit-remove-mark (patchsym)
 721   "Unmark the patch PATCHSYM."
 722   (setq stgit-marked-patches (delq patchsym stgit-marked-patches)))
 723
 724 (defun stgit-clear-marks ()
 725   "Unmark all patches."
 726   (setq stgit-marked-patches '()))
 727
 728 (defun stgit-patch-at-point (&optional cause-error)
 729   (get-text-property (point) 'patch-data))
 730
 731 (defun stgit-patch-name-at-point (&optional cause-error only-patches)
 732   "Return the patch name on the current line as a symbol.
 733 If CAUSE-ERROR is not nil, signal an error if none found.
 734 If ONLY-PATCHES is not nil, only allow real patches, and not
 735 index or work tree."
 736   (let ((patch (stgit-patch-at-point)))
 737     (and patch
 738          only-patches
 739          (memq (stgit-patch-status patch) '(work index))
 740          (setq patch nil))
 741     (cond (patch
 742            (stgit-patch-name patch))
 743           (cause-error
 744            (error "No patch on this line")))))
 745
 746 (defun stgit-patched-file-at-point ()
 747   (get-text-property (point) 'file-data))
 748
 749 (defun stgit-patches-marked-or-at-point ()
 750   "Return the symbols of the marked patches, or the patch on the current line."
 751   (if stgit-marked-patches
 752       stgit-marked-patches
 753     (let ((patch (stgit-patch-name-at-point)))
 754       (if patch
 755           (list patch)
 756         '()))))
 757
 758 (defun stgit-goto-patch (patchsym)
 759   "Move point to the line containing patch PATCHSYM.
 760 If that patch cannot be found, do nothing."
 761   (let ((node (ewoc-nth stgit-ewoc 0)))
 762     (while (and node (not (eq (stgit-patch-name (ewoc-data node))
 763                               patchsym)))
 764       (setq node (ewoc-next stgit-ewoc node)))
 765     (when node
 766       (ewoc-goto-node stgit-ewoc node)
 767       (move-to-column goal-column))))
 768
 769 (defun stgit-init ()
 770   "Run stg init."
 771   (interactive)
 772   (stgit-capture-output nil
 773     (stgit-run "init"))
 774   (stgit-reload))
 775
 776 (defun stgit-mark ()
 777   "Mark the patch under point."
 778   (interactive)
 779   (let* ((node (ewoc-locate stgit-ewoc))
 780          (patch (ewoc-data node))
 781          (name (stgit-patch-name patch)))
 782     (when (eq name :work)
 783       (error "Cannot mark the work tree"))
 784     (when (eq name :index)
 785       (error "Cannot mark the index"))
 786     (stgit-add-mark (stgit-patch-name patch))
 787     (ewoc-invalidate stgit-ewoc node))
 788   (stgit-next-patch))
 789
 790 (defun stgit-unmark-up ()
 791   "Remove mark from the patch on the previous line."
 792   (interactive)
 793   (stgit-previous-patch)
 794   (let* ((node (ewoc-locate stgit-ewoc))
 795          (patch (ewoc-data node)))
 796     (stgit-remove-mark (stgit-patch-name patch))
 797     (ewoc-invalidate stgit-ewoc node))
 798   (move-to-column (stgit-goal-column)))
 799
 800 (defun stgit-unmark-down ()
 801   "Remove mark from the patch on the current line."
 802   (interactive)
 803   (let* ((node (ewoc-locate stgit-ewoc))
 804          (patch (ewoc-data node)))
 805     (stgit-remove-mark (stgit-patch-name patch))
 806     (ewoc-invalidate stgit-ewoc node))
 807   (stgit-next-patch))
 808
 809 (defun stgit-rename (name)
 810   "Rename the patch under point to NAME."
 811   (interactive (list
 812                 (read-string "Patch name: "
 813                              (symbol-name (stgit-patch-name-at-point t t)))))
 814   (let ((old-patchsym (stgit-patch-name-at-point t t)))
 815     (stgit-capture-output nil
 816       (stgit-run "rename" old-patchsym name))
 817     (let ((name-sym (intern name)))
 818       (when (memq old-patchsym stgit-expanded-patches)
 819         (setq stgit-expanded-patches
 820             (cons name-sym (delq old-patchsym stgit-expanded-patches))))
 821       (when (memq old-patchsym stgit-marked-patches)
 822         (setq stgit-marked-patches
 823             (cons name-sym (delq old-patchsym stgit-marked-patches))))
 824       (stgit-reload)
 825       (stgit-goto-patch name-sym))))
 826
 827 (defun stgit-reload-or-repair (repair)
 828   "Update the contents of the StGit buffer (`stgit-reload').
 829
 830 With a prefix argument, repair the StGit metadata if the branch
 831 was modified with git commands (`stgit-repair')."
 832   (interactive "P")
 833   (if repair
 834       (stgit-repair)
 835     (stgit-reload)))
 836
 837 (defun stgit-repair ()
 838   "Run stg repair."
 839   (interactive)
 840   (stgit-capture-output nil
 841     (stgit-run "repair"))
 842   (stgit-reload))
 843
 844 (defun stgit-available-branches ()
 845   "Returns a list of the available stg branches"
 846   (let ((output (with-output-to-string
 847                   (stgit-run "branch" "--list")))
 848         (start 0)
 849         result)
 850     (while (string-match "^>?\\s-+s\\s-+\\(\\S-+\\)" output start)
 851       (setq result (cons (match-string 1 output) result))
 852       (setq start (match-end 0)))
 853     result))
 854
 855 (defun stgit-branch (branch)
 856   "Switch to branch BRANCH."
 857   (interactive (list (completing-read "Switch to branch: "
 858                                       (stgit-available-branches))))
 859   (stgit-capture-output nil (stgit-run "branch" "--" branch))
 860   (stgit-reload))
 861
 862 (defun stgit-commit (count)
 863   "Run stg commit on COUNT commits.
 864 Interactively, the prefix argument is used as COUNT."
 865   (interactive "p")
 866   (stgit-capture-output nil (stgit-run "commit" "-n" count))
 867   (stgit-reload))
 868
 869 (defun stgit-revert-file ()
 870   "Revert the file at point, which must be in the index or the
 871 working tree."
 872   (interactive)
 873   (let* ((patched-file (or (stgit-patched-file-at-point)
 874                            (error "No file on the current line")))
 875          (patch-name   (stgit-patch-name-at-point))
 876          (file-status  (stgit-file-status patched-file))
 877          (rm-file      (cond ((stgit-file-copy-or-rename patched-file)
 878                               (stgit-file-cr-to patched-file))
 879                              ((eq file-status 'add)
 880                               (stgit-file-file patched-file))))
 881          (co-file      (cond ((eq file-status 'rename)
 882                               (stgit-file-cr-from patched-file))
 883                              ((not (memq file-status '(copy add)))
 884                               (stgit-file-file patched-file)))))
 885
 886     (unless (memq patch-name '(:work :index))
 887       (error "No index or working tree file on this line"))
 888
 889     (let ((nfiles (+ (if rm-file 1 0) (if co-file 1 0))))
 890       (when (yes-or-no-p (format "Revert %d file%s? "
 891                                  nfiles
 892                                  (if (= nfiles 1) "" "s")))
 893         (stgit-capture-output nil
 894           (when rm-file
 895             (stgit-run-git "rm" "-f" "-q" "--" rm-file))
 896           (when co-file
 897             (stgit-run-git "checkout" "HEAD" co-file)))
 898         (stgit-reload)))))
 899
 900 (defun stgit-resolve-file ()
 901   "Resolve conflict in the file at point."
 902   (interactive)
 903   (let* ((patched-file (stgit-patched-file-at-point))
 904          (patch        (stgit-patch-at-point))
 905          (patch-name   (and patch (stgit-patch-name patch)))
 906          (status       (and patched-file (stgit-file-status patched-file))))
 907
 908     (unless (memq patch-name '(:work :index))
 909       (error "No index or working tree file on this line"))
 910
 911     (unless (eq status 'unmerged)
 912       (error "No conflict to resolve at the current line"))
 913
 914     (stgit-capture-output nil
 915       (stgit-move-change-to-index (stgit-file-file patched-file)))
 916
 917     (stgit-reload)))
 918
 919 (defun stgit-uncommit (count)
 920   "Run stg uncommit on COUNT commits.
 921 Interactively, the prefix argument is used as COUNT."
 922   (interactive "p")
 923   (stgit-capture-output nil (stgit-run "uncommit" "-n" count))
 924   (stgit-reload))
 925
 926 (defun stgit-push-next (npatches)
 927   "Push the first unapplied patch.
 928 With numeric prefix argument, push that many patches."
 929   (interactive "p")
 930   (stgit-capture-output nil (stgit-run "push" "-n" npatches))
 931   (stgit-reload)
 932   (stgit-refresh-git-status))
 933
 934 (defun stgit-pop-next (npatches)
 935   "Pop the topmost applied patch.
 936 With numeric prefix argument, pop that many patches."
 937   (interactive "p")
 938   (stgit-capture-output nil (stgit-run "pop" "-n" npatches))
 939   (stgit-reload)
 940   (stgit-refresh-git-status))
 941
 942 (defun stgit-applied-at-point ()
 943   "Is the patch on the current line applied?"
 944   (save-excursion
 945     (beginning-of-line)
 946     (looking-at "[>+]")))
 947
 948 (defun stgit-push-or-pop ()
 949   "Push or pop the patch on the current line."
 950   (interactive)
 951   (let ((patchsym (stgit-patch-name-at-point t))
 952         (applied (stgit-applied-at-point)))
 953     (stgit-capture-output nil
 954       (stgit-run (if applied "pop" "push") patchsym))
 955     (stgit-reload)))
 956
 957 (defun stgit-goto ()
 958   "Go to the patch on the current line."
 959   (interactive)
 960   (let ((patchsym (stgit-patch-name-at-point t)))
 961     (stgit-capture-output nil
 962       (stgit-run "goto" patchsym))
 963     (stgit-reload)))
 964
 965 (defun stgit-id (patchsym)
 966   "Return the git commit id for PATCHSYM.
 967 If PATCHSYM is a keyword, returns PATCHSYM unmodified."
 968   (if (keywordp patchsym)
 969       patchsym
 970     (let ((result (with-output-to-string
 971                     (stgit-run-silent "id" patchsym))))
 972       (unless (string-match "^\\([0-9A-Fa-f]\\{40\\}\\)$" result)
 973         (error "Cannot find commit id for %s" patchsym))
 974       (match-string 1 result))))
 975
 976 (defun stgit-show ()
 977   "Show the patch on the current line."
 978   (interactive)
 979   (stgit-capture-output "*StGit patch*"
 980     (case (get-text-property (point) 'entry-type)
 981       ('file
 982        (let* ((patched-file (stgit-patched-file-at-point))
 983               (patch-name (stgit-patch-name-at-point))
 984               (patch-id (stgit-id patch-name))
 985               (args (append (and (stgit-file-cr-from patched-file)
 986                                  (list (stgit-find-copies-harder-diff-arg)))
 987                             (cond ((eq patch-id :index)
 988                                    '("--cached"))
 989                                   ((eq patch-id :work)
 990                                    nil)
 991                                   (t
 992                                    (list (concat patch-id "^") patch-id)))
 993                             '("--")
 994                               (if (stgit-file-copy-or-rename patched-file)
 995                                   (list (stgit-file-cr-from patched-file)
 996                                         (stgit-file-cr-to patched-file))
 997                                 (list (stgit-file-file patched-file))))))
 998          (apply 'stgit-run-git "diff" args)))
 999       ('patch
1000        (let* ((patch-name (stgit-patch-name-at-point))
1001               (patch-id (stgit-id patch-name)))
1002          (if (or (eq patch-id :index) (eq patch-id :work))
1003              (apply 'stgit-run-git "diff"
1004                     (stgit-find-copies-harder-diff-arg)
1005                     (and (eq patch-id :index)
1006                          '("--cached")))
1007            (stgit-run "show" "-O" "--patch-with-stat" "-O" "-M"
1008                       (stgit-patch-name-at-point)))))
1009       (t
1010        (error "No patch or file at point")))
1011     (with-current-buffer standard-output
1012       (goto-char (point-min))
1013       (diff-mode))))
1014
1015 (defun stgit-move-change-to-index (file)
1016   "Copies the workspace state of FILE to index, using git add or git rm"
1017   (let ((op (if (or (file-exists-p file) (file-symlink-p file))
1018                 '("add") '("rm" "-q"))))
1019     (stgit-capture-output "*git output*"
1020       (apply 'stgit-run-git (append op '("--") (list file))))))
1021
1022 (defun stgit-remove-change-from-index (file)
1023   "Unstages the change in FILE from the index"
1024   (stgit-capture-output "*git output*"
1025     (stgit-run-git "reset" "-q" "--" file)))
1026
1027 (defun stgit-file-toggle-index ()
1028   "Move modified file in or out of the index."
1029   (interactive)
1030   (let ((patched-file (stgit-patched-file-at-point)))
1031     (unless patched-file
1032       (error "No file on the current line"))
1033     (when (eq (stgit-file-status patched-file) 'unmerged)
1034       (error (substitute-command-keys "Use \\[stgit-resolve-file] to move an unmerged file to the index")))
1035     (let ((patch-name (stgit-patch-name-at-point)))
1036       (cond ((eq patch-name :work)
1037              (stgit-move-change-to-index (stgit-file-file patched-file)))
1038             ((eq patch-name :index)
1039              (stgit-remove-change-from-index (stgit-file-file patched-file)))
1040             (t
1041              (error "Can only move files in the working tree to index")))))
1042   (stgit-refresh-worktree)
1043   (stgit-refresh-index))
1044
1045 (defun stgit-edit ()
1046   "Edit the patch on the current line."
1047   (interactive)
1048   (let ((patchsym (stgit-patch-name-at-point t t))
1049         (edit-buf (get-buffer-create "*StGit edit*"))
1050         (dir default-directory))
1051     (log-edit 'stgit-confirm-edit t nil edit-buf)
1052     (set (make-local-variable 'stgit-edit-patchsym) patchsym)
1053     (setq default-directory dir)
1054     (let ((standard-output edit-buf))
1055       (stgit-run-silent "edit" "--save-template=-" patchsym))))
1056
1057 (defun stgit-confirm-edit ()
1058   (interactive)
1059   (let ((file (make-temp-file "stgit-edit-")))
1060     (write-region (point-min) (point-max) file)
1061     (stgit-capture-output nil
1062       (stgit-run "edit" "-f" file stgit-edit-patchsym))
1063     (with-current-buffer log-edit-parent-buffer
1064       (stgit-reload))))
1065
1066 (defun stgit-new (add-sign)
1067   "Create a new patch.
1068 With a prefix argument, include a \"Signed-off-by:\" line at the
1069 end of the patch."
1070   (interactive "P")
1071   (let ((edit-buf (get-buffer-create "*StGit edit*"))
1072         (dir default-directory))
1073     (log-edit 'stgit-confirm-new t nil edit-buf)
1074     (setq default-directory dir)
1075     (when add-sign
1076       (save-excursion
1077         (let ((standard-output (current-buffer)))
1078           (stgit-run-silent "new" "--sign" "--save-template=-"))))))
1079
1080 (defun stgit-confirm-new ()
1081   (interactive)
1082   (let ((file (make-temp-file "stgit-edit-")))
1083     (write-region (point-min) (point-max) file)
1084     (stgit-capture-output nil
1085       (stgit-run "new" "-f" file))
1086     (with-current-buffer log-edit-parent-buffer
1087       (stgit-reload))))
1088
1089 (defun stgit-create-patch-name (description)
1090   "Create a patch name from a long description"
1091   (let ((patch ""))
1092     (while (> (length description) 0)
1093       (cond ((string-match "\\`[a-zA-Z_-]+" description)
1094              (setq patch (downcase (concat patch
1095                                            (match-string 0 description))))
1096              (setq description (substring description (match-end 0))))
1097             ((string-match "\\` +" description)
1098              (setq patch (concat patch "-"))
1099              (setq description (substring description (match-end 0))))
1100             ((string-match "\\`[^a-zA-Z_-]+" description)
1101              (setq description (substring description (match-end 0))))))
1102     (cond ((= (length patch) 0)
1103            "patch")
1104           ((> (length patch) 20)
1105            (substring patch 0 20))
1106           (t patch))))
1107
1108 (defun stgit-delete (patchsyms &optional spill-p)
1109   "Delete the patches in PATCHSYMS.
1110 Interactively, delete the marked patches, or the patch at point.
1111
1112 With a prefix argument, or SPILL-P, spill the patch contents to
1113 the work tree and index."
1114   (interactive (list (stgit-patches-marked-or-at-point)
1115                      current-prefix-arg))
1116   (unless patchsyms
1117     (error "No patches to delete"))
1118   (when (memq :index patchsyms)
1119     (error "Cannot delete the index"))
1120   (when (memq :work  patchsyms)
1121     (error "Cannot delete the work tree"))
1122
1123   (let ((npatches (length patchsyms)))
1124     (when (yes-or-no-p (format "Really delete %d patch%s%s? "
1125                                npatches
1126                                (if (= 1 npatches) "" "es")
1127                                (if spill-p
1128                                    " (spilling contents to index)"
1129                                  "")))
1130       (let ((args (if spill-p
1131                       (cons "--spill" patchsyms)
1132                     patchsyms)))
1133         (stgit-capture-output nil
1134           (apply 'stgit-run "delete" args))
1135         (stgit-reload)))))
1136
1137 (defun stgit-move-patches-target ()
1138   "Return the patchsym indicating a target patch for
1139 `stgit-move-patches'.
1140
1141 This is either the patch at point, or one of :top and :bottom, if
1142 the point is after or before the applied patches."
1143
1144   (let ((patchsym (stgit-patch-name-at-point)))
1145     (cond (patchsym patchsym)
1146           ((save-excursion (re-search-backward "^>" nil t)) :top)
1147           (t :bottom))))
1148
1149 (defun stgit-sort-patches (patchsyms)
1150   "Returns the list of patches in PATCHSYMS sorted according to
1151 their position in the patch series, bottommost first.
1152
1153 PATCHSYMS may not contain duplicate entries."
1154   (let (sorted-patchsyms
1155         (series (with-output-to-string
1156                   (with-current-buffer standard-output
1157                     (stgit-run-silent "series" "--noprefix"))))
1158         start)
1159     (while (string-match "^\\(.+\\)" series start)
1160       (let ((patchsym (intern (match-string 1 series))))
1161         (when (memq patchsym patchsyms)
1162           (setq sorted-patchsyms (cons patchsym sorted-patchsyms))))
1163       (setq start (match-end 0)))
1164     (setq sorted-patchsyms (nreverse sorted-patchsyms))
1165
1166     (unless (= (length patchsyms) (length sorted-patchsyms))
1167       (error "Internal error"))
1168
1169     sorted-patchsyms))
1170
1171 (defun stgit-move-patches (patchsyms target-patch)
1172   "Move the patches in PATCHSYMS to below TARGET-PATCH.
1173 If TARGET-PATCH is :bottom or :top, move the patches to the
1174 bottom or top of the stack, respectively.
1175
1176 Interactively, move the marked patches to where the point is."
1177   (interactive (list stgit-marked-patches
1178                      (stgit-move-patches-target)))
1179   (unless patchsyms
1180     (error "Need at least one patch to move"))
1181
1182   (unless target-patch
1183     (error "Point not at a patch"))
1184
1185   (if (eq target-patch :top)
1186       (stgit-capture-output nil
1187         (apply 'stgit-run "float" patchsyms))
1188
1189     ;; need to have patchsyms sorted by position in the stack
1190     (let ((sorted-patchsyms (stgit-sort-patches patchsyms)))
1191       (while sorted-patchsyms
1192         (setq sorted-patchsyms
1193               (and (stgit-capture-output nil
1194                      (if (eq target-patch :bottom)
1195                          (stgit-run "sink" "--" (car sorted-patchsyms))
1196                        (stgit-run "sink" "--to" target-patch "--"
1197                                   (car sorted-patchsyms))))
1198                    (cdr sorted-patchsyms))))))
1199   (stgit-reload))
1200
1201 (defun stgit-squash (patchsyms)
1202   "Squash the patches in PATCHSYMS.
1203 Interactively, squash the marked patches.
1204
1205 Unless there are any conflicts, the patches will be merged into
1206 one patch, which will occupy the same spot in the series as the
1207 deepest patch had before the squash."
1208   (interactive (list stgit-marked-patches))
1209   (when (< (length patchsyms) 2)
1210     (error "Need at least two patches to squash"))
1211   (let ((stgit-buffer (current-buffer))
1212         (edit-buf (get-buffer-create "*StGit edit*"))
1213         (dir default-directory)
1214         (sorted-patchsyms (stgit-sort-patches patchsyms)))
1215     (log-edit 'stgit-confirm-squash t nil edit-buf)
1216     (set (make-local-variable 'stgit-patchsyms) sorted-patchsyms)
1217     (setq default-directory dir)
1218     (let ((result (let ((standard-output edit-buf))
1219                     (apply 'stgit-run-silent "squash"
1220                            "--save-template=-" sorted-patchsyms))))
1221
1222       ;; stg squash may have reordered the patches or caused conflicts
1223       (with-current-buffer stgit-buffer
1224         (stgit-reload))
1225
1226       (unless (eq 0 result)
1227         (fundamental-mode)
1228         (rename-buffer "*StGit error*")
1229         (resize-temp-buffer-window)
1230         (switch-to-buffer-other-window stgit-buffer)
1231         (error "stg squash failed")))))
1232
1233 (defun stgit-confirm-squash ()
1234   (interactive)
1235   (let ((file (make-temp-file "stgit-edit-")))
1236     (write-region (point-min) (point-max) file)
1237     (stgit-capture-output nil
1238       (apply 'stgit-run "squash" "-f" file stgit-patchsyms))
1239     (with-current-buffer log-edit-parent-buffer
1240       (stgit-clear-marks)
1241       ;; Go to first marked patch and stay there
1242       (goto-char (point-min))
1243       (re-search-forward (concat "^[>+-]\\*") nil t)
1244       (move-to-column goal-column)
1245       (let ((pos (point)))
1246         (stgit-reload)
1247         (goto-char pos)))))
1248
1249 (defun stgit-help ()
1250   "Display help for the StGit mode."
1251   (interactive)
1252   (describe-function 'stgit-mode))
1253
1254 (defun stgit-undo (&optional arg)
1255   "Run stg undo.
1256 With prefix argument, run it with the --hard flag."
1257   (interactive "P")
1258   (stgit-capture-output nil
1259     (if arg
1260         (stgit-run "undo" "--hard")
1261       (stgit-run "undo")))
1262   (stgit-reload))
1263
1264 (defun stgit-refresh (&optional arg)
1265   "Run stg refresh.
1266 If the index contains any changes, only refresh from index.
1267
1268 With prefix argument, refresh the marked patch or the patch under point."
1269   (interactive "P")
1270   (let ((patchargs (if arg
1271                        (let ((patches (stgit-patches-marked-or-at-point)))
1272                          (cond ((null patches)
1273                                 (error "No patch to update"))
1274                                ((> (length patches) 1)
1275                                 (error "Too many patches selected"))
1276                                (t
1277                                 (cons "-p" patches))))
1278                      nil)))
1279     (unless (stgit-index-empty-p)
1280       (setq patchargs (cons "--index" patchargs)))
1281     (stgit-capture-output nil
1282       (apply 'stgit-run "refresh" patchargs))
1283     (stgit-refresh-git-status))
1284   (stgit-reload))
1285
1286 (defcustom stgit-show-worktree-mode 'center
1287   "This variable controls where the \"Index\" and \"Work tree\"
1288 will be shown on in the buffer.
1289
1290 It can be set to 'top (above all patches), 'center (show between
1291 applied and unapplied patches), and 'bottom (below all patches).
1292
1293 See also `stgit-show-worktree'."
1294   :type '(radio (const :tag "above all patches (top)" top)
1295                 (const :tag "between applied and unapplied patches (center)"
1296                        center)
1297                 (const :tag "below all patches (bottom)" bottom))
1298   :group 'stgit)
1299
1300 (defcustom stgit-default-show-worktree
1301   nil
1302   "Set to non-nil to by default show the working tree in a new stgit buffer.
1303
1304 This value is used as the default value for `stgit-show-worktree'."
1305   :type 'boolean
1306   :group 'stgit)
1307
1308 (defvar stgit-show-worktree nil
1309   "If nil, inhibit showing work tree and index in the stgit buffer.
1310
1311 See also `stgit-show-worktree-mode'.")
1312
1313 (defun stgit-toggle-worktree (&optional arg)
1314   "Toggle the visibility of the work tree.
1315 With arg, show the work tree if arg is positive.
1316
1317 Its initial setting is controlled by `stgit-default-show-worktree'.
1318
1319 `stgit-show-worktree-mode' controls where on screen the index and
1320 work tree will show up."
1321   (interactive)
1322   (setq stgit-show-worktree
1323         (if (numberp arg)
1324             (> arg 0)
1325           (not stgit-show-worktree)))
1326   (stgit-reload))
1327
1328 (provide 'stgit)