Re: support for bzr shelve/unshelve in vc-dir

[Dan Nicolaescu <dann@ics.uci.edu>]

Xavier Maillard <xma@gnu.org> writes:

  >    Are the bzr shelve/unshelve commands popular?
  > 
  >    Do we want something similar to the vc-dir support for "git stash" for
  >    bzr shelve/unshelve?
  > 
  >    If yes, I can try to whip up a patch before the feature freeze...
  > 
  > Speaking for myself, I'd vote for this feature.

Here's a quick port of the git code (It still uses the "stash" name).
It can create and remove shelves.
I don't see a way to display the diff for a shelf.


Index: vc-bzr.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/vc-bzr.el,v
retrieving revision 1.86
diff -u -3 -p -u -p -r1.86 vc-bzr.el
--- vc-bzr.el	26 Nov 2009 14:50:32 -0000	1.86
+++ vc-bzr.el	2 Dec 2009 05:25:45 -0000
@@ -703,11 +705,33 @@ stream.  Standard error output is discar
   (vc-exec-after
    `(vc-bzr-after-dir-status (quote ,update-function))))
 
+(defvar vc-bzr-stash-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map "\C-k" 'vc-bzr-stash-delete-at-point)
+    (define-key map "=" 'vc-bzr-stash-show-at-point)
+    (define-key map "\C-m" 'vc-bzr-stash-show-at-point)
+    map))
+
+(defvar vc-bzr-extra-menu-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map [bzr-st]
+      '(menu-item "Stash..." vc-bzr-stash
+		  :help "Stash away changes"))
+    (define-key map [bzr-ss]
+      '(menu-item "Show Stash..." vc-bzr-stash-show
+		  :help "Show stash contents"))
+    map))
+
+(defun vc-bzr-extra-menu () vc-bzr-extra-menu-map)
+
+(defun vc-bzr-extra-status-menu () vc-bzr-extra-menu-map)
+
 (defun vc-bzr-dir-extra-headers (dir)
   (let*
       ((str (with-temp-buffer
 	      (vc-bzr-command "info" t 0 dir)
 	      (buffer-string)))
+       (stash (vc-bzr-stash-list))
        (light-checkout
 	(when (string-match ".+light checkout root: \\(.+\\)$" str)
 	  (match-string 1 str)))
@@ -721,18 +745,81 @@ stream.  Standard error output is discar
       (if (string-match "parent branch: \\(.+\\)$" str)
  	  (match-string 1 str)
  	"None")
-       'face 'font-lock-variable-name-face)
+      'face 'font-lock-variable-name-face)
      "\n"
-      (when light-checkout
-	(concat
-	 (propertize "Light checkout root: " 'face 'font-lock-type-face)
-	 (propertize light-checkout 'face 'font-lock-variable-name-face)
-	 "\n"))
-      (when light-checkout-branch
-	(concat
-	 (propertize "Checkout of branch : " 'face 'font-lock-type-face)
-	 (propertize light-checkout-branch 'face 'font-lock-variable-name-face)
-	 "\n")))))
+     (when light-checkout
+       (concat
+	(propertize "Light checkout root: " 'face 'font-lock-type-face)
+	(propertize light-checkout 'face 'font-lock-variable-name-face)
+	"\n"))
+     (when light-checkout-branch
+       (concat
+	(propertize "Checkout of branch : " 'face 'font-lock-type-face)
+	(propertize light-checkout-branch 'face 'font-lock-variable-name-face)
+	"\n"))
+     (if stash
+	 (concat
+	  (propertize "Stash      :\n" 'face 'font-lock-type-face)
+	  (mapconcat
+	   (lambda (x)
+	     (propertize x
+			 'face 'font-lock-variable-name-face
+			 'mouse-face 'highlight
+			 'keymap vc-bzr-stash-map))
+	   stash "\n"))
+       (concat
+	(propertize "Stash      : " 'face 'font-lock-type-face)
+	(propertize "Nothing stashed"
+		    'face 'font-lock-variable-name-face))))))
+
+
+(defun vc-bzr-stash (name)
+  "Create a stash."
+  (interactive "sStash name: ")
+  (let ((root (vc-bzr-root default-directory)))
+    (when root
+      (vc-bzr-command "shelve" nil 0 nil "--all" "-m" name)
+      (vc-resynch-buffer root t t))))
+
+(defun vc-bzr-stash-show (name)
+  "Show the contents of stash NAME."
+  (interactive "sStash name: ")
+  (vc-setup-buffer "*vc-bzr-stash*")
+  ;; FIXME: how can you show the contents of a shelf?
+  (vc-bzr-command "shelve" "*vc-bzr-stash*" 'async nil name)
+  (set-buffer "*vc-bzr-stash*")
+  (diff-mode)
+  (setq buffer-read-only t)
+  (pop-to-buffer (current-buffer)))
+
+(defun vc-bzr-stash-list ()
+  (with-temp-buffer
+    (vc-bzr-command "shelve" (current-buffer) 1 nil "--list")
+    (delete
+     ""
+     (split-string
+      (buffer-substring (point-min) (point-max))
+      "\n"))))
+
+(defun vc-bzr-stash-get-at-point (point)
+  (save-excursion
+    (goto-char point)
+    (beginning-of-line)
+    (if (looking-at "^ +\\([0-9]+\\):")
+	(match-string 1)
+      (error "Cannot find stash at point"))))
+
+(defun vc-bzr-stash-delete-at-point ()
+  (interactive)
+  (let ((stash (vc-bzr-stash-get-at-point (point))))
+    (when (y-or-n-p (format "Remove stash %s ?" stash))
+      (vc-bzr-command "unshelve" nil 0 nil "--delete-only" stash)
+      (vc-dir-refresh))))
+
+(defun vc-bzr-stash-show-at-point ()
+  (interactive)
+  (vc-bzr-stash-show (vc-bzr-stash-get-at-point (point))))
+
 
 ;;; Revision completion