[Emacs-diffs] /srv/bzr/emacs/trunk r99645: Add support for shelving snapshots and for showing shelves.

[Dan Nicolaescu]

------------------------------------------------------------
revno: 99645
committer: Dan Nicolaescu <address@hidden>
branch nick: trunk
timestamp: Thu 2010-03-11 17:29:30 -0800
message:
  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.
modified:
  etc/NEWS
  lisp/ChangeLog
  lisp/files.el
  lisp/vc-bzr.el

=== modified file 'etc/NEWS'
--- a/etc/NEWS  2010-03-11 20:42:19 +0000
+++ b/etc/NEWS  2010-03-12 01:29:30 +0000
@@ -36,6 +36,10 @@
 
 * 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.
+
 
 * New Modes and Packages in Emacs 24.1
 

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2010-03-11 06:20:24 +0000
+++ b/lisp/ChangeLog    2010-03-12 01:29:30 +0000
@@ -1,3 +1,12 @@
+2010-03-12  Dan Nicolaescu  <address@hidden>
+
+       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  <address@hidden>
 
        * cus-edit.el (customize-changed-options-previous-release):

=== modified file 'lisp/files.el'
--- a/lisp/files.el     2010-02-28 01:11:15 +0000
+++ b/lisp/files.el     2010-03-12 01:29:30 +0000
@@ -2269,7 +2269,7 @@
      ("\\.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)

=== modified file 'lisp/vc-bzr.el'
--- a/lisp/vc-bzr.el    2010-02-17 21:39:21 +0000
+++ b/lisp/vc-bzr.el    2010-03-12 01:29:30 +0000
@@ -758,9 +758,11 @@
 
     (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 @@
     (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 @@
       (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 @@
   (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 @@
       (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)))