procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add support for bzr shelve/unshelve.

Browse source 
* 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.
This commit is contained in:
Dan Nicolaescu 2009-12-03 07:46:13 +00:00
parent 3f6bd7904e
commit 4dfb3b9cd5
3 changed files with 129 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
etc/NEWS
View file

@ -269,6 +269,9 @@ their content displayed.
**** 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.

9
lisp/ChangeLog
View file

@ -1,5 +1,14 @@
2009-12-03 Dan Nicolaescu <dann@ics.uci.edu>
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 <monnier@iro.umontreal.ca>

117
lisp/vc-bzr.el
View file

@ -704,11 +704,49 @@ stream. Standard error output is discarded."
(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 @@ stream. Standard error output is discarded."
(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