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
  14 (defun stgit (dir)
  15   "Manage StGit patches for the tree in DIR."
  16   (interactive "DDirectory: \n")
  17   (switch-to-stgit-buffer (git-get-top-dir dir))
  18   (stgit-reload))
  19
  20 (unless (fboundp 'git-get-top-dir)
  21   (defun git-get-top-dir (dir)
  22     "Retrieve the top-level directory of a git tree."
  23     (let ((cdup (with-output-to-string
  24                   (with-current-buffer standard-output
  25                     (cd dir)
  26                     (unless (eq 0 (call-process "git" nil t nil
  27                                                 "rev-parse" "--show-cdup"))
  28                       (error "cannot find top-level git tree for %s." dir))))))
  29       (expand-file-name (concat (file-name-as-directory dir)
  30                                 (car (split-string cdup "\n")))))))
  31
  32 (defun stgit-refresh-git-status (&optional dir)
  33   "If it exists, refresh the `git-status' buffer belonging to
  34 directory DIR or `default-directory'"
  35   (when (and (fboundp 'git-find-status-buffer)
  36              (fboundp 'git-refresh-status))
  37     (let* ((top-dir (git-get-top-dir (or dir default-directory)))
  38            (git-status-buffer (and top-dir (git-find-status-buffer top-dir))))
  39       (when git-status-buffer
  40         (with-current-buffer git-status-buffer
  41           (git-refresh-status))))))
  42
  43 (defun switch-to-stgit-buffer (dir)
  44   "Switch to a (possibly new) buffer displaying StGit patches for DIR."
  45   (setq dir (file-name-as-directory dir))
  46   (let ((buffers (buffer-list)))
  47     (while (and buffers
  48                 (not (with-current-buffer (car buffers)
  49                        (and (eq major-mode 'stgit-mode)
  50                             (string= default-directory dir)))))
  51       (setq buffers (cdr buffers)))
  52     (switch-to-buffer (if buffers
  53                           (car buffers)
  54                         (create-stgit-buffer dir)))))
  55
  56 (defun create-stgit-buffer (dir)
  57   "Create a buffer for showing StGit patches.
  58 Argument DIR is the repository path."
  59   (let ((buf (create-file-buffer (concat dir "*stgit*")))
  60         (inhibit-read-only t))
  61     (with-current-buffer buf
  62       (setq default-directory dir)
  63       (stgit-mode)
  64       (setq buffer-read-only t))
  65     buf))
  66
  67 (defmacro stgit-capture-output (name &rest body)
  68   "Capture StGit output and show it in a window at the end."
  69   `(let ((output-buf (get-buffer-create ,(or name "*StGit output*")))
  70          (stgit-dir default-directory)
  71          (inhibit-read-only t))
  72      (with-current-buffer output-buf
  73        (erase-buffer)
  74        (setq default-directory stgit-dir)
  75        (setq buffer-read-only t))
  76      (let ((standard-output output-buf))
  77        ,@body)
  78      (with-current-buffer output-buf
  79        (set-buffer-modified-p nil)
  80        (setq buffer-read-only t)
  81        (if (< (point-min) (point-max))
  82            (display-buffer output-buf t)))))
  83 (put 'stgit-capture-output 'lisp-indent-function 1)
  84
  85 (defun stgit-run-silent (&rest args)
  86   (apply 'call-process "stg" nil standard-output nil args))
  87
  88 (defun stgit-run (&rest args)
  89   (let ((msgcmd (mapconcat #'identity args " ")))
  90     (message "Running stg %s..." msgcmd)
  91     (apply 'call-process "stg" nil standard-output nil args)
  92     (message "Running stg %s...done" msgcmd)))
  93
  94 (defun stgit-run-git (&rest args)
  95   (let ((msgcmd (mapconcat #'identity args " ")))
  96     (message "Running git %s..." msgcmd)
  97     (apply 'call-process "git" nil standard-output nil args)
  98     (message "Running git %s...done" msgcmd)))
  99
 100 (defun stgit-run-git-silent (&rest args)
 101   (apply 'call-process "git" nil standard-output nil args))
 102
 103 (defun stgit-reload ()
 104   "Update the contents of the StGit buffer."
 105   (interactive)
 106   (let ((inhibit-read-only t)
 107         (curline (line-number-at-pos))
 108         (curpatch (stgit-patch-at-point)))
 109     (erase-buffer)
 110     (insert "Branch: ")
 111     (stgit-run-silent "branch")
 112     (stgit-run-silent "series" "--description")
 113     (stgit-rescan)
 114     (if curpatch
 115         (stgit-goto-patch curpatch)
 116       (goto-line curline)))
 117   (stgit-refresh-git-status))
 118
 119 (defgroup stgit nil
 120   "A user interface for the StGit patch maintenance tool."
 121   :group 'tools)
 122
 123 (defface stgit-description-face
 124   '((((background dark)) (:foreground "tan"))
 125     (((background light)) (:foreground "dark red")))
 126   "The face used for StGit descriptions"
 127   :group 'stgit)
 128
 129 (defface stgit-top-patch-face
 130   '((((background dark)) (:weight bold :foreground "yellow"))
 131     (((background light)) (:weight bold :foreground "purple"))
 132     (t (:weight bold)))
 133   "The face used for the top patch names"
 134   :group 'stgit)
 135
 136 (defface stgit-applied-patch-face
 137   '((((background dark)) (:foreground "light yellow"))
 138     (((background light)) (:foreground "purple"))
 139     (t ()))
 140   "The face used for applied patch names"
 141   :group 'stgit)
 142
 143 (defface stgit-unapplied-patch-face
 144   '((((background dark)) (:foreground "gray80"))
 145     (((background light)) (:foreground "orchid"))
 146     (t ()))
 147   "The face used for unapplied patch names"
 148   :group 'stgit)
 149
 150 (defface stgit-modified-file-face
 151   '((((class color) (background light)) (:foreground "purple"))
 152     (((class color) (background dark)) (:foreground "salmon")))
 153   "StGit mode face used for modified file status"
 154   :group 'stgit)
 155
 156 (defface stgit-unmerged-file-face
 157   '((((class color) (background light)) (:foreground "red" :bold t))
 158     (((class color) (background dark)) (:foreground "red" :bold t)))
 159   "StGit mode face used for unmerged file status"
 160   :group 'stgit)
 161
 162 (defface stgit-unknown-file-face
 163   '((((class color) (background light)) (:foreground "goldenrod" :bold t))
 164     (((class color) (background dark)) (:foreground "goldenrod" :bold t)))
 165   "StGit mode face used for unknown file status"
 166   :group 'stgit)
 167
 168 (defcustom stgit-expand-find-copies-harder
 169   nil
 170   "Try harder to find copied files when listing patches.
 171
 172 When not nil, runs git diff-tree with the --find-copies-harder
 173 flag, which reduces performance."
 174   :type 'boolean
 175   :group 'stgit)
 176
 177 (defconst stgit-file-status-code-strings
 178   (mapcar (lambda (arg)
 179             (cons (car arg)
 180                   (format "%-12s"
 181                           (propertize (cadr arg) 'face (car (cddr arg))))))
 182           '((add         "Added"        stgit-modified-file-face)
 183             (copy        "Copied"       stgit-modified-file-face)
 184             (delete      "Deleted"      stgit-modified-file-face)
 185             (modify      "Modified"     stgit-modified-file-face)
 186             (rename      "Renamed"      stgit-modified-file-face)
 187             (mode-change "Mode changed" stgit-modified-file-face)
 188             (unmerged    "Unmerged"     stgit-unmerged-file-face)
 189             (unknown     "Unknown"      stgit-unknown-file-face)))
 190   "Alist of code symbols to description strings")
 191
 192 (defun stgit-file-status-code-as-string (code)
 193   "Return stgit status code as string"
 194   (let ((str (assq code stgit-file-status-code-strings)))
 195     (and str (cdr str))))
 196
 197 (defun stgit-file-status-code (str)
 198   "Return stgit status code from git status string"
 199   (let ((code (assoc str '(("A" . add)
 200                            ("C" . copy)
 201                            ("D" . delete)
 202                            ("M" . modify)
 203                            ("R" . rename)
 204                            ("T" . mode-change)
 205                            ("U" . unmerged)
 206                            ("X" . unknown)))))
 207     (if code (cdr code) 'unknown)))
 208
 209 (defun stgit-expand-patch (patchsym)
 210   (save-excursion
 211     (forward-line)
 212     (let* ((start (point))
 213            (result (with-output-to-string
 214                      (stgit-run-git "diff-tree" "-r" "-z"
 215                                     (if stgit-expand-find-copies-harder
 216                                         "--find-copies-harder"
 217                                       "-C")
 218                                     (stgit-id (symbol-name patchsym))))))
 219       (let (mstart)
 220         (while (string-match "\0:[0-7]+ [0-7]+ [0-9A-Fa-f]\\{40\\} [0-9A-Fa-f]\\{40\\} \\(\\([CR]\\)\\([0-9]*\\)\0\\([^\0]*\\)\0\\([^\0]*\\)\\|\\([ABD-QS-Z]\\)\0\\([^\0]*\\)\\)"
 221                              result mstart)
 222           (let ((copy-or-rename (match-string 2 result))
 223                 (line-start (point))
 224                 properties)
 225             (insert "    ")
 226             (if copy-or-rename
 227                 (let ((cr-score       (match-string 3 result))
 228                       (cr-from-file   (match-string 4 result))
 229                       (cr-to-file     (match-string 5 result)))
 230                   (setq properties (list 'stgit-old-file cr-from-file
 231                                          'stgit-new-file cr-to-file))
 232                   (insert (stgit-file-status-code-as-string
 233                            (if (equal "C" copy-or-rename) 'copy 'rename))
 234                           cr-from-file
 235                           (propertize " -> " 'face 'stgit-description-face)
 236                           cr-to-file))
 237               (let ((status (stgit-file-status-code (match-string 6 result)))
 238                     (file   (match-string 7 result)))
 239                 (setq properties (list 'stgit-file file))
 240                 (insert (stgit-file-status-code-as-string status) file)))
 241             (insert ?\n)
 242             (add-text-properties line-start (point) properties))
 243           (setq mstart (match-end 0))))
 244       (when (= start (point))
 245         (insert "    <no files>\n"))
 246       (put-text-property start (point) 'stgit-patchsym patchsym))))
 247
 248 (defun stgit-rescan ()
 249   "Rescan the status buffer."
 250   (save-excursion
 251     (let ((marked ()))
 252       (goto-char (point-min))
 253       (while (not (eobp))
 254         (cond ((looking-at "Branch: \\(.*\\)")
 255                (put-text-property (match-beginning 1) (match-end 1)
 256                                   'face 'bold))
 257               ((looking-at "\\([>+-]\\)\\( \\)\\([^ ]+\\) *[|#] \\(.*\\)")
 258                (let ((state (match-string 1))
 259                      (patchsym (intern (match-string 3))))
 260                  (put-text-property
 261                   (match-beginning 3) (match-end 3) 'face
 262                   (cond ((string= state ">") 'stgit-top-patch-face)
 263                         ((string= state "+") 'stgit-applied-patch-face)
 264                         ((string= state "-") 'stgit-unapplied-patch-face)))
 265                  (put-text-property (match-beginning 4) (match-end 4)
 266                                     'face 'stgit-description-face)
 267                  (when (memq patchsym stgit-marked-patches)
 268                    (replace-match "*" nil nil nil 2)
 269                    (setq marked (cons patchsym marked)))
 270                  (when (memq patchsym stgit-expanded-patches)
 271                    (stgit-expand-patch patchsym))
 272                  ))
 273               ((or (looking-at "stg series: Branch \".*\" not initialised")
 274                    (looking-at "stg series: .*: branch not initialized"))
 275                (forward-line 1)
 276                (insert "Run M-x stgit-init to initialise")))
 277         (forward-line 1))
 278       (setq stgit-marked-patches (nreverse marked)))))
 279
 280 (defun stgit-select ()
 281   "Expand or collapse the current entry"
 282   (interactive)
 283   (let ((curpatch (stgit-patch-at-point)))
 284     (if (not curpatch)
 285         (let ((patched-file (stgit-patched-file-at-point)))
 286           (unless patched-file
 287             (error "No patch or file on the current line"))
 288           (let ((filename (expand-file-name (cdr patched-file))))
 289             (unless (file-exists-p filename)
 290               (error "File does not exist"))
 291             (find-file filename)))
 292       (setq curpatch (intern curpatch))
 293       (setq stgit-expanded-patches
 294             (if (memq curpatch stgit-expanded-patches)
 295                 (delq curpatch stgit-expanded-patches)
 296               (cons curpatch stgit-expanded-patches)))
 297       (stgit-reload))))
 298
 299 (defun stgit-find-file-other-window ()
 300   "Open file at point in other window"
 301   (interactive)
 302   (let ((patched-file (stgit-patched-file-at-point)))
 303     (unless patched-file
 304       (error "No file on the current line"))
 305     (let ((filename (expand-file-name (cdr patched-file))))
 306       (unless (file-exists-p filename)
 307         (error "File does not exist"))
 308       (find-file-other-window filename))))
 309
 310 (defun stgit-quit ()
 311   "Hide the stgit buffer."
 312   (interactive)
 313   (bury-buffer))
 314
 315 (defun stgit-git-status ()
 316   "Show status using `git-status'."
 317   (interactive)
 318   (unless (fboundp 'git-status)
 319     (error "stgit-git-status requires git-status"))
 320   (let ((dir default-directory))
 321     (save-selected-window
 322       (pop-to-buffer nil)
 323       (git-status dir))))
 324
 325 (defun stgit-next-line (&optional arg try-vscroll)
 326   "Move cursor vertically down ARG lines"
 327   (interactive "p\np")
 328   (next-line arg try-vscroll)
 329   (when (looking-at "  \\S-")
 330     (forward-char 2)))
 331
 332 (defun stgit-previous-line (&optional arg try-vscroll)
 333   "Move cursor vertically up ARG lines"
 334   (interactive "p\np")
 335   (previous-line arg try-vscroll)
 336   (when (looking-at "  \\S-")
 337     (forward-char 2)))
 338
 339 (defun stgit-next-patch (&optional arg)
 340   "Move cursor down ARG patches"
 341   (interactive "p")
 342   (unless arg
 343     (setq arg 1))
 344   (if (< arg 0)
 345       (stgit-previous-patch (- arg))
 346     (while (not (zerop arg))
 347       (setq arg (1- arg))
 348       (while (progn (stgit-next-line)
 349                     (not (stgit-patch-at-point)))))))
 350
 351 (defun stgit-previous-patch (&optional arg)
 352   "Move cursor up ARG patches"
 353   (interactive "p")
 354   (unless arg
 355     (setq arg 1))
 356   (if (< arg 0)
 357       (stgit-next-patch (- arg))
 358     (while (not (zerop arg))
 359       (setq arg (1- arg))
 360       (while (progn (stgit-previous-line)
 361                     (not (stgit-patch-at-point)))))))
 362
 363 (defvar stgit-mode-hook nil
 364   "Run after `stgit-mode' is setup.")
 365
 366 (defvar stgit-mode-map nil
 367   "Keymap for StGit major mode.")
 368
 369 (unless stgit-mode-map
 370   (setq stgit-mode-map (make-keymap))
 371   (suppress-keymap stgit-mode-map)
 372   (mapc (lambda (arg) (define-key stgit-mode-map (car arg) (cdr arg)))
 373         '((" " .        stgit-mark)
 374           ("m" .        stgit-mark)
 375           ("\d" .       stgit-unmark-up)
 376           ("u" .        stgit-unmark-down)
 377           ("?" .        stgit-help)
 378           ("h" .        stgit-help)
 379           ("p" .        stgit-previous-line)
 380           ("n" .        stgit-next-line)
 381           ("\C-p" .     stgit-previous-patch)
 382           ("\C-n" .     stgit-next-patch)
 383           ("\M-{" .     stgit-previous-patch)
 384           ("\M-}" .     stgit-next-patch)
 385           ("s" .        stgit-git-status)
 386           ("g" .        stgit-reload)
 387           ("r" .        stgit-refresh)
 388           ("\C-c\C-r" . stgit-rename)
 389           ("e" .        stgit-edit)
 390           ("c" .        stgit-coalesce)
 391           ("N" .        stgit-new)
 392           ("R" .        stgit-repair)
 393           ("C" .        stgit-commit)
 394           ("U" .        stgit-uncommit)
 395           ("\r" .       stgit-select)
 396           ("o" .        stgit-find-file-other-window)
 397           (">" .        stgit-push-next)
 398           ("<" .        stgit-pop-next)
 399           ("P" .        stgit-push-or-pop)
 400           ("G" .        stgit-goto)
 401           ("=" .        stgit-show)
 402           ("D" .        stgit-delete)
 403           ([(control ?/)] . stgit-undo)
 404           ("\C-_" .     stgit-undo)
 405           ("q" . stgit-quit))))
 406
 407 (defun stgit-mode ()
 408   "Major mode for interacting with StGit.
 409 Commands:
 410 \\{stgit-mode-map}"
 411   (kill-all-local-variables)
 412   (buffer-disable-undo)
 413   (setq mode-name "StGit"
 414         major-mode 'stgit-mode
 415         goal-column 2)
 416   (use-local-map stgit-mode-map)
 417   (set (make-local-variable 'list-buffers-directory) default-directory)
 418   (set (make-local-variable 'stgit-marked-patches) nil)
 419   (set (make-local-variable 'stgit-expanded-patches) nil)
 420   (set-variable 'truncate-lines 't)
 421   (run-hooks 'stgit-mode-hook))
 422
 423 (defun stgit-add-mark (patch)
 424   (let ((patchsym (intern patch)))
 425     (setq stgit-marked-patches (cons patchsym stgit-marked-patches))))
 426
 427 (defun stgit-remove-mark (patch)
 428   (let ((patchsym (intern patch)))
 429     (setq stgit-marked-patches (delq patchsym stgit-marked-patches))))
 430
 431 (defun stgit-clear-marks ()
 432   (setq stgit-marked-patches '()))
 433
 434 (defun stgit-marked-patches ()
 435   "Return the names of the marked patches."
 436   (mapcar 'symbol-name stgit-marked-patches))
 437
 438 (defun stgit-patch-at-point (&optional cause-error allow-file)
 439   "Return the patch name on the current line.
 440 If CAUSE-ERROR is not nil, signal an error if none found.
 441 If ALLOW-FILE is not nil, also handle when point is on a file of
 442 a patch."
 443   (or (and allow-file
 444            (let ((patchsym (get-text-property (point) 'stgit-patchsym)))
 445              (and patchsym
 446                   (symbol-name patchsym))))
 447       (save-excursion
 448         (beginning-of-line)
 449         (and (looking-at "[>+-][ *]\\([^ ]*\\)")
 450              (match-string-no-properties 1)))
 451       (and cause-error
 452            (error "No patch on this line"))))
 453
 454 (defun stgit-patched-file-at-point (&optional both-files)
 455   "Returns a cons of the patchsym and file name at point. For
 456 copies and renames, return the new file if the patch is either
 457 applied. If BOTH-FILES is non-nil, return a cons of the old and
 458 the new file names instead of just one name."
 459   (let ((patchsym (get-text-property (point) 'stgit-patchsym))
 460         (file     (get-text-property (point) 'stgit-file)))
 461     (cond ((not patchsym) nil)
 462           (file (cons patchsym file))
 463           (both-files
 464            (cons patchsym (cons (get-text-property (point) 'stgit-old-file)
 465                                 (get-text-property (point) 'stgit-new-file))))
 466           (t
 467            (let ((file-sym (save-excursion
 468                              (stgit-previous-patch)
 469                              (unless (equal (stgit-patch-at-point)
 470                                             (symbol-name patchsym))
 471                                (error "Cannot find the %s patch" patchsym))
 472                              (beginning-of-line)
 473                              (if (= (char-after) ?-)
 474                                  'stgit-old-file
 475                                'stgit-new-file))))
 476              (cons patchsym (get-text-property (point) file-sym)))))))
 477
 478 (defun stgit-patches-marked-or-at-point ()
 479   "Return the names of the marked patches, or the patch on the current line."
 480   (if stgit-marked-patches
 481       (stgit-marked-patches)
 482     (let ((patch (stgit-patch-at-point)))
 483       (if patch
 484           (list patch)
 485         '()))))
 486
 487 (defun stgit-goto-patch (patch)
 488   "Move point to the line containing PATCH."
 489   (let ((p (point)))
 490     (goto-char (point-min))
 491     (if (re-search-forward (concat "^[>+-][ *]" (regexp-quote patch) " ") nil t)
 492         (progn (move-to-column goal-column)
 493                t)
 494       (goto-char p)
 495       nil)))
 496
 497 (defun stgit-init ()
 498   "Run stg init."
 499   (interactive)
 500   (stgit-capture-output nil
 501     (stgit-run "init"))
 502   (stgit-reload))
 503
 504 (defun stgit-mark ()
 505   "Mark the patch under point."
 506   (interactive)
 507   (let ((patch (stgit-patch-at-point t)))
 508     (stgit-add-mark patch)
 509     (stgit-reload))
 510   (stgit-next-patch))
 511
 512 (defun stgit-unmark-up ()
 513   "Remove mark from the patch on the previous line."
 514   (interactive)
 515   (stgit-previous-patch)
 516   (stgit-remove-mark (stgit-patch-at-point t))
 517   (stgit-reload))
 518
 519 (defun stgit-unmark-down ()
 520   "Remove mark from the patch on the current line."
 521   (interactive)
 522   (stgit-remove-mark (stgit-patch-at-point t))
 523   (stgit-next-patch)
 524   (stgit-reload))
 525
 526 (defun stgit-rename (name)
 527   "Rename the patch under point to NAME."
 528   (interactive (list (read-string "Patch name: " (stgit-patch-at-point t))))
 529   (let ((old-name (stgit-patch-at-point t)))
 530     (stgit-capture-output nil
 531       (stgit-run "rename" old-name name))
 532     (let ((old-name-sym (intern old-name))
 533           (name-sym (intern name)))
 534       (when (memq old-name-sym stgit-expanded-patches)
 535         (setq stgit-expanded-patches
 536             (cons name-sym (delq old-name-sym stgit-expanded-patches))))
 537       (when (memq old-name-sym stgit-marked-patches)
 538         (setq stgit-marked-patches
 539             (cons name-sym (delq old-name-sym stgit-marked-patches)))))
 540     (stgit-reload)
 541     (stgit-goto-patch name)))
 542
 543 (defun stgit-repair ()
 544   "Run stg repair."
 545   (interactive)
 546   (stgit-capture-output nil
 547     (stgit-run "repair"))
 548   (stgit-reload))
 549
 550 (defun stgit-commit ()
 551   "Run stg commit."
 552   (interactive)
 553   (stgit-capture-output nil (stgit-run "commit"))
 554   (stgit-reload))
 555
 556 (defun stgit-uncommit (arg)
 557   "Run stg uncommit. Numeric arg determines number of patches to uncommit."
 558   (interactive "p")
 559   (stgit-capture-output nil (stgit-run "uncommit" "-n" (number-to-string arg)))
 560   (stgit-reload))
 561
 562 (defun stgit-push-next (npatches)
 563   "Push the first unapplied patch.
 564 With numeric prefix argument, push that many patches."
 565   (interactive "p")
 566   (stgit-capture-output nil (stgit-run "push" "-n"
 567                                        (number-to-string npatches)))
 568   (stgit-reload)
 569   (stgit-refresh-git-status))
 570
 571 (defun stgit-pop-next (npatches)
 572   "Pop the topmost applied patch.
 573 With numeric prefix argument, pop that many patches."
 574   (interactive "p")
 575   (stgit-capture-output nil (stgit-run "pop" "-n" (number-to-string npatches)))
 576   (stgit-reload)
 577   (stgit-refresh-git-status))
 578
 579 (defun stgit-applied-at-point ()
 580   "Is the patch on the current line applied?"
 581   (save-excursion
 582     (beginning-of-line)
 583     (looking-at "[>+]")))
 584
 585 (defun stgit-push-or-pop ()
 586   "Push or pop the patch on the current line."
 587   (interactive)
 588   (let ((patch (stgit-patch-at-point t))
 589         (applied (stgit-applied-at-point)))
 590     (stgit-capture-output nil
 591       (stgit-run (if applied "pop" "push") patch))
 592     (stgit-reload)))
 593
 594 (defun stgit-goto ()
 595   "Go to the patch on the current line."
 596   (interactive)
 597   (let ((patch (stgit-patch-at-point t)))
 598     (stgit-capture-output nil
 599       (stgit-run "goto" patch))
 600     (stgit-reload)))
 601
 602 (defun stgit-id (patch)
 603   "Return the git commit id for PATCH"
 604   (let ((result (with-output-to-string
 605                   (stgit-run-silent "id" patch))))
 606     (unless (string-match "^\\([0-9A-Fa-f]\\{40\\}\\)$" result)
 607       (error "Cannot find commit id for %s" patch))
 608     (match-string 1 result)))
 609
 610 (defun stgit-show ()
 611   "Show the patch on the current line."
 612   (interactive)
 613   (stgit-capture-output "*StGit patch*"
 614     (let ((patch (stgit-patch-at-point)))
 615       (if (not patch)
 616           (let ((patched-file (stgit-patched-file-at-point t)))
 617             (unless patched-file
 618               (error "No patch or file at point"))
 619             (let ((id (stgit-id (symbol-name (car patched-file)))))
 620               (with-output-to-temp-buffer "*StGit diff*"
 621                 (if (consp (cdr patched-file))
 622                     ;; two files (copy or rename)
 623                     (stgit-run-git "diff" "-C" "-C" (concat id "^") id "--"
 624                                    (cadr patched-file) (cddr patched-file))
 625                   ;; just one file
 626                   (stgit-run-git "diff" (concat id "^") id "--"
 627                                  (cdr patched-file)))
 628                 (with-current-buffer standard-output
 629                   (diff-mode)))))
 630         (stgit-run "show" (stgit-patch-at-point))
 631         (with-current-buffer standard-output
 632           (goto-char (point-min))
 633           (diff-mode))))))
 634
 635 (defun stgit-edit ()
 636   "Edit the patch on the current line."
 637   (interactive)
 638   (let ((patch (stgit-patch-at-point t))
 639         (edit-buf (get-buffer-create "*StGit edit*"))
 640         (dir default-directory))
 641     (log-edit 'stgit-confirm-edit t nil edit-buf)
 642     (set (make-local-variable 'stgit-edit-patch) patch)
 643     (setq default-directory dir)
 644     (let ((standard-output edit-buf))
 645       (stgit-run-silent "edit" "--save-template=-" patch))))
 646
 647 (defun stgit-confirm-edit ()
 648   (interactive)
 649   (let ((file (make-temp-file "stgit-edit-")))
 650     (write-region (point-min) (point-max) file)
 651     (stgit-capture-output nil
 652       (stgit-run "edit" "-f" file stgit-edit-patch))
 653     (with-current-buffer log-edit-parent-buffer
 654       (stgit-reload))))
 655
 656 (defun stgit-new ()
 657   "Create a new patch."
 658   (interactive)
 659   (let ((edit-buf (get-buffer-create "*StGit edit*"))
 660         (dir default-directory))
 661     (log-edit 'stgit-confirm-new t nil edit-buf)
 662     (setq default-directory dir)))
 663
 664 (defun stgit-confirm-new ()
 665   (interactive)
 666   (let ((file (make-temp-file "stgit-edit-")))
 667     (write-region (point-min) (point-max) file)
 668     (stgit-capture-output nil
 669       (stgit-run "new" "-f" file))
 670     (with-current-buffer log-edit-parent-buffer
 671       (stgit-reload))))
 672
 673 (defun stgit-create-patch-name (description)
 674   "Create a patch name from a long description"
 675   (let ((patch ""))
 676     (while (> (length description) 0)
 677       (cond ((string-match "\\`[a-zA-Z_-]+" description)
 678              (setq patch (downcase (concat patch (match-string 0 description))))
 679              (setq description (substring description (match-end 0))))
 680             ((string-match "\\` +" description)
 681              (setq patch (concat patch "-"))
 682              (setq description (substring description (match-end 0))))
 683             ((string-match "\\`[^a-zA-Z_-]+" description)
 684              (setq description (substring description (match-end 0))))))
 685     (cond ((= (length patch) 0)
 686            "patch")
 687           ((> (length patch) 20)
 688            (substring patch 0 20))
 689           (t patch))))
 690
 691 (defun stgit-delete (patch-names)
 692   "Delete the named patches."
 693   (interactive (list (stgit-patches-marked-or-at-point)))
 694   (if (zerop (length patch-names))
 695       (error "No patches to delete")
 696     (when (yes-or-no-p (format "Really delete %d patches? "
 697                                (length patch-names)))
 698       (stgit-capture-output nil
 699         (apply 'stgit-run "delete" patch-names))
 700       (stgit-reload))))
 701
 702 (defun stgit-coalesce (patch-names)
 703   "Run stg coalesce on the named patches."
 704   (interactive (list (stgit-marked-patches)))
 705   (let ((edit-buf (get-buffer-create "*StGit edit*"))
 706         (dir default-directory))
 707     (log-edit 'stgit-confirm-coalesce t nil edit-buf)
 708     (set (make-local-variable 'stgit-patches) patch-names)
 709     (setq default-directory dir)
 710     (let ((standard-output edit-buf))
 711       (apply 'stgit-run-silent "coalesce" "--save-template=-" patch-names))))
 712
 713 (defun stgit-confirm-coalesce ()
 714   (interactive)
 715   (let ((file (make-temp-file "stgit-edit-")))
 716     (write-region (point-min) (point-max) file)
 717     (stgit-capture-output nil
 718       (apply 'stgit-run "coalesce" "-f" file stgit-patches))
 719     (with-current-buffer log-edit-parent-buffer
 720       (stgit-clear-marks)
 721       ;; Go to first marked patch and stay there
 722       (goto-char (point-min))
 723       (re-search-forward (concat "^[>+-]\\*") nil t)
 724       (move-to-column goal-column)
 725       (let ((pos (point)))
 726         (stgit-reload)
 727         (goto-char pos)))))
 728
 729 (defun stgit-help ()
 730   "Display help for the StGit mode."
 731   (interactive)
 732   (describe-function 'stgit-mode))
 733
 734 (defun stgit-undo (&optional arg)
 735   "Run stg undo.
 736 With prefix argument, run it with the --hard flag."
 737   (interactive "P")
 738   (stgit-capture-output nil
 739     (if arg
 740         (stgit-run "undo" "--hard")
 741       (stgit-run "undo")))
 742   (stgit-reload))
 743
 744 (defun stgit-refresh (&optional arg)
 745   "Run stg refresh.
 746 With prefix argument, refresh the marked patch or the patch under point."
 747   (interactive "P")
 748   (let ((patchargs (if arg
 749                        (let ((patches (stgit-patches-marked-or-at-point)))
 750                          (cond ((null patches)
 751                                 (error "no patch to update"))
 752                                ((> (length patches) 1)
 753                                 (error "too many patches selected"))
 754                                (t
 755                                 (cons "-p" patches))))
 756                      nil)))
 757     (stgit-capture-output nil
 758       (apply 'stgit-run "refresh" patchargs))
 759     (stgit-refresh-git-status))
 760   (stgit-reload))
 761
 762 (provide 'stgit)