Add support for shelving snapshots and for showing shelves.

* vc-bzr.el (vc-bzr-shelve-show, vc-bzr-shelve-show-at-point)
(vc-bzr-shelve-apply-and-keep-at-point, vc-bzr-shelve-snapshot):
New functions.
(vc-bzr-shelve-map, vc-bzr-shelve-menu-map)
(vc-bzr-extra-menu-map): Map them.

diff --git a/etc/NEWS b/etc/NEWS
index 0dbf15eab054b4ce72cf6783d6b494fb0915c9c7..82c63f4449bb409206503bc26e03fc6d5b48b87f 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -36,6 +36,10 @@ so we will look at it and add it to the manual.
 \f
 * Changes in Specialized Modes and Packages in Emacs 24.1
 
+** VC and related modes
+
+*** vc-dir for Bzr supports viewing shelve contents and shelving snapshots.
+
 \f
 * New Modes and Packages in Emacs 24.1
 

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 88ed61cd1d500ce29a51aae9be429a37bf537e1b..e7f4f17d549e1d67f26f7957427d7bb4cf7571c2 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,12 @@
+2010-03-12  Dan Nicolaescu  <dann@ics.uci.edu>
+
+       Add support for shelving snapshots and for showing shelves.
+       * vc-bzr.el (vc-bzr-shelve-show, vc-bzr-shelve-show-at-point)
+       (vc-bzr-shelve-apply-and-keep-at-point, vc-bzr-shelve-snapshot):
+       New functions.
+       (vc-bzr-shelve-map, vc-bzr-shelve-menu-map)
+       (vc-bzr-extra-menu-map): Map them.
+
 2010-03-11  Glenn Morris  <rgm@gnu.org>
 
        * cus-edit.el (customize-changed-options-previous-release):

diff --git a/lisp/files.el b/lisp/files.el
index f0a8d72d3f0ac92fefc902ad5c2e5b61ee0fe42c..99fa7ddf1b573acd256bde273b083854ebc4bbbb 100644 (file)
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -2269,7 +2269,7 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\)\\'" . archive-mode)
      ("\\.dtd\\'" . sgml-mode)
      ("\\.ds\\(ss\\)?l\\'" . dsssl-mode)
      ("\\.js\\'" . js-mode)            ; javascript-mode would be better
-     ("\\.[ds]?v\\'" . verilog-mode)
+     ("\\.[ds]?vh?\\'" . verilog-mode)
      ;; .emacs or .gnus or .viper following a directory delimiter in
      ;; Unix, MSDOG or VMS syntax.
      ("[]>:/\\]\\..*\\(emacs\\|gnus\\|viper\\)\\'" . emacs-lisp-mode)

diff --git a/lisp/vc-bzr.el b/lisp/vc-bzr.el
index b0dbb8ec1929bd7987e0ec7eb9f5043cec5de1ce..75845f0aa2cb9e9bb715c7def8a38c6366311e62 100644 (file)
--- a/lisp/vc-bzr.el
+++ b/lisp/vc-bzr.el
@@ -758,9 +758,11 @@ stream.  Standard error output is discarded."
 
     (define-key map [down-mouse-3] 'vc-bzr-shelve-menu)
     (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 "=" '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-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
@@ -768,16 +770,22 @@ stream.  Standard error output is discarded."
     (define-key map [de]
       '(menu-item "Delete shelf" vc-bzr-shelve-delete-at-point
                  :help "Delete the current shelf"))
+    (define-key map [ap]
+      '(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"))
+    (define-key map [sh]
+      '(menu-item "Show shelve" vc-bzr-shelve-show-at-point
+                 :help "Show the contents of the current shelve"))
     map))
 
 (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"))
@@ -864,16 +872,16 @@ stream.  Standard error output is discarded."
       (vc-bzr-command "shelve" nil 0 nil "--all" "-m" name)
       (vc-resynch-buffer root t t))))
 
-;; (defun vc-bzr-shelve-show (name)
-;;   "Show the contents of shelve NAME."
-;;   (interactive "sShelve name: ")
-;;   (vc-setup-buffer "*vc-bzr-shelve*")
-;;   ;; FIXME: how can you show the contents of a shelf?
-;;   (vc-bzr-command "shelve" "*vc-bzr-shelve*" 'async nil name)
-;;   (set-buffer "*vc-bzr-shelve*")
-;;   (diff-mode)
-;;   (setq buffer-read-only t)
-;;   (pop-to-buffer (current-buffer)))
+(defun vc-bzr-shelve-show (name)
+  "Show the contents of shelve NAME."
+  (interactive "sShelve name: ")
+  (vc-setup-buffer "*vc-bzr-shelve*")
+  ;; FIXME: how can you show the contents of a shelf?
+  (vc-bzr-command "unshelve" "*vc-bzr-shelve*" 'async nil "--preview" name)
+  (set-buffer "*vc-bzr-shelve*")
+  (diff-mode)
+  (setq buffer-read-only t)
+  (pop-to-buffer (current-buffer)))
 
 (defun vc-bzr-shelve-apply (name)
   "Apply shelve NAME and remove it afterwards."
@@ -881,6 +889,23 @@ stream.  Standard error output is discarded."
   (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")
@@ -905,14 +930,18 @@ stream.  Standard error output is discarded."
       (vc-bzr-command "unshelve" nil 0 nil "--delete-only" shelve)
       (vc-dir-refresh))))
 
-;; (defun vc-bzr-shelve-show-at-point ()
-;;   (interactive)
-;;   (vc-bzr-shelve-show (vc-bzr-shelve-get-at-point (point))))
+(defun vc-bzr-shelve-show-at-point ()
+  (interactive)
+  (vc-bzr-shelve-show (vc-bzr-shelve-get-at-point (point))))
 
 (defun vc-bzr-shelve-apply-at-point ()
   (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)))