From: Dan Nicolaescu Date: Fri, 12 Mar 2010 01:29:30 +0000 (-0800) Subject: Add support for shelving snapshots and for showing shelves. X-Git-Tag: emacs-pretest-24.0.90~104^2~275^2~438^2~759 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=855a22946bfc123649647656af225ec846a92704;p=emacs.git 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 0dbf15eab05..82c63f4449b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -36,6 +36,10 @@ so we will look at it and add it to the manual. * 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 --git a/lisp/ChangeLog b/lisp/ChangeLog index 88ed61cd1d5..e7f4f17d549 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -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 --git a/lisp/files.el b/lisp/files.el index f0a8d72d3f0..99fa7ddf1b5 100644 --- 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 b0dbb8ec192..75845f0aa2c 100644 --- 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)))