bug#5290: vc-bzr: improve support for shelves

[Dan Nicolaescu]

The latest bzr has support for "unshelve --keep" (implemented as a
result of a discussion on emacs-devel).
That makes the shelves much more usable.

The patch below add support for that option, and for creating snapshots
of the tree as a shelf.

Given that it's not a bug fix this would need a maintainer approval to
get in 23.2 at this point...

Index: vc-bzr.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/vc-bzr.el,v
retrieving revision 1.94
diff -u -3 -p -u -p -r1.94 vc-bzr.el
--- vc-bzr.el   9 Dec 2009 06:04:12 -0000       1.94
+++ vc-bzr.el   2 Jan 2010 03:58:42 -0000
@@ -722,7 +733,9 @@ stream.  Standard error output is discar
     (define-key map "\C-k" 'vc-bzr-shelve-delete-at-point)
     ;; (define-key map "=" 'vc-bzr-shelve-show-at-point)
     ;; (define-key map "\C-m" 'vc-bzr-shelve-show-at-point)
-    (define-key map "A" 'vc-bzr-shelve-apply-at-point)
+    (define-key map "A" 'vc-bzr-shelve-apply-and-keep-at-point)
+    (define-key map "P" 'vc-bzr-shelve-apply-at-point)
+    (define-key map "S" 'vc-bzr-shelve-snapshot)
     map))
 
 (defvar vc-bzr-shelve-menu-map
@@ -731,8 +744,11 @@ stream.  Standard error output is discar
       '(menu-item "Delete shelf" vc-bzr-shelve-delete-at-point
                  :help "Delete the current shelf"))
     (define-key map [ap]
-      '(menu-item "Apply shelf" vc-bzr-shelve-apply-at-point
-                 :help "Apply the current shelf"))
+      '(menu-item "Apply and keep shelf" vc-bzr-shelve-apply-and-keep-at-point
+                 :help "Apply the current shelf and keep it"))
+    (define-key map [po]
+      '(menu-item "Apply and remove shelf (pop)" vc-bzr-shelve-apply-at-point
+                 :help "Apply the current shelf and remove it"))
     ;; (define-key map [sh]
     ;;   '(menu-item "Show shelve" vc-bzr-shelve-show-at-point
     ;;                   :help "Show the contents of the current shelve"))
@@ -740,6 +756,9 @@ stream.  Standard error output is discar
 
 (defvar vc-bzr-extra-menu-map
   (let ((map (make-sparse-keymap)))
+    (define-key map [bzr-sn]
+      '(menu-item "Shelve a snapshot" vc-bzr-shelve-snapshot
+                 :help "Shelve the current state of the tree and keep the 
current state"))
     (define-key map [bzr-sh]
       '(menu-item "Shelve..." vc-bzr-shelve
                  :help "Shelve changes"))
@@ -790,7 +809,7 @@ stream.  Standard error output is discar
             (propertize x
                         'face 'font-lock-variable-name-face
                         'mouse-face 'highlight
-                        'help-echo "mouse-3: Show shelve menu\nA: Apply 
shelf\nC-k: Delete shelf"
+                        'help-echo "mouse-3: Show shelve menu\nA: Apply and 
keep shelf\nP: Apply and remove shelf\nS: Snapshot to a shelf\nC-k: Delete 
shelf"
                         'keymap vc-bzr-shelve-map))
           shelve "\n"))
        (concat
@@ -820,11 +839,28 @@ stream.  Standard error output is discar
 ;;   (pop-to-buffer (current-buffer)))
 
 (defun vc-bzr-shelve-apply (name)
-  "Apply shelve NAME."
-  (interactive "sApply shelf: ")
+  "Apply shelve NAME and remove it afterwards."
+  (interactive "sApply (and remove) shelf: ")
   (vc-bzr-command "unshelve" "*vc-bzr-shelve*" 0 nil "--apply" name)
   (vc-resynch-buffer (vc-bzr-root default-directory) t t))
 
+(defun vc-bzr-shelve-apply-and-keep (name)
+  "Apply shelve NAME and keep it afterwards."
+  (interactive "sApply (and keep) shelf: ")
+  (vc-bzr-command "unshelve" "*vc-bzr-shelve*" 0 nil "--apply" "--keep" name)
+  (vc-resynch-buffer (vc-bzr-root default-directory) t t))
+
+(defun vc-bzr-shelve-snapshot ()
+  "Create a stash with the current tree state."
+  (interactive)
+  (vc-bzr-command "shelve" nil 0 nil "--all" "-m"
+                 (let ((ct (current-time)))
+                   (concat
+                    (format-time-string "Snapshot on %Y-%m-%d" ct)
+                    (format-time-string " at %H:%M" ct))))
+  (vc-bzr-command "unshelve" "*vc-bzr-shelve*" 0 nil "--apply" "--keep")
+  (vc-resynch-buffer (vc-bzr-root default-directory) t t))
+
 (defun vc-bzr-shelve-list ()
   (with-temp-buffer
     (vc-bzr-command "shelve" (current-buffer) 1 nil "--list" "-q")
@@ -857,6 +893,10 @@ stream.  Standard error output is discar
   (interactive)
   (vc-bzr-shelve-apply (vc-bzr-shelve-get-at-point (point))))
 
+(defun vc-bzr-shelve-apply-and-keep-at-point ()
+  (interactive)
+  (vc-bzr-shelve-apply-and-keep (vc-bzr-shelve-get-at-point (point))))
+
 (defun vc-bzr-shelve-menu (e)
   (interactive "e")
   (vc-dir-at-event e (popup-menu vc-bzr-shelve-menu-map e)))