chiark - git - mdw - stgit/blob - contrib/stgit.el

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