[Emacs-diffs] emacs etc/NEWS lisp/ChangeLog lisp/vc-bzr.el

[Dan Nicolaescu]

CVSROOT:        /cvsroot/emacs
Module name:    emacs
Changes by:     Dan Nicolaescu <dann>   09/12/03 07:46:17

Modified files:
        etc            : NEWS 
        lisp           : ChangeLog vc-bzr.el 

Log message:
        Add support for bzr shelve/unshelve.
        * vc-bzr.el (vc-bzr-shelve-map, vc-bzr-shelve-menu-map)
        (vc-bzr-extra-menu-map): New variables.
        (vc-bzr-extra-menu, vc-bzr-extra-status-menu, vc-bzr-shelve)
        (vc-bzr-shelve-apply, vc-bzr-shelve-list)
        (vc-bzr-shelve-get-at-point, vc-bzr-shelve-delete-at-point)
        (vc-bzr-shelve-apply-at-point, vc-bzr-shelve-menu): New functions.
        (vc-bzr-dir-extra-headers): Display shelves.

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/emacs/etc/NEWS?cvsroot=emacs&r1=1.2133&r2=1.2134
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/ChangeLog?cvsroot=emacs&r1=1.16809&r2=1.16810
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/vc-bzr.el?cvsroot=emacs&r1=1.87&r2=1.88

Patches:
Index: etc/NEWS
===================================================================
RCS file: /cvsroot/emacs/emacs/etc/NEWS,v
retrieving revision 1.2133
retrieving revision 1.2134
diff -u -b -r1.2133 -r1.2134
--- etc/NEWS    3 Dec 2009 04:08:08 -0000       1.2133
+++ etc/NEWS    3 Dec 2009 07:46:13 -0000       1.2134
@@ -269,6 +269,9 @@
 
 **** vc-dir displays the stash status
 
+*** vc-bzr supports operating with shelves: the shelve list is
+displayed in the *vc-dir* header, shelves can be created, removed and applied.
+
 *** log-edit-strip-single-file-name controls whether or not single filenames
 are stripped when copying text from the ChangeLog to the *VC-Log* buffer.
 

Index: lisp/ChangeLog
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/ChangeLog,v
retrieving revision 1.16809
retrieving revision 1.16810
diff -u -b -r1.16809 -r1.16810
--- lisp/ChangeLog      3 Dec 2009 07:31:15 -0000       1.16809
+++ lisp/ChangeLog      3 Dec 2009 07:46:14 -0000       1.16810
@@ -1,5 +1,14 @@
 2009-12-03  Dan Nicolaescu  <address@hidden>
 
+       Add support for bzr shelve/unshelve.
+       * vc-bzr.el (vc-bzr-shelve-map, vc-bzr-shelve-menu-map)
+       (vc-bzr-extra-menu-map): New variables.
+       (vc-bzr-extra-menu, vc-bzr-extra-status-menu, vc-bzr-shelve)
+       (vc-bzr-shelve-apply, vc-bzr-shelve-list)
+       (vc-bzr-shelve-get-at-point, vc-bzr-shelve-delete-at-point)
+       (vc-bzr-shelve-apply-at-point, vc-bzr-shelve-menu): New functions.
+       (vc-bzr-dir-extra-headers): Display shelves.
+
        * vc-bzr.el (vc-bzr-print-log): Deal with nil arguments better.
 
 2009-12-03  Stefan Monnier  <address@hidden>

Index: lisp/vc-bzr.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/vc-bzr.el,v
retrieving revision 1.87
retrieving revision 1.88
diff -u -b -r1.87 -r1.88
--- lisp/vc-bzr.el      3 Dec 2009 07:31:18 -0000       1.87
+++ lisp/vc-bzr.el      3 Dec 2009 07:46:17 -0000       1.88
@@ -704,11 +704,49 @@
   (vc-exec-after
    `(vc-bzr-after-dir-status (quote ,update-function))))
 
+(defvar vc-bzr-shelve-map
+  (let ((map (make-sparse-keymap)))
+    ;; Turn off vc-dir marking
+    (define-key map [mouse-2] 'ignore)
+
+    (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 "A" 'vc-bzr-shelve-apply-at-point)
+    map))
+
+(defvar vc-bzr-shelve-menu-map
+  (let ((map (make-sparse-keymap "Bzr Shelve")))
+    (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 shelf" vc-bzr-shelve-apply-at-point
+                 :help "Apply the current shelf"))
+    ;; (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-sh]
+      '(menu-item "Shelve..." vc-bzr-shelve
+                 :help "Shelve changes"))
+    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)))
+       (shelve (vc-bzr-shelve-list))
+       (shelve-help-echo "Use M-x vc-bzr-shelve to create shelves")
        (light-checkout
        (when (string-match ".+light checkout root: \\(.+\\)$" str)
          (match-string 1 str)))
@@ -734,6 +772,85 @@
         (propertize "Checkout of branch : " 'face 'font-lock-type-face)
         (propertize light-checkout-branch 'face 'font-lock-variable-name-face)
         "\n")))))
+     (if shelve
+        (concat
+         (propertize "Shelves            :\n" 'face 'font-lock-type-face
+                     'help-echo shelve-help-echo)
+         (mapconcat
+          (lambda (x)
+            (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"
+                        'keymap vc-bzr-shelve-map))
+          shelve "\n"))
+       (concat
+       (propertize "Shelves            : " 'face 'font-lock-type-face
+                   'help-echo shelve-help-echo)
+       (propertize "No shelved changes"
+                   'help-echo shelve-help-echo
+                   'face 'font-lock-variable-name-face))))))
+
+(defun vc-bzr-shelve (name)
+  "Create a shelve."
+  (interactive "sShelf 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-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-apply (name)
+  "Apply shelve NAME."
+  (interactive "sApply 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-list ()
+  (with-temp-buffer
+    (vc-bzr-command "shelve" (current-buffer) 1 nil "--list" "-q")
+    (delete
+     ""
+     (split-string
+      (buffer-substring (point-min) (point-max))
+      "\n"))))
+
+(defun vc-bzr-shelve-get-at-point (point)
+  (save-excursion
+    (goto-char point)
+    (beginning-of-line)
+    (if (looking-at "^ +\\([0-9]+\\):")
+       (match-string 1)
+      (error "Cannot find shelf at point"))))
+
+(defun vc-bzr-shelve-delete-at-point ()
+  (interactive)
+  (let ((shelve (vc-bzr-shelve-get-at-point (point))))
+    (when (y-or-n-p (format "Remove shelf %s ?" shelve))
+      (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-apply-at-point ()
+  (interactive)
+  (vc-bzr-shelve-apply (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)))
 
 ;;; Revision completion