Mercurial > emacs
comparison lisp/vc-bzr.el @ 107372:b73242777fb9
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.
| author | Dan Nicolaescu <dann@ics.uci.edu> |
|---|---|
| date | Thu, 11 Mar 2010 17:29:30 -0800 |
| parents | 6e6072f0c0a2 |
| children | 1918e70c8b37 |
comparison
equal
deleted
inserted
replaced
| 107371:018bc2f5c9e6 | 107372:b73242777fb9 |
|---|---|
| 756 ;; Turn off vc-dir marking | 756 ;; Turn off vc-dir marking |
| 757 (define-key map [mouse-2] 'ignore) | 757 (define-key map [mouse-2] 'ignore) |
| 758 | 758 |
| 759 (define-key map [down-mouse-3] 'vc-bzr-shelve-menu) | 759 (define-key map [down-mouse-3] 'vc-bzr-shelve-menu) |
| 760 (define-key map "\C-k" 'vc-bzr-shelve-delete-at-point) | 760 (define-key map "\C-k" 'vc-bzr-shelve-delete-at-point) |
| 761 ;; (define-key map "=" 'vc-bzr-shelve-show-at-point) | 761 (define-key map "=" 'vc-bzr-shelve-show-at-point) |
| 762 ;; (define-key map "\C-m" 'vc-bzr-shelve-show-at-point) | 762 (define-key map "\C-m" 'vc-bzr-shelve-show-at-point) |
| 763 (define-key map "A" 'vc-bzr-shelve-apply-and-keep-at-point) | |
| 763 (define-key map "P" 'vc-bzr-shelve-apply-at-point) | 764 (define-key map "P" 'vc-bzr-shelve-apply-at-point) |
| 765 (define-key map "S" 'vc-bzr-shelve-snapshot) | |
| 764 map)) | 766 map)) |
| 765 | 767 |
| 766 (defvar vc-bzr-shelve-menu-map | 768 (defvar vc-bzr-shelve-menu-map |
| 767 (let ((map (make-sparse-keymap "Bzr Shelve"))) | 769 (let ((map (make-sparse-keymap "Bzr Shelve"))) |
| 768 (define-key map [de] | 770 (define-key map [de] |
| 769 '(menu-item "Delete shelf" vc-bzr-shelve-delete-at-point | 771 '(menu-item "Delete shelf" vc-bzr-shelve-delete-at-point |
| 770 :help "Delete the current shelf")) | 772 :help "Delete the current shelf")) |
| 773 (define-key map [ap] | |
| 774 '(menu-item "Apply and keep shelf" vc-bzr-shelve-apply-and-keep-at-point | |
| 775 :help "Apply the current shelf and keep it")) | |
| 771 (define-key map [po] | 776 (define-key map [po] |
| 772 '(menu-item "Apply and remove shelf (pop)" vc-bzr-shelve-apply-at-point | 777 '(menu-item "Apply and remove shelf (pop)" vc-bzr-shelve-apply-at-point |
| 773 :help "Apply the current shelf and remove it")) | 778 :help "Apply the current shelf and remove it")) |
| 774 ;; (define-key map [sh] | 779 (define-key map [sh] |
| 775 ;; '(menu-item "Show shelve" vc-bzr-shelve-show-at-point | 780 '(menu-item "Show shelve" vc-bzr-shelve-show-at-point |
| 776 ;; :help "Show the contents of the current shelve")) | 781 :help "Show the contents of the current shelve")) |
| 777 map)) | 782 map)) |
| 778 | 783 |
| 779 (defvar vc-bzr-extra-menu-map | 784 (defvar vc-bzr-extra-menu-map |
| 780 (let ((map (make-sparse-keymap))) | 785 (let ((map (make-sparse-keymap))) |
| 786 (define-key map [bzr-sn] | |
| 787 '(menu-item "Shelve a snapshot" vc-bzr-shelve-snapshot | |
| 788 :help "Shelve the current state of the tree and keep the current state")) | |
| 781 (define-key map [bzr-sh] | 789 (define-key map [bzr-sh] |
| 782 '(menu-item "Shelve..." vc-bzr-shelve | 790 '(menu-item "Shelve..." vc-bzr-shelve |
| 783 :help "Shelve changes")) | 791 :help "Shelve changes")) |
| 784 map)) | 792 map)) |
| 785 | 793 |
| 862 (let ((root (vc-bzr-root default-directory))) | 870 (let ((root (vc-bzr-root default-directory))) |
| 863 (when root | 871 (when root |
| 864 (vc-bzr-command "shelve" nil 0 nil "--all" "-m" name) | 872 (vc-bzr-command "shelve" nil 0 nil "--all" "-m" name) |
| 865 (vc-resynch-buffer root t t)))) | 873 (vc-resynch-buffer root t t)))) |
| 866 | 874 |
| 867 ;; (defun vc-bzr-shelve-show (name) | 875 (defun vc-bzr-shelve-show (name) |
| 868 ;; "Show the contents of shelve NAME." | 876 "Show the contents of shelve NAME." |
| 869 ;; (interactive "sShelve name: ") | 877 (interactive "sShelve name: ") |
| 870 ;; (vc-setup-buffer "*vc-bzr-shelve*") | 878 (vc-setup-buffer "*vc-bzr-shelve*") |
| 871 ;; ;; FIXME: how can you show the contents of a shelf? | 879 ;; FIXME: how can you show the contents of a shelf? |
| 872 ;; (vc-bzr-command "shelve" "*vc-bzr-shelve*" 'async nil name) | 880 (vc-bzr-command "unshelve" "*vc-bzr-shelve*" 'async nil "--preview" name) |
| 873 ;; (set-buffer "*vc-bzr-shelve*") | 881 (set-buffer "*vc-bzr-shelve*") |
| 874 ;; (diff-mode) | 882 (diff-mode) |
| 875 ;; (setq buffer-read-only t) | 883 (setq buffer-read-only t) |
| 876 ;; (pop-to-buffer (current-buffer))) | 884 (pop-to-buffer (current-buffer))) |
| 877 | 885 |
| 878 (defun vc-bzr-shelve-apply (name) | 886 (defun vc-bzr-shelve-apply (name) |
| 879 "Apply shelve NAME and remove it afterwards." | 887 "Apply shelve NAME and remove it afterwards." |
| 880 (interactive "sApply (and remove) shelf: ") | 888 (interactive "sApply (and remove) shelf: ") |
| 881 (vc-bzr-command "unshelve" "*vc-bzr-shelve*" 0 nil "--apply" name) | 889 (vc-bzr-command "unshelve" "*vc-bzr-shelve*" 0 nil "--apply" name) |
| 890 (vc-resynch-buffer (vc-bzr-root default-directory) t t)) | |
| 891 | |
| 892 (defun vc-bzr-shelve-apply-and-keep (name) | |
| 893 "Apply shelve NAME and keep it afterwards." | |
| 894 (interactive "sApply (and keep) shelf: ") | |
| 895 (vc-bzr-command "unshelve" "*vc-bzr-shelve*" 0 nil "--apply" "--keep" name) | |
| 896 (vc-resynch-buffer (vc-bzr-root default-directory) t t)) | |
| 897 | |
| 898 (defun vc-bzr-shelve-snapshot () | |
| 899 "Create a stash with the current tree state." | |
| 900 (interactive) | |
| 901 (vc-bzr-command "shelve" nil 0 nil "--all" "-m" | |
| 902 (let ((ct (current-time))) | |
| 903 (concat | |
| 904 (format-time-string "Snapshot on %Y-%m-%d" ct) | |
| 905 (format-time-string " at %H:%M" ct)))) | |
| 906 (vc-bzr-command "unshelve" "*vc-bzr-shelve*" 0 nil "--apply" "--keep") | |
| 882 (vc-resynch-buffer (vc-bzr-root default-directory) t t)) | 907 (vc-resynch-buffer (vc-bzr-root default-directory) t t)) |
| 883 | 908 |
| 884 (defun vc-bzr-shelve-list () | 909 (defun vc-bzr-shelve-list () |
| 885 (with-temp-buffer | 910 (with-temp-buffer |
| 886 (vc-bzr-command "shelve" (current-buffer) 1 nil "--list" "-q") | 911 (vc-bzr-command "shelve" (current-buffer) 1 nil "--list" "-q") |
| 903 (let ((shelve (vc-bzr-shelve-get-at-point (point)))) | 928 (let ((shelve (vc-bzr-shelve-get-at-point (point)))) |
| 904 (when (y-or-n-p (format "Remove shelf %s ?" shelve)) | 929 (when (y-or-n-p (format "Remove shelf %s ?" shelve)) |
| 905 (vc-bzr-command "unshelve" nil 0 nil "--delete-only" shelve) | 930 (vc-bzr-command "unshelve" nil 0 nil "--delete-only" shelve) |
| 906 (vc-dir-refresh)))) | 931 (vc-dir-refresh)))) |
| 907 | 932 |
| 908 ;; (defun vc-bzr-shelve-show-at-point () | 933 (defun vc-bzr-shelve-show-at-point () |
| 909 ;; (interactive) | 934 (interactive) |
| 910 ;; (vc-bzr-shelve-show (vc-bzr-shelve-get-at-point (point)))) | 935 (vc-bzr-shelve-show (vc-bzr-shelve-get-at-point (point)))) |
| 911 | 936 |
| 912 (defun vc-bzr-shelve-apply-at-point () | 937 (defun vc-bzr-shelve-apply-at-point () |
| 913 (interactive) | 938 (interactive) |
| 914 (vc-bzr-shelve-apply (vc-bzr-shelve-get-at-point (point)))) | 939 (vc-bzr-shelve-apply (vc-bzr-shelve-get-at-point (point)))) |
| 940 | |
| 941 (defun vc-bzr-shelve-apply-and-keep-at-point () | |
| 942 (interactive) | |
| 943 (vc-bzr-shelve-apply-and-keep (vc-bzr-shelve-get-at-point (point)))) | |
| 915 | 944 |
| 916 (defun vc-bzr-shelve-menu (e) | 945 (defun vc-bzr-shelve-menu (e) |
| 917 (interactive "e") | 946 (interactive "e") |
| 918 (vc-dir-at-event e (popup-menu vc-bzr-shelve-menu-map e))) | 947 (vc-dir-at-event e (popup-menu vc-bzr-shelve-menu-map e))) |
| 919 | 948 |