# HG changeset patch # User Dan Nicolaescu # Date 1268357370 28800 # Node ID b73242777fb9abdc9632c31da9f0b257170c1f92 # Parent 018bc2f5c9e69b19f7194107f634375cdbfcf348 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 -r 018bc2f5c9e6 -r b73242777fb9 etc/NEWS --- a/etc/NEWS Thu Mar 11 22:42:19 2010 +0200 +++ b/etc/NEWS Thu Mar 11 17:29:30 2010 -0800 @@ -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 diff -r 018bc2f5c9e6 -r b73242777fb9 lisp/ChangeLog --- a/lisp/ChangeLog Thu Mar 11 22:42:19 2010 +0200 +++ b/lisp/ChangeLog Thu Mar 11 17:29:30 2010 -0800 @@ -1,3 +1,12 @@ +2010-03-12 Dan Nicolaescu + + 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 * cus-edit.el (customize-changed-options-previous-release): diff -r 018bc2f5c9e6 -r b73242777fb9 lisp/files.el --- a/lisp/files.el Thu Mar 11 22:42:19 2010 +0200 +++ b/lisp/files.el Thu Mar 11 17:29:30 2010 -0800 @@ -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) diff -r 018bc2f5c9e6 -r b73242777fb9 lisp/vc-bzr.el --- a/lisp/vc-bzr.el Thu Mar 11 22:42:19 2010 +0200 +++ b/lisp/vc-bzr.el Thu Mar 11 17:29:30 2010 -0800 @@ -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)))