diff options
| author | Eric S. Raymond | 2008-05-03 11:46:05 +0000 |
|---|---|---|
| committer | Eric S. Raymond | 2008-05-03 11:46:05 +0000 |
| commit | 783b505b7bd8f28bdf73e8c34ae22e809cfe64db (patch) | |
| tree | b1c3c6968987362fb34dcb2ee44eb93115b7cd8b | |
| parent | dab955e836add3ce0ef2e974a28d9e554de23c4a (diff) | |
| download | emacs-783b505b7bd8f28bdf73e8c34ae22e809cfe64db.tar.gz emacs-783b505b7bd8f28bdf73e8c34ae22e809cfe64db.zip | |
Moved most of vc-dir from vc.el to vc-dispatcher.el.
| -rw-r--r-- | lisp/vc-dispatcher.el | 675 | ||||
| -rw-r--r-- | lisp/vc.el | 721 |
2 files changed, 697 insertions, 699 deletions
diff --git a/lisp/vc-dispatcher.el b/lisp/vc-dispatcher.el index ef4cffd2f8d..669731d5c7b 100644 --- a/lisp/vc-dispatcher.el +++ b/lisp/vc-dispatcher.el | |||
| @@ -601,7 +601,8 @@ the buffer contents as a comment." | |||
| 601 | (vc-dir-move-to-goal-column)) | 601 | (vc-dir-move-to-goal-column)) |
| 602 | (run-hooks after-hook 'vc-finish-logentry-hook))) | 602 | (run-hooks after-hook 'vc-finish-logentry-hook))) |
| 603 | 603 | ||
| 604 | ;; VC-Dired mode (to be removed when vc-dir support is finished) | 604 | ;; VC-Dired mode |
| 605 | ;; FIXME: to be removed when vc-dir support is finished | ||
| 605 | 606 | ||
| 606 | (defcustom vc-dired-listing-switches "-al" | 607 | (defcustom vc-dired-listing-switches "-al" |
| 607 | "Switches passed to `ls' for vc-dired. MUST contain the `l' option." | 608 | "Switches passed to `ls' for vc-dired. MUST contain the `l' option." |
| @@ -623,15 +624,11 @@ the buffer contents as a comment." | |||
| 623 | 624 | ||
| 624 | (defvar vc-dired-mode nil) | 625 | (defvar vc-dired-mode nil) |
| 625 | (defvar vc-dired-window-configuration) | 626 | (defvar vc-dired-window-configuration) |
| 626 | |||
| 627 | (make-variable-buffer-local 'vc-dired-mode) | ||
| 628 | |||
| 629 | ;; The VC directory major mode. Coopt Dired for this. | ||
| 630 | ;; All VC commands get mapped into logical equivalents. | ||
| 631 | |||
| 632 | (defvar vc-dired-switches) | 627 | (defvar vc-dired-switches) |
| 633 | (defvar vc-dired-terse-mode) | 628 | (defvar vc-dired-terse-mode) |
| 634 | 629 | ||
| 630 | (make-variable-buffer-local 'vc-dired-mode) | ||
| 631 | |||
| 635 | (defvar vc-dired-mode-map | 632 | (defvar vc-dired-mode-map |
| 636 | (let ((map (make-sparse-keymap)) | 633 | (let ((map (make-sparse-keymap)) |
| 637 | (vmap (make-sparse-keymap))) | 634 | (vmap (make-sparse-keymap))) |
| @@ -827,4 +824,668 @@ With prefix arg READ-SWITCHES, specify a value to override | |||
| 827 | vc-dired-switches | 824 | vc-dired-switches |
| 828 | 'vc-dired-mode)))) | 825 | 'vc-dired-mode)))) |
| 829 | 826 | ||
| 827 | ;; The ewoc-based vc-directory implementation | ||
| 828 | |||
| 829 | (defcustom vc-dir-mode-hook nil | ||
| 830 | "Normal hook run by `vc-dir-mode'. | ||
| 831 | See `run-hooks'." | ||
| 832 | :type 'hook | ||
| 833 | :group 'vc) | ||
| 834 | |||
| 835 | ;; Used to store information for the files displayed in the *VC status* buffer. | ||
| 836 | ;; Each item displayed corresponds to one of these defstructs. | ||
| 837 | (defstruct (vc-dir-fileinfo | ||
| 838 | (:copier nil) | ||
| 839 | (:type list) ;So we can use `member' on lists of FIs. | ||
| 840 | (:constructor | ||
| 841 | ;; We could define it as an alias for `list'. | ||
| 842 | vc-dir-create-fileinfo (name state &optional extra marked directory)) | ||
| 843 | (:conc-name vc-dir-fileinfo->)) | ||
| 844 | name ;Keep it as first, for `member'. | ||
| 845 | state | ||
| 846 | ;; For storing client-mode specific information. | ||
| 847 | extra | ||
| 848 | marked | ||
| 849 | ;; To keep track of not updated files during a global refresh | ||
| 850 | needs-update | ||
| 851 | ;; To distinguish files and directories. | ||
| 852 | directory) | ||
| 853 | |||
| 854 | (defvar vc-ewoc nil) | ||
| 855 | (defvar vc-dir-process-buffer nil | ||
| 856 | "The buffer used for the asynchronous call that computes the VC status.") | ||
| 857 | |||
| 858 | (defun vc-dir-move-to-goal-column () | ||
| 859 | ;; Used to keep the cursor on the file name column. | ||
| 860 | (beginning-of-line) | ||
| 861 | ;; Must be in sync with vc-default-status-printer. | ||
| 862 | (forward-char 25)) | ||
| 863 | |||
| 864 | (defun vc-dir-prepare-status-buffer (dir &optional create-new) | ||
| 865 | "Find a *vc-dir* buffer showing DIR, or create a new one." | ||
| 866 | (setq dir (expand-file-name dir)) | ||
| 867 | (let* ((bname "*vc-dir*") | ||
| 868 | ;; Look for another *vc-dir* buffer visiting the same directory. | ||
| 869 | (buf (save-excursion | ||
| 870 | (unless create-new | ||
| 871 | (dolist (buffer (buffer-list)) | ||
| 872 | (set-buffer buffer) | ||
| 873 | (when (and (eq major-mode 'vc-dir-mode) | ||
| 874 | (string= (expand-file-name default-directory) dir)) | ||
| 875 | (return buffer))))))) | ||
| 876 | (or buf | ||
| 877 | ;; Create a new *vc-dir* buffer. | ||
| 878 | (with-current-buffer (create-file-buffer bname) | ||
| 879 | (cd dir) | ||
| 880 | (vc-setup-buffer (current-buffer)) | ||
| 881 | ;; Reset the vc-parent-buffer-name so that it does not appear | ||
| 882 | ;; in the mode-line. | ||
| 883 | (setq vc-parent-buffer-name nil) | ||
| 884 | (current-buffer))))) | ||
| 885 | |||
| 886 | (defvar vc-dir-menu-map | ||
| 887 | (let ((map (make-sparse-keymap "VC-dir"))) | ||
| 888 | (define-key map [quit] | ||
| 889 | '(menu-item "Quit" quit-window | ||
| 890 | :help "Quit")) | ||
| 891 | (define-key map [kill] | ||
| 892 | '(menu-item "Kill Update Command" vc-dir-kill-dir-status-process | ||
| 893 | :enable (vc-dir-busy) | ||
| 894 | :help "Kill the command that updates VC status buffer")) | ||
| 895 | (define-key map [refresh] | ||
| 896 | '(menu-item "Refresh" vc-dir-refresh | ||
| 897 | :enable (not (vc-dir-busy)) | ||
| 898 | :help "Refresh the contents of the VC status buffer")) | ||
| 899 | ;; Movement. | ||
| 900 | (define-key map [sepmv] '("--")) | ||
| 901 | (define-key map [next-line] | ||
| 902 | '(menu-item "Next line" vc-dir-next-line | ||
| 903 | :help "Go to the next line" :keys "n")) | ||
| 904 | (define-key map [previous-line] | ||
| 905 | '(menu-item "Previous line" vc-dir-previous-line | ||
| 906 | :help "Go to the previous line")) | ||
| 907 | ;; Marking. | ||
| 908 | (define-key map [sepmrk] '("--")) | ||
| 909 | (define-key map [unmark-all] | ||
| 910 | '(menu-item "Unmark All" vc-dir-unmark-all-files | ||
| 911 | :help "Unmark all files that are in the same state as the current file\ | ||
| 912 | \nWith prefix argument unmark all files")) | ||
| 913 | (define-key map [unmark-previous] | ||
| 914 | '(menu-item "Unmark previous " vc-dir-unmark-file-up | ||
| 915 | :help "Move to the previous line and unmark the file")) | ||
| 916 | |||
| 917 | (define-key map [mark-all] | ||
| 918 | '(menu-item "Mark All" vc-dir-mark-all-files | ||
| 919 | :help "Mark all files that are in the same state as the current file\ | ||
| 920 | \nWith prefix argument mark all files")) | ||
| 921 | (define-key map [unmark] | ||
| 922 | '(menu-item "Unmark" vc-dir-unmark | ||
| 923 | :help "Unmark the current file or all files in the region")) | ||
| 924 | |||
| 925 | (define-key map [mark] | ||
| 926 | '(menu-item "Mark" vc-dir-mark | ||
| 927 | :help "Mark the current file or all files in the region")) | ||
| 928 | |||
| 929 | (define-key map [sepopn] '("--")) | ||
| 930 | (define-key map [open-other] | ||
| 931 | '(menu-item "Open in other window" vc-dir-find-file-other-window | ||
| 932 | :help "Find the file on the current line, in another window")) | ||
| 933 | (define-key map [open] | ||
| 934 | '(menu-item "Open file" vc-dir-find-file | ||
| 935 | :help "Find the file on the current line")) | ||
| 936 | ;; FIXME: Stuff starting here should be appended by vc | ||
| 937 | ;; VC info details | ||
| 938 | (define-key map [sepvcdet] '("--")) | ||
| 939 | (define-key map [remup] | ||
| 940 | '(menu-item "Hide up-to-date" vc-dir-hide-up-to-date | ||
| 941 | :help "Hide up-to-date items from display")) | ||
| 942 | ;; FIXME: This needs a key binding. And maybe a better name | ||
| 943 | ;; ("Insert" like PCL-CVS uses does not sound that great either)... | ||
| 944 | (define-key map [ins] | ||
| 945 | '(menu-item "Show File" vc-dir-show-fileentry | ||
| 946 | :help "Show a file in the VC status listing even though it might be up to date")) | ||
| 947 | (define-key map [annotate] | ||
| 948 | '(menu-item "Annotate" vc-annotate | ||
| 949 | :help "Display the edit history of the current file using colors")) | ||
| 950 | (define-key map [diff] | ||
| 951 | '(menu-item "Compare with Base Version" vc-diff | ||
| 952 | :help "Compare file set with the base version")) | ||
| 953 | (define-key map [log] | ||
| 954 | '(menu-item "Show history" vc-print-log | ||
| 955 | :help "List the change log of the current file set in a window")) | ||
| 956 | ;; VC commands. | ||
| 957 | (define-key map [sepvccmd] '("--")) | ||
| 958 | (define-key map [update] | ||
| 959 | '(menu-item "Update to latest version" vc-update | ||
| 960 | :help "Update the current fileset's files to their tip revisions")) | ||
| 961 | (define-key map [revert] | ||
| 962 | '(menu-item "Revert to base version" vc-revert | ||
| 963 | :help "Revert working copies of the selected fileset to their repository contents.")) | ||
| 964 | (define-key map [next-action] | ||
| 965 | ;; FIXME: This really really really needs a better name! | ||
| 966 | ;; And a key binding too. | ||
| 967 | '(menu-item "Check In/Out" vc-next-action | ||
| 968 | :help "Do the next logical version control operation on the current fileset")) | ||
| 969 | (define-key map [register] | ||
| 970 | '(menu-item "Register" vc-dir-register | ||
| 971 | :help "Register file set into the version control system")) | ||
| 972 | map) | ||
| 973 | "Menu for VC status") | ||
| 974 | |||
| 975 | (defalias 'vc-dir-menu-map vc-dir-menu-map) | ||
| 976 | |||
| 977 | (defvar vc-dir-mode-map | ||
| 978 | (let ((map (make-keymap))) | ||
| 979 | (suppress-keymap map) | ||
| 980 | ;; Marking. | ||
| 981 | (define-key map "m" 'vc-dir-mark) | ||
| 982 | (define-key map "M" 'vc-dir-mark-all-files) | ||
| 983 | (define-key map "u" 'vc-dir-unmark) | ||
| 984 | (define-key map "U" 'vc-dir-unmark-all-files) | ||
| 985 | (define-key map "\C-?" 'vc-dir-unmark-file-up) | ||
| 986 | (define-key map "\M-\C-?" 'vc-dir-unmark-all-files) | ||
| 987 | ;; Movement. | ||
| 988 | (define-key map "n" 'vc-dir-next-line) | ||
| 989 | (define-key map " " 'vc-dir-next-line) | ||
| 990 | (define-key map "\t" 'vc-dir-next-line) | ||
| 991 | (define-key map "p" 'vc-dir-previous-line) | ||
| 992 | (define-key map [backtab] 'vc-dir-previous-line) | ||
| 993 | ;; VC commands. | ||
| 994 | ;; FIXME: These need to be in a client-local keymap | ||
| 995 | (define-key map "=" 'vc-diff) ;; C-x v = | ||
| 996 | (define-key map "a" 'vc-dir-register) | ||
| 997 | (define-key map "+" 'vc-update) ;; C-x v + | ||
| 998 | (define-key map "R" 'vc-revert) ;; u is taken by unmark. | ||
| 999 | (define-key map "A" 'vc-annotate);; Can't be "g" (as in vc map) | ||
| 1000 | (define-key map "l" 'vc-print-log) ;; C-x v l | ||
| 1001 | ;; The remainder. | ||
| 1002 | (define-key map "f" 'vc-dir-find-file) | ||
| 1003 | (define-key map "\C-m" 'vc-dir-find-file) | ||
| 1004 | (define-key map "o" 'vc-dir-find-file-other-window) | ||
| 1005 | (define-key map "x" 'vc-dir-hide-up-to-date) | ||
| 1006 | (define-key map "q" 'quit-window) | ||
| 1007 | (define-key map "g" 'vc-dir-refresh) | ||
| 1008 | (define-key map "\C-c\C-c" 'vc-dir-kill-dir-status-process) | ||
| 1009 | (define-key map [(down-mouse-3)] 'vc-dir-menu) | ||
| 1010 | (define-key map [(mouse-2)] 'vc-dir-toggle-mark) | ||
| 1011 | |||
| 1012 | ;; Hook up the menu. | ||
| 1013 | (define-key map [menu-bar vc-dir-mode] | ||
| 1014 | '(menu-item | ||
| 1015 | ;; This is used so that client modes can add mode-specific | ||
| 1016 | ;; menu items to vc-dir-menu-map. | ||
| 1017 | "VC Status" vc-dir-menu-map :filter vc-dir-menu-map-filter)) | ||
| 1018 | map) | ||
| 1019 | "Keymap for VC status") | ||
| 1020 | |||
| 1021 | (defmacro vc-at-event (event &rest body) | ||
| 1022 | "Evaluate `body' wich point located at event-start of `event'. | ||
| 1023 | If `body' uses `event', it should be a variable, | ||
| 1024 | otherwise it will be evaluated twice." | ||
| 1025 | (let ((posn (gensym "vc-at-event-posn"))) | ||
| 1026 | `(let ((,posn (event-start ,event))) | ||
| 1027 | (save-excursion | ||
| 1028 | (set-buffer (window-buffer (posn-window ,posn))) | ||
| 1029 | (goto-char (posn-point ,posn)) | ||
| 1030 | ,@body)))) | ||
| 1031 | |||
| 1032 | (defun vc-dir-menu (e) | ||
| 1033 | "Popup the VC status menu." | ||
| 1034 | (interactive "e") | ||
| 1035 | (vc-at-event e (popup-menu vc-dir-menu-map e))) | ||
| 1036 | |||
| 1037 | (defvar vc-dir-tool-bar-map | ||
| 1038 | (let ((map (make-sparse-keymap))) | ||
| 1039 | (tool-bar-local-item-from-menu 'vc-dir-find-file "open" | ||
| 1040 | map vc-dir-mode-map) | ||
| 1041 | (tool-bar-local-item "bookmark_add" | ||
| 1042 | 'vc-dir-toggle-mark 'vc-dir-toggle-mark map | ||
| 1043 | :help "Toggle mark on current item") | ||
| 1044 | (tool-bar-local-item-from-menu 'vc-dir-previous-line "left-arrow" | ||
| 1045 | map vc-dir-mode-map | ||
| 1046 | :rtl "right-arrow") | ||
| 1047 | (tool-bar-local-item-from-menu 'vc-dir-next-line "right-arrow" | ||
| 1048 | map vc-dir-mode-map | ||
| 1049 | :rtl "left-arrow") | ||
| 1050 | (tool-bar-local-item-from-menu 'vc-print-log "info" | ||
| 1051 | map vc-dir-mode-map) | ||
| 1052 | (tool-bar-local-item-from-menu 'vc-dir-refresh "refresh" | ||
| 1053 | map vc-dir-mode-map) | ||
| 1054 | (tool-bar-local-item-from-menu 'nonincremental-search-forward | ||
| 1055 | "search" map) | ||
| 1056 | (tool-bar-local-item-from-menu 'vc-dir-kill-dir-status-process "cancel" | ||
| 1057 | map vc-dir-mode-map) | ||
| 1058 | (tool-bar-local-item-from-menu 'quit-window "exit" | ||
| 1059 | map vc-dir-mode-map) | ||
| 1060 | map)) | ||
| 1061 | |||
| 1062 | ;; t if directories should be shown in vc-dir. | ||
| 1063 | ;; WORK IN PROGRESS! DO NOT SET this! ONLY set it if you want to help | ||
| 1064 | ;; write code for this feature. This variable will likely disappear | ||
| 1065 | ;; when the work is done. | ||
| 1066 | (defvar vc-dir-insert-directories nil) | ||
| 1067 | |||
| 1068 | (defun vc-dir-update (entries buffer &optional noinsert) | ||
| 1069 | "Update BUFFER's ewoc from the list of ENTRIES. | ||
| 1070 | If NOINSERT, ignore elements on ENTRIES which are not in the ewoc." | ||
| 1071 | ;; Add ENTRIES to the vc-dir buffer BUFFER. | ||
| 1072 | (with-current-buffer buffer | ||
| 1073 | ;; Insert the entries sorted by name into the ewoc. | ||
| 1074 | ;; We assume the ewoc is sorted too, which should be the | ||
| 1075 | ;; case if we always add entries with vc-dir-update. | ||
| 1076 | (setq entries | ||
| 1077 | ;; Sort: first files and then subdirectories. | ||
| 1078 | ;; XXX: this is VERY inefficient, it computes the directory | ||
| 1079 | ;; names too many times | ||
| 1080 | (sort entries | ||
| 1081 | (lambda (entry1 entry2) | ||
| 1082 | (let ((dir1 (file-name-directory (expand-file-name (car entry1)))) | ||
| 1083 | (dir2 (file-name-directory (expand-file-name (car entry2))))) | ||
| 1084 | (cond | ||
| 1085 | ((string< dir1 dir2) t) | ||
| 1086 | ((not (string= dir1 dir2)) nil) | ||
| 1087 | ((string< (car entry1) (car entry2)))))))) | ||
| 1088 | (if (not vc-dir-insert-directories) | ||
| 1089 | (let ((entry (car entries)) | ||
| 1090 | (node (ewoc-nth vc-ewoc 0))) | ||
| 1091 | (while (and entry node) | ||
| 1092 | (let ((entryfile (car entry)) | ||
| 1093 | (nodefile (vc-dir-fileinfo->name (ewoc-data node)))) | ||
| 1094 | (cond | ||
| 1095 | ((string-lessp nodefile entryfile) | ||
| 1096 | (setq node (ewoc-next vc-ewoc node))) | ||
| 1097 | ((string-lessp entryfile nodefile) | ||
| 1098 | (unless noinsert | ||
| 1099 | (ewoc-enter-before vc-ewoc node | ||
| 1100 | (apply 'vc-dir-create-fileinfo entry))) | ||
| 1101 | (setq entries (cdr entries) entry (car entries))) | ||
| 1102 | (t | ||
| 1103 | (setf (vc-dir-fileinfo->state (ewoc-data node)) (nth 1 entry)) | ||
| 1104 | (setf (vc-dir-fileinfo->extra (ewoc-data node)) (nth 2 entry)) | ||
| 1105 | (setf (vc-dir-fileinfo->needs-update (ewoc-data node)) nil) | ||
| 1106 | (ewoc-invalidate vc-ewoc node) | ||
| 1107 | (setq entries (cdr entries) entry (car entries)) | ||
| 1108 | (setq node (ewoc-next vc-ewoc node)))))) | ||
| 1109 | (unless (or node noinsert) | ||
| 1110 | ;; We're past the last node, all remaining entries go to the end. | ||
| 1111 | (while entries | ||
| 1112 | (ewoc-enter-last vc-ewoc | ||
| 1113 | (apply 'vc-dir-create-fileinfo (pop entries)))))) | ||
| 1114 | ;; Insert directory entries in the right places. | ||
| 1115 | (let ((entry (car entries)) | ||
| 1116 | (node (ewoc-nth vc-ewoc 0))) | ||
| 1117 | ;; Insert . if it is not present. | ||
| 1118 | (unless node | ||
| 1119 | (let ((rd (file-relative-name default-directory))) | ||
| 1120 | (ewoc-enter-last | ||
| 1121 | vc-ewoc (vc-dir-create-fileinfo | ||
| 1122 | rd nil nil nil (expand-file-name default-directory)))) | ||
| 1123 | (setq node (ewoc-nth vc-ewoc 0))) | ||
| 1124 | |||
| 1125 | (while (and entry node) | ||
| 1126 | (let* ((entryfile (car entry)) | ||
| 1127 | (entrydir (file-name-directory (expand-file-name entryfile))) | ||
| 1128 | (nodedir | ||
| 1129 | (or (vc-dir-fileinfo->directory (ewoc-data node)) | ||
| 1130 | (file-name-directory | ||
| 1131 | (expand-file-name | ||
| 1132 | (vc-dir-fileinfo->name (ewoc-data node))))))) | ||
| 1133 | (cond | ||
| 1134 | ;; First try to find the directory. | ||
| 1135 | ((string-lessp nodedir entrydir) | ||
| 1136 | (setq node (ewoc-next vc-ewoc node))) | ||
| 1137 | ((string-equal nodedir entrydir) | ||
| 1138 | ;; Found the directory, find the place for the file name. | ||
| 1139 | (let ((nodefile (vc-dir-fileinfo->name (ewoc-data node)))) | ||
| 1140 | (cond | ||
| 1141 | ((string-lessp nodefile entryfile) | ||
| 1142 | (setq node (ewoc-next vc-ewoc node))) | ||
| 1143 | ((string-equal nodefile entryfile) | ||
| 1144 | (setf (vc-dir-fileinfo->state (ewoc-data node)) (nth 1 entry)) | ||
| 1145 | (setf (vc-dir-fileinfo->extra (ewoc-data node)) (nth 2 entry)) | ||
| 1146 | (setf (vc-dir-fileinfo->needs-update (ewoc-data node)) nil) | ||
| 1147 | (ewoc-invalidate vc-ewoc node) | ||
| 1148 | (setq entries (cdr entries) entry (car entries)) | ||
| 1149 | (setq node (ewoc-next vc-ewoc node))) | ||
| 1150 | (t | ||
| 1151 | (ewoc-enter-before vc-ewoc node | ||
| 1152 | (apply 'vc-dir-create-fileinfo entry)) | ||
| 1153 | (setq entries (cdr entries) entry (car entries)))))) | ||
| 1154 | (t | ||
| 1155 | ;; We need to insert a directory node | ||
| 1156 | (let ((rd (file-relative-name entrydir))) | ||
| 1157 | (ewoc-enter-last | ||
| 1158 | vc-ewoc (vc-dir-create-fileinfo rd nil nil nil entrydir))) | ||
| 1159 | ;; Now insert the node itself. | ||
| 1160 | (ewoc-enter-before vc-ewoc node | ||
| 1161 | (apply 'vc-dir-create-fileinfo entry)) | ||
| 1162 | (setq entries (cdr entries) entry (car entries)))))) | ||
| 1163 | ;; We're past the last node, all remaining entries go to the end. | ||
| 1164 | (unless (or node noinsert) | ||
| 1165 | (let* ((lastnode (ewoc-nth vc-ewoc -1)) | ||
| 1166 | (lastdir | ||
| 1167 | (or (vc-dir-fileinfo->directory (ewoc-data lastnode)) | ||
| 1168 | (file-name-directory | ||
| 1169 | (expand-file-name | ||
| 1170 | (vc-dir-fileinfo->name (ewoc-data lastnode))))))) | ||
| 1171 | (dolist (entry entries) | ||
| 1172 | (let ((entrydir (file-name-directory (expand-file-name (car entry))))) | ||
| 1173 | ;; Insert a directory node if needed. | ||
| 1174 | (unless (string-equal lastdir entrydir) | ||
| 1175 | (setq lastdir entrydir) | ||
| 1176 | (let ((rd (file-relative-name entrydir))) | ||
| 1177 | (ewoc-enter-last | ||
| 1178 | vc-ewoc (vc-dir-create-fileinfo rd nil nil nil entrydir)))) | ||
| 1179 | ;; Now insert the node itself. | ||
| 1180 | (ewoc-enter-last vc-ewoc | ||
| 1181 | (apply 'vc-dir-create-fileinfo entry)))))))))) | ||
| 1182 | |||
| 1183 | (defun vc-dir-busy () | ||
| 1184 | (and (buffer-live-p vc-dir-process-buffer) | ||
| 1185 | (get-buffer-process vc-dir-process-buffer))) | ||
| 1186 | |||
| 1187 | (defun vc-dir-kill-dir-status-process () | ||
| 1188 | "Kill the temporary buffer and associated process." | ||
| 1189 | (interactive) | ||
| 1190 | (when (buffer-live-p vc-dir-process-buffer) | ||
| 1191 | (let ((proc (get-buffer-process vc-dir-process-buffer))) | ||
| 1192 | (when proc (delete-process proc)) | ||
| 1193 | (setq vc-dir-process-buffer nil) | ||
| 1194 | (setq mode-line-process nil)))) | ||
| 1195 | |||
| 1196 | (defun vc-dir-kill-query () | ||
| 1197 | ;; Make sure that when the VC status buffer is killed the update | ||
| 1198 | ;; process running in background is also killed. | ||
| 1199 | (if (vc-dir-busy) | ||
| 1200 | (when (y-or-n-p "Status update process running, really kill status buffer?") | ||
| 1201 | (vc-dir-kill-dir-status-process) | ||
| 1202 | t) | ||
| 1203 | t)) | ||
| 1204 | |||
| 1205 | (defun vc-dir-next-line (arg) | ||
| 1206 | "Go to the next line. | ||
| 1207 | If a prefix argument is given, move by that many lines." | ||
| 1208 | (interactive "p") | ||
| 1209 | (ewoc-goto-next vc-ewoc arg) | ||
| 1210 | (vc-dir-move-to-goal-column)) | ||
| 1211 | |||
| 1212 | (defun vc-dir-previous-line (arg) | ||
| 1213 | "Go to the previous line. | ||
| 1214 | If a prefix argument is given, move by that many lines." | ||
| 1215 | (interactive "p") | ||
| 1216 | (ewoc-goto-prev vc-ewoc arg) | ||
| 1217 | (vc-dir-move-to-goal-column)) | ||
| 1218 | |||
| 1219 | (defun vc-dir-mark-unmark (mark-unmark-function) | ||
| 1220 | (if (use-region-p) | ||
| 1221 | (let ((firstl (line-number-at-pos (region-beginning))) | ||
| 1222 | (lastl (line-number-at-pos (region-end)))) | ||
| 1223 | (save-excursion | ||
| 1224 | (goto-char (region-beginning)) | ||
| 1225 | (while (<= (line-number-at-pos) lastl) | ||
| 1226 | (funcall mark-unmark-function)))) | ||
| 1227 | (funcall mark-unmark-function))) | ||
| 1228 | |||
| 1229 | (defun vc-dir-parent-marked-p (arg) | ||
| 1230 | (when vc-dir-insert-directories | ||
| 1231 | ;; Return nil if none of the parent directories of arg is marked. | ||
| 1232 | (let* ((argdata (ewoc-data arg)) | ||
| 1233 | (argdir | ||
| 1234 | (let ((crtdir (vc-dir-fileinfo->directory argdata))) | ||
| 1235 | (if crtdir | ||
| 1236 | crtdir | ||
| 1237 | (file-name-directory (expand-file-name | ||
| 1238 | (vc-dir-fileinfo->name argdata)))))) | ||
| 1239 | (arglen (length argdir)) | ||
| 1240 | (crt arg) | ||
| 1241 | data dir) | ||
| 1242 | ;; Go through the predecessors, checking if any directory that is | ||
| 1243 | ;; a parent is marked. | ||
| 1244 | (while (setq crt (ewoc-prev vc-ewoc crt)) | ||
| 1245 | (setq data (ewoc-data crt)) | ||
| 1246 | (setq dir | ||
| 1247 | (let ((crtdir (vc-dir-fileinfo->directory data))) | ||
| 1248 | (if crtdir | ||
| 1249 | crtdir | ||
| 1250 | (file-name-directory (expand-file-name | ||
| 1251 | (vc-dir-fileinfo->name data)))))) | ||
| 1252 | |||
| 1253 | (when (and (vc-dir-fileinfo->directory data) | ||
| 1254 | (string-equal (substring argdir 0 (length dir)) dir)) | ||
| 1255 | (when (vc-dir-fileinfo->marked data) | ||
| 1256 | (error "Cannot mark `%s', parent directory `%s' marked" | ||
| 1257 | (vc-dir-fileinfo->name argdata) | ||
| 1258 | (vc-dir-fileinfo->name data))))) | ||
| 1259 | nil))) | ||
| 1260 | |||
| 1261 | (defun vc-dir-children-marked-p (arg) | ||
| 1262 | ;; Return nil if none of the children of arg is marked. | ||
| 1263 | (when vc-dir-insert-directories | ||
| 1264 | (let* ((argdata (ewoc-data arg)) | ||
| 1265 | (argdir (vc-dir-fileinfo->directory argdata)) | ||
| 1266 | (arglen (length argdir)) | ||
| 1267 | (is-child t) | ||
| 1268 | (crt arg) | ||
| 1269 | data dir) | ||
| 1270 | (while (and is-child (setq crt (ewoc-next vc-ewoc crt))) | ||
| 1271 | (setq data (ewoc-data crt)) | ||
| 1272 | (setq dir | ||
| 1273 | (let ((crtdir (vc-dir-fileinfo->directory data))) | ||
| 1274 | (if crtdir | ||
| 1275 | crtdir | ||
| 1276 | (file-name-directory (expand-file-name | ||
| 1277 | (vc-dir-fileinfo->name data)))))) | ||
| 1278 | (if (string-equal argdir (substring dir 0 arglen)) | ||
| 1279 | (when (vc-dir-fileinfo->marked data) | ||
| 1280 | (error "Cannot mark `%s', child `%s' marked" | ||
| 1281 | (vc-dir-fileinfo->name argdata) | ||
| 1282 | (vc-dir-fileinfo->name data))) | ||
| 1283 | ;; We are done, we got to an entry that is not a child of `arg'. | ||
| 1284 | (setq is-child nil))) | ||
| 1285 | nil))) | ||
| 1286 | |||
| 1287 | (defun vc-dir-mark-file (&optional arg) | ||
| 1288 | ;; Mark ARG or the current file and move to the next line. | ||
| 1289 | (let* ((crt (or arg (ewoc-locate vc-ewoc))) | ||
| 1290 | (file (ewoc-data crt)) | ||
| 1291 | (isdir (vc-dir-fileinfo->directory file))) | ||
| 1292 | (when (or (and isdir (not (vc-dir-children-marked-p crt))) | ||
| 1293 | (and (not isdir) (not (vc-dir-parent-marked-p crt)))) | ||
| 1294 | (setf (vc-dir-fileinfo->marked file) t) | ||
| 1295 | (ewoc-invalidate vc-ewoc crt) | ||
| 1296 | (unless (or arg (mouse-event-p last-command-event)) | ||
| 1297 | (vc-dir-next-line 1))))) | ||
| 1298 | |||
| 1299 | (defun vc-dir-mark () | ||
| 1300 | "Mark the current file or all files in the region. | ||
| 1301 | If the region is active, mark all the files in the region. | ||
| 1302 | Otherwise mark the file on the current line and move to the next | ||
| 1303 | line." | ||
| 1304 | (interactive) | ||
| 1305 | (vc-dir-mark-unmark 'vc-dir-mark-file)) | ||
| 1306 | |||
| 1307 | (defun vc-dir-mark-all-files (arg) | ||
| 1308 | "Mark all files with the same state as the current one. | ||
| 1309 | With a prefix argument mark all files. | ||
| 1310 | If the current entry is a directory, mark all child files. | ||
| 1311 | |||
| 1312 | The VC commands operate on files that are on the same state. | ||
| 1313 | This command is intended to make it easy to select all files that | ||
| 1314 | share the same state." | ||
| 1315 | (interactive "P") | ||
| 1316 | (if arg | ||
| 1317 | ;; Mark all files. | ||
| 1318 | (progn | ||
| 1319 | ;; First check that no directory is marked, we can't mark | ||
| 1320 | ;; files in that case. | ||
| 1321 | (ewoc-map | ||
| 1322 | (lambda (filearg) | ||
| 1323 | (when (and (vc-dir-fileinfo->directory filearg) | ||
| 1324 | (vc-dir-fileinfo->directory filearg)) | ||
| 1325 | (error "Cannot mark all files, directory `%s' marked" | ||
| 1326 | (vc-dir-fileinfo->name filearg)))) | ||
| 1327 | vc-ewoc) | ||
| 1328 | (ewoc-map | ||
| 1329 | (lambda (filearg) | ||
| 1330 | (unless (vc-dir-fileinfo->marked filearg) | ||
| 1331 | (setf (vc-dir-fileinfo->marked filearg) t) | ||
| 1332 | t)) | ||
| 1333 | vc-ewoc)) | ||
| 1334 | (let ((data (ewoc-data (ewoc-locate vc-ewoc)))) | ||
| 1335 | (if (vc-dir-fileinfo->directory data) | ||
| 1336 | ;; It's a directory, mark child files. | ||
| 1337 | (let ((crt (ewoc-locate vc-ewoc))) | ||
| 1338 | (unless (vc-dir-children-marked-p crt) | ||
| 1339 | (while (setq crt (ewoc-next vc-ewoc crt)) | ||
| 1340 | (let ((crt-data (ewoc-data crt))) | ||
| 1341 | (unless (vc-dir-fileinfo->directory crt-data) | ||
| 1342 | (setf (vc-dir-fileinfo->marked crt-data) t) | ||
| 1343 | (ewoc-invalidate vc-ewoc crt)))))) | ||
| 1344 | ;; It's a file | ||
| 1345 | (let ((state (vc-dir-fileinfo->state data)) | ||
| 1346 | (crt (ewoc-nth vc-ewoc 0))) | ||
| 1347 | (while crt | ||
| 1348 | (let ((crt-data (ewoc-data crt))) | ||
| 1349 | (when (and (not (vc-dir-fileinfo->marked crt-data)) | ||
| 1350 | (eq (vc-dir-fileinfo->state crt-data) state) | ||
| 1351 | (not (vc-dir-fileinfo->directory crt-data))) | ||
| 1352 | (vc-dir-mark-file crt))) | ||
| 1353 | (setq crt (ewoc-next vc-ewoc crt)))))))) | ||
| 1354 | |||
| 1355 | (defun vc-dir-unmark-file () | ||
| 1356 | ;; Unmark the current file and move to the next line. | ||
| 1357 | (let* ((crt (ewoc-locate vc-ewoc)) | ||
| 1358 | (file (ewoc-data crt))) | ||
| 1359 | (setf (vc-dir-fileinfo->marked file) nil) | ||
| 1360 | (ewoc-invalidate vc-ewoc crt) | ||
| 1361 | (unless (mouse-event-p last-command-event) | ||
| 1362 | (vc-dir-next-line 1)))) | ||
| 1363 | |||
| 1364 | (defun vc-dir-unmark () | ||
| 1365 | "Unmark the current file or all files in the region. | ||
| 1366 | If the region is active, unmark all the files in the region. | ||
| 1367 | Otherwise mark the file on the current line and move to the next | ||
| 1368 | line." | ||
| 1369 | (interactive) | ||
| 1370 | (vc-dir-mark-unmark 'vc-dir-unmark-file)) | ||
| 1371 | |||
| 1372 | (defun vc-dir-unmark-file-up () | ||
| 1373 | "Move to the previous line and unmark the file." | ||
| 1374 | (interactive) | ||
| 1375 | ;; If we're on the first line, we won't move up, but we will still | ||
| 1376 | ;; remove the mark. This seems a bit odd but it is what buffer-menu | ||
| 1377 | ;; does. | ||
| 1378 | (let* ((prev (ewoc-goto-prev vc-ewoc 1)) | ||
| 1379 | (file (ewoc-data prev))) | ||
| 1380 | (setf (vc-dir-fileinfo->marked file) nil) | ||
| 1381 | (ewoc-invalidate vc-ewoc prev) | ||
| 1382 | (vc-dir-move-to-goal-column))) | ||
| 1383 | |||
| 1384 | (defun vc-dir-unmark-all-files (arg) | ||
| 1385 | "Unmark all files with the same state as the current one. | ||
| 1386 | With a prefix argument unmark all files. | ||
| 1387 | If the current entry is a directory, unmark all the child files. | ||
| 1388 | |||
| 1389 | The VC commands operate on files that are on the same state. | ||
| 1390 | This command is intended to make it easy to deselect all files | ||
| 1391 | that share the same state." | ||
| 1392 | (interactive "P") | ||
| 1393 | (if arg | ||
| 1394 | (ewoc-map | ||
| 1395 | (lambda (filearg) | ||
| 1396 | (when (vc-dir-fileinfo->marked filearg) | ||
| 1397 | (setf (vc-dir-fileinfo->marked filearg) nil) | ||
| 1398 | t)) | ||
| 1399 | vc-ewoc) | ||
| 1400 | (let* ((crt (ewoc-locate vc-ewoc)) | ||
| 1401 | (data (ewoc-data crt))) | ||
| 1402 | (if (vc-dir-fileinfo->directory data) | ||
| 1403 | ;; It's a directory, unmark child files. | ||
| 1404 | (while (setq crt (ewoc-next vc-ewoc crt)) | ||
| 1405 | (let ((crt-data (ewoc-data crt))) | ||
| 1406 | (unless (vc-dir-fileinfo->directory crt-data) | ||
| 1407 | (setf (vc-dir-fileinfo->marked crt-data) nil) | ||
| 1408 | (ewoc-invalidate vc-ewoc crt)))) | ||
| 1409 | ;; It's a file | ||
| 1410 | (let ((crt-state (vc-dir-fileinfo->state (ewoc-data crt)))) | ||
| 1411 | (ewoc-map | ||
| 1412 | (lambda (filearg) | ||
| 1413 | (when (and (vc-dir-fileinfo->marked filearg) | ||
| 1414 | (eq (vc-dir-fileinfo->state filearg) crt-state)) | ||
| 1415 | (setf (vc-dir-fileinfo->marked filearg) nil) | ||
| 1416 | t)) | ||
| 1417 | vc-ewoc)))))) | ||
| 1418 | |||
| 1419 | (defun vc-dir-toggle-mark-file () | ||
| 1420 | (let* ((crt (ewoc-locate vc-ewoc)) | ||
| 1421 | (file (ewoc-data crt))) | ||
| 1422 | (if (vc-dir-fileinfo->marked file) | ||
| 1423 | (vc-dir-unmark-file) | ||
| 1424 | (vc-dir-mark-file)))) | ||
| 1425 | |||
| 1426 | (defun vc-dir-toggle-mark (e) | ||
| 1427 | (interactive "e") | ||
| 1428 | (vc-at-event e (vc-dir-mark-unmark 'vc-dir-toggle-mark-file))) | ||
| 1429 | |||
| 1430 | (defun vc-dir-delete-file () | ||
| 1431 | "Delete the marked files, or the current file if no marks." | ||
| 1432 | (interactive) | ||
| 1433 | (mapc 'vc-delete-file (or (vc-dir-marked-files) | ||
| 1434 | (list (vc-dir-current-file))))) | ||
| 1435 | |||
| 1436 | (defun vc-dir-find-file () | ||
| 1437 | "Find the file on the current line." | ||
| 1438 | (interactive) | ||
| 1439 | (find-file (vc-dir-current-file))) | ||
| 1440 | |||
| 1441 | (defun vc-dir-find-file-other-window () | ||
| 1442 | "Find the file on the current line, in another window." | ||
| 1443 | (interactive) | ||
| 1444 | (find-file-other-window (vc-dir-current-file))) | ||
| 1445 | |||
| 1446 | (defun vc-dir-current-file () | ||
| 1447 | (let ((node (ewoc-locate vc-ewoc))) | ||
| 1448 | (unless node | ||
| 1449 | (error "No file available.")) | ||
| 1450 | (expand-file-name (vc-dir-fileinfo->name (ewoc-data node))))) | ||
| 1451 | |||
| 1452 | (defun vc-dir-marked-files () | ||
| 1453 | "Return the list of marked files." | ||
| 1454 | (mapcar | ||
| 1455 | (lambda (elem) (expand-file-name (vc-dir-fileinfo->name elem))) | ||
| 1456 | (ewoc-collect vc-ewoc 'vc-dir-fileinfo->marked))) | ||
| 1457 | |||
| 1458 | (defun vc-dir-marked-only-files () | ||
| 1459 | "Return the list of marked files, for marked directories, return child files." | ||
| 1460 | |||
| 1461 | (let ((crt (ewoc-nth vc-ewoc 0)) | ||
| 1462 | result) | ||
| 1463 | (while crt | ||
| 1464 | (let ((crt-data (ewoc-data crt))) | ||
| 1465 | (if (vc-dir-fileinfo->marked crt-data) | ||
| 1466 | (if (vc-dir-fileinfo->directory crt-data) | ||
| 1467 | (let* ((dir (vc-dir-fileinfo->directory crt-data)) | ||
| 1468 | (dirlen (length dir)) | ||
| 1469 | data) | ||
| 1470 | (while | ||
| 1471 | (and (setq crt (ewoc-next vc-ewoc crt)) | ||
| 1472 | (string-equal | ||
| 1473 | (substring | ||
| 1474 | (progn | ||
| 1475 | (setq data (ewoc-data crt)) | ||
| 1476 | (let ((crtdir (vc-dir-fileinfo->directory data))) | ||
| 1477 | (if crtdir | ||
| 1478 | crtdir | ||
| 1479 | (file-name-directory | ||
| 1480 | (expand-file-name | ||
| 1481 | (vc-dir-fileinfo->name data)))))) | ||
| 1482 | 0 dirlen) | ||
| 1483 | dir)) | ||
| 1484 | (unless (vc-dir-fileinfo->directory data) | ||
| 1485 | (push (vc-dir-fileinfo->name data) result)))) | ||
| 1486 | (push (expand-file-name (vc-dir-fileinfo->name crt-data)) result) | ||
| 1487 | (setq crt (ewoc-next vc-ewoc crt))) | ||
| 1488 | (setq crt (ewoc-next vc-ewoc crt))))) | ||
| 1489 | result)) | ||
| 1490 | |||
| 830 | ;;; vc-dispatcher.el ends here | 1491 | ;;; vc-dispatcher.el ends here |
diff --git a/lisp/vc.el b/lisp/vc.el index ad01ed3d05e..031f15cac3a 100644 --- a/lisp/vc.el +++ b/lisp/vc.el | |||
| @@ -818,12 +818,6 @@ See `run-hooks'." | |||
| 818 | :type 'hook | 818 | :type 'hook |
| 819 | :group 'vc) | 819 | :group 'vc) |
| 820 | 820 | ||
| 821 | (defcustom vc-dir-mode-hook nil | ||
| 822 | "Normal hook run by `vc-dir-mode'. | ||
| 823 | See `run-hooks'." | ||
| 824 | :type 'hook | ||
| 825 | :group 'vc) | ||
| 826 | |||
| 827 | ;; Annotate customization | 821 | ;; Annotate customization |
| 828 | (defcustom vc-annotate-color-map | 822 | (defcustom vc-annotate-color-map |
| 829 | (if (and (tty-display-color-p) (<= (display-color-cells) 8)) | 823 | (if (and (tty-display-color-p) (<= (display-color-cells) 8)) |
| @@ -2035,27 +2029,6 @@ Called by dired after any portion of a vc-dired buffer has been read in." | |||
| 2035 | 2029 | ||
| 2036 | ;; VC status implementation | 2030 | ;; VC status implementation |
| 2037 | 2031 | ||
| 2038 | ;; Used to store information for the files displayed in the *VC status* buffer. | ||
| 2039 | ;; Each item displayed corresponds to one of these defstructs. | ||
| 2040 | (defstruct (vc-dir-fileinfo | ||
| 2041 | (:copier nil) | ||
| 2042 | (:type list) ;So we can use `member' on lists of FIs. | ||
| 2043 | (:constructor | ||
| 2044 | ;; We could define it as an alias for `list'. | ||
| 2045 | vc-dir-create-fileinfo (name state &optional extra marked directory)) | ||
| 2046 | (:conc-name vc-dir-fileinfo->)) | ||
| 2047 | name ;Keep it as first, for `member'. | ||
| 2048 | state | ||
| 2049 | ;; For storing backend specific information. | ||
| 2050 | extra | ||
| 2051 | marked | ||
| 2052 | ;; To keep track of not updated files during a global refresh | ||
| 2053 | needs-update | ||
| 2054 | ;; To distinguish files and directories. | ||
| 2055 | directory) | ||
| 2056 | |||
| 2057 | (defvar vc-ewoc nil) | ||
| 2058 | |||
| 2059 | (defun vc-default-status-extra-headers (backend dir) | 2032 | (defun vc-default-status-extra-headers (backend dir) |
| 2060 | ;; Be loud by default to remind people to add coded to display | 2033 | ;; Be loud by default to remind people to add coded to display |
| 2061 | ;; backend specific headers. | 2034 | ;; backend specific headers. |
| @@ -2102,239 +2075,9 @@ specific headers." | |||
| 2102 | (let ((backend (vc-responsible-backend default-directory))) | 2075 | (let ((backend (vc-responsible-backend default-directory))) |
| 2103 | (vc-call-backend backend 'status-printer fileentry))) | 2076 | (vc-call-backend backend 'status-printer fileentry))) |
| 2104 | 2077 | ||
| 2105 | (defun vc-dir-move-to-goal-column () | ||
| 2106 | ;; Used to keep the cursor on the file name column. | ||
| 2107 | (beginning-of-line) | ||
| 2108 | ;; Must be in sync with vc-default-status-printer. | ||
| 2109 | (forward-char 25)) | ||
| 2110 | |||
| 2111 | (defun vc-dir-prepare-status-buffer (dir &optional create-new) | ||
| 2112 | "Find a *vc-dir* buffer showing DIR, or create a new one." | ||
| 2113 | (setq dir (expand-file-name dir)) | ||
| 2114 | (let* ((bname "*vc-dir*") | ||
| 2115 | ;; Look for another *vc-dir* buffer visiting the same directory. | ||
| 2116 | (buf (save-excursion | ||
| 2117 | (unless create-new | ||
| 2118 | (dolist (buffer (buffer-list)) | ||
| 2119 | (set-buffer buffer) | ||
| 2120 | (when (and (eq major-mode 'vc-dir-mode) | ||
| 2121 | (string= (expand-file-name default-directory) dir)) | ||
| 2122 | (return buffer))))))) | ||
| 2123 | (or buf | ||
| 2124 | ;; Create a new *vc-dir* buffer. | ||
| 2125 | (with-current-buffer (create-file-buffer bname) | ||
| 2126 | (cd dir) | ||
| 2127 | (vc-setup-buffer (current-buffer)) | ||
| 2128 | ;; Reset the vc-parent-buffer-name so that it does not appear | ||
| 2129 | ;; in the mode-line. | ||
| 2130 | (setq vc-parent-buffer-name nil) | ||
| 2131 | (current-buffer))))) | ||
| 2132 | |||
| 2133 | ;;;###autoload | ||
| 2134 | (defun vc-dir (dir) | ||
| 2135 | "Show the VC status for DIR." | ||
| 2136 | (interactive "DVC status for directory: ") | ||
| 2137 | (pop-to-buffer (vc-dir-prepare-status-buffer dir)) | ||
| 2138 | (if (eq major-mode 'vc-dir-mode) | ||
| 2139 | (vc-dir-refresh) | ||
| 2140 | (vc-dir-mode))) | ||
| 2141 | |||
| 2142 | (defvar vc-dir-menu-map | ||
| 2143 | (let ((map (make-sparse-keymap "VC-dir"))) | ||
| 2144 | (define-key map [quit] | ||
| 2145 | '(menu-item "Quit" quit-window | ||
| 2146 | :help "Quit")) | ||
| 2147 | (define-key map [kill] | ||
| 2148 | '(menu-item "Kill Update Command" vc-dir-kill-dir-status-process | ||
| 2149 | :enable (vc-dir-busy) | ||
| 2150 | :help "Kill the command that updates VC status buffer")) | ||
| 2151 | (define-key map [refresh] | ||
| 2152 | '(menu-item "Refresh" vc-dir-refresh | ||
| 2153 | :enable (not (vc-dir-busy)) | ||
| 2154 | :help "Refresh the contents of the VC status buffer")) | ||
| 2155 | (define-key map [remup] | ||
| 2156 | '(menu-item "Hide up-to-date" vc-dir-hide-up-to-date | ||
| 2157 | :help "Hide up-to-date items from display")) | ||
| 2158 | ;; Movement. | ||
| 2159 | (define-key map [sepmv] '("--")) | ||
| 2160 | (define-key map [next-line] | ||
| 2161 | '(menu-item "Next line" vc-dir-next-line | ||
| 2162 | :help "Go to the next line" :keys "n")) | ||
| 2163 | (define-key map [previous-line] | ||
| 2164 | '(menu-item "Previous line" vc-dir-previous-line | ||
| 2165 | :help "Go to the previous line")) | ||
| 2166 | ;; Marking. | ||
| 2167 | (define-key map [sepmrk] '("--")) | ||
| 2168 | (define-key map [unmark-all] | ||
| 2169 | '(menu-item "Unmark All" vc-dir-unmark-all-files | ||
| 2170 | :help "Unmark all files that are in the same state as the current file\ | ||
| 2171 | \nWith prefix argument unmark all files")) | ||
| 2172 | (define-key map [unmark-previous] | ||
| 2173 | '(menu-item "Unmark previous " vc-dir-unmark-file-up | ||
| 2174 | :help "Move to the previous line and unmark the file")) | ||
| 2175 | |||
| 2176 | (define-key map [mark-all] | ||
| 2177 | '(menu-item "Mark All" vc-dir-mark-all-files | ||
| 2178 | :help "Mark all files that are in the same state as the current file\ | ||
| 2179 | \nWith prefix argument mark all files")) | ||
| 2180 | (define-key map [unmark] | ||
| 2181 | '(menu-item "Unmark" vc-dir-unmark | ||
| 2182 | :help "Unmark the current file or all files in the region")) | ||
| 2183 | |||
| 2184 | (define-key map [mark] | ||
| 2185 | '(menu-item "Mark" vc-dir-mark | ||
| 2186 | :help "Mark the current file or all files in the region")) | ||
| 2187 | |||
| 2188 | (define-key map [sepopn] '("--")) | ||
| 2189 | (define-key map [open-other] | ||
| 2190 | '(menu-item "Open in other window" vc-dir-find-file-other-window | ||
| 2191 | :help "Find the file on the current line, in another window")) | ||
| 2192 | (define-key map [open] | ||
| 2193 | '(menu-item "Open file" vc-dir-find-file | ||
| 2194 | :help "Find the file on the current line")) | ||
| 2195 | ;; VC info details | ||
| 2196 | (define-key map [sepvcdet] '("--")) | ||
| 2197 | ;; FIXME: This needs a key binding. And maybe a better name | ||
| 2198 | ;; ("Insert" like PCL-CVS uses does not sound that great either)... | ||
| 2199 | (define-key map [ins] | ||
| 2200 | '(menu-item "Show File" vc-dir-show-fileentry | ||
| 2201 | :help "Show a file in the VC status listing even though it might be up to date")) | ||
| 2202 | (define-key map [annotate] | ||
| 2203 | '(menu-item "Annotate" vc-annotate | ||
| 2204 | :help "Display the edit history of the current file using colors")) | ||
| 2205 | (define-key map [diff] | ||
| 2206 | '(menu-item "Compare with Base Version" vc-diff | ||
| 2207 | :help "Compare file set with the base version")) | ||
| 2208 | (define-key map [log] | ||
| 2209 | '(menu-item "Show history" vc-print-log | ||
| 2210 | :help "List the change log of the current file set in a window")) | ||
| 2211 | ;; VC commands. | ||
| 2212 | (define-key map [sepvccmd] '("--")) | ||
| 2213 | (define-key map [update] | ||
| 2214 | '(menu-item "Update to latest version" vc-update | ||
| 2215 | :help "Update the current fileset's files to their tip revisions")) | ||
| 2216 | (define-key map [revert] | ||
| 2217 | '(menu-item "Revert to base version" vc-revert | ||
| 2218 | :help "Revert working copies of the selected fileset to their repository contents.")) | ||
| 2219 | (define-key map [next-action] | ||
| 2220 | ;; FIXME: This really really really needs a better name! | ||
| 2221 | ;; And a key binding too. | ||
| 2222 | '(menu-item "Check In/Out" vc-next-action | ||
| 2223 | :help "Do the next logical version control operation on the current fileset")) | ||
| 2224 | (define-key map [register] | ||
| 2225 | '(menu-item "Register" vc-dir-register | ||
| 2226 | :help "Register file set into the version control system")) | ||
| 2227 | map) | ||
| 2228 | "Menu for VC status") | ||
| 2229 | |||
| 2230 | (defalias 'vc-dir-menu-map vc-dir-menu-map) | ||
| 2231 | |||
| 2232 | (defvar vc-dir-mode-map | ||
| 2233 | (let ((map (make-keymap))) | ||
| 2234 | (suppress-keymap map) | ||
| 2235 | ;; Marking. | ||
| 2236 | (define-key map "m" 'vc-dir-mark) | ||
| 2237 | (define-key map "M" 'vc-dir-mark-all-files) | ||
| 2238 | (define-key map "u" 'vc-dir-unmark) | ||
| 2239 | (define-key map "U" 'vc-dir-unmark-all-files) | ||
| 2240 | (define-key map "\C-?" 'vc-dir-unmark-file-up) | ||
| 2241 | (define-key map "\M-\C-?" 'vc-dir-unmark-all-files) | ||
| 2242 | ;; Movement. | ||
| 2243 | (define-key map "n" 'vc-dir-next-line) | ||
| 2244 | (define-key map " " 'vc-dir-next-line) | ||
| 2245 | (define-key map "\t" 'vc-dir-next-line) | ||
| 2246 | (define-key map "p" 'vc-dir-previous-line) | ||
| 2247 | (define-key map [backtab] 'vc-dir-previous-line) | ||
| 2248 | ;; VC commands. | ||
| 2249 | (define-key map "=" 'vc-diff) ;; C-x v = | ||
| 2250 | (define-key map "a" 'vc-dir-register) | ||
| 2251 | (define-key map "+" 'vc-update) ;; C-x v + | ||
| 2252 | (define-key map "R" 'vc-revert) ;; u is taken by unmark. | ||
| 2253 | |||
| 2254 | ;; Can't be "g" (as in vc map), so "A" for "Annotate". | ||
| 2255 | (define-key map "A" 'vc-annotate) | ||
| 2256 | (define-key map "l" 'vc-print-log) ;; C-x v l | ||
| 2257 | ;; The remainder. | ||
| 2258 | (define-key map "f" 'vc-dir-find-file) | ||
| 2259 | (define-key map "\C-m" 'vc-dir-find-file) | ||
| 2260 | (define-key map "o" 'vc-dir-find-file-other-window) | ||
| 2261 | (define-key map "x" 'vc-dir-hide-up-to-date) | ||
| 2262 | (define-key map "q" 'quit-window) | ||
| 2263 | (define-key map "g" 'vc-dir-refresh) | ||
| 2264 | (define-key map "\C-c\C-c" 'vc-dir-kill-dir-status-process) | ||
| 2265 | (define-key map [(down-mouse-3)] 'vc-dir-menu) | ||
| 2266 | (define-key map [(mouse-2)] 'vc-dir-toggle-mark) | ||
| 2267 | |||
| 2268 | ;; Hook up the menu. | ||
| 2269 | (define-key map [menu-bar vc-dir-mode] | ||
| 2270 | '(menu-item | ||
| 2271 | ;; This is used to that VC backends could add backend specific | ||
| 2272 | ;; menu items to vc-dir-menu-map. | ||
| 2273 | "VC Status" vc-dir-menu-map :filter vc-dir-menu-map-filter)) | ||
| 2274 | map) | ||
| 2275 | "Keymap for VC status") | ||
| 2276 | |||
| 2277 | (defun vc-default-extra-status-menu (backend) | 2078 | (defun vc-default-extra-status-menu (backend) |
| 2278 | nil) | 2079 | nil) |
| 2279 | 2080 | ||
| 2280 | ;; This is used to that VC backends could add backend specific menu | ||
| 2281 | ;; items to vc-dir-menu-map. | ||
| 2282 | (defun vc-dir-menu-map-filter (orig-binding) | ||
| 2283 | (when (and (symbolp orig-binding) (fboundp orig-binding)) | ||
| 2284 | (setq orig-binding (indirect-function orig-binding))) | ||
| 2285 | (let ((ext-binding | ||
| 2286 | (vc-call-backend (vc-responsible-backend default-directory) | ||
| 2287 | 'extra-status-menu))) | ||
| 2288 | (if (null ext-binding) | ||
| 2289 | orig-binding | ||
| 2290 | (append orig-binding | ||
| 2291 | '("----") | ||
| 2292 | ext-binding)))) | ||
| 2293 | |||
| 2294 | (defmacro vc-at-event (event &rest body) | ||
| 2295 | "Evaluate `body' wich point located at event-start of `event'. | ||
| 2296 | If `body' uses `event', it should be a variable, | ||
| 2297 | otherwise it will be evaluated twice." | ||
| 2298 | (let ((posn (gensym "vc-at-event-posn"))) | ||
| 2299 | `(let ((,posn (event-start ,event))) | ||
| 2300 | (save-excursion | ||
| 2301 | (set-buffer (window-buffer (posn-window ,posn))) | ||
| 2302 | (goto-char (posn-point ,posn)) | ||
| 2303 | ,@body)))) | ||
| 2304 | |||
| 2305 | (defun vc-dir-menu (e) | ||
| 2306 | "Popup the VC status menu." | ||
| 2307 | (interactive "e") | ||
| 2308 | (vc-at-event e (popup-menu vc-dir-menu-map e))) | ||
| 2309 | |||
| 2310 | (defvar vc-dir-tool-bar-map | ||
| 2311 | (let ((map (make-sparse-keymap))) | ||
| 2312 | (tool-bar-local-item-from-menu 'vc-dir-find-file "open" | ||
| 2313 | map vc-dir-mode-map) | ||
| 2314 | (tool-bar-local-item "bookmark_add" | ||
| 2315 | 'vc-dir-toggle-mark 'vc-dir-toggle-mark map | ||
| 2316 | :help "Toggle mark on current item") | ||
| 2317 | (tool-bar-local-item-from-menu 'vc-dir-previous-line "left-arrow" | ||
| 2318 | map vc-dir-mode-map | ||
| 2319 | :rtl "right-arrow") | ||
| 2320 | (tool-bar-local-item-from-menu 'vc-dir-next-line "right-arrow" | ||
| 2321 | map vc-dir-mode-map | ||
| 2322 | :rtl "left-arrow") | ||
| 2323 | (tool-bar-local-item-from-menu 'vc-print-log "info" | ||
| 2324 | map vc-dir-mode-map) | ||
| 2325 | (tool-bar-local-item-from-menu 'vc-dir-refresh "refresh" | ||
| 2326 | map vc-dir-mode-map) | ||
| 2327 | (tool-bar-local-item-from-menu 'nonincremental-search-forward | ||
| 2328 | "search" map) | ||
| 2329 | (tool-bar-local-item-from-menu 'vc-dir-kill-dir-status-process "cancel" | ||
| 2330 | map vc-dir-mode-map) | ||
| 2331 | (tool-bar-local-item-from-menu 'quit-window "exit" | ||
| 2332 | map vc-dir-mode-map) | ||
| 2333 | map)) | ||
| 2334 | |||
| 2335 | (defvar vc-dir-process-buffer nil | ||
| 2336 | "The buffer used for the asynchronous call that computes the VC status.") | ||
| 2337 | |||
| 2338 | (defun vc-dir-mode () | 2081 | (defun vc-dir-mode () |
| 2339 | "Major mode for showing the VC status for a directory. | 2082 | "Major mode for showing the VC status for a directory. |
| 2340 | Marking/Unmarking key bindings and actions: | 2083 | Marking/Unmarking key bindings and actions: |
| @@ -2378,130 +2121,28 @@ U - if the cursor is on a file: unmark all the files with the same VC state | |||
| 2378 | 2121 | ||
| 2379 | (put 'vc-dir-mode 'mode-class 'special) | 2122 | (put 'vc-dir-mode 'mode-class 'special) |
| 2380 | 2123 | ||
| 2381 | ;; t if directories should be shown in vc-dir. | 2124 | ;;;###autoload |
| 2382 | ;; WORK IN PROGRESS! DO NOT SET this! ONLY set it if you want to help | 2125 | (defun vc-dir (dir) |
| 2383 | ;; write code for this feature. This variable will likely disappear | 2126 | "Show the VC status for DIR." |
| 2384 | ;; when the work is done. | 2127 | (interactive "DVC status for directory: ") |
| 2385 | (defvar vc-dir-insert-directories nil) | 2128 | (pop-to-buffer (vc-dir-prepare-status-buffer dir)) |
| 2386 | 2129 | (if (eq major-mode 'vc-dir-mode) | |
| 2387 | (defun vc-dir-update (entries buffer &optional noinsert) | 2130 | (vc-dir-refresh) |
| 2388 | "Update BUFFER's ewoc from the list of ENTRIES. | 2131 | (vc-dir-mode))) |
| 2389 | If NOINSERT, ignore elements on ENTRIES which are not in the ewoc." | 2132 | |
| 2390 | ;; Add ENTRIES to the vc-dir buffer BUFFER. | 2133 | ;; This is used to that VC backends could add backend specific menu |
| 2391 | (with-current-buffer buffer | 2134 | ;; items to vc-dir-menu-map. |
| 2392 | ;; Insert the entries sorted by name into the ewoc. | 2135 | (defun vc-dir-menu-map-filter (orig-binding) |
| 2393 | ;; We assume the ewoc is sorted too, which should be the | 2136 | (when (and (symbolp orig-binding) (fboundp orig-binding)) |
| 2394 | ;; case if we always add entries with vc-dir-update. | 2137 | (setq orig-binding (indirect-function orig-binding))) |
| 2395 | (setq entries | 2138 | (let ((ext-binding |
| 2396 | ;; Sort: first files and then subdirectories. | 2139 | (vc-call-backend (vc-responsible-backend default-directory) |
| 2397 | ;; XXX: this is VERY inefficient, it computes the directory | 2140 | 'extra-status-menu))) |
| 2398 | ;; names too many times | 2141 | (if (null ext-binding) |
| 2399 | (sort entries | 2142 | orig-binding |
| 2400 | (lambda (entry1 entry2) | 2143 | (append orig-binding |
| 2401 | (let ((dir1 (file-name-directory (expand-file-name (car entry1)))) | 2144 | '("----") |
| 2402 | (dir2 (file-name-directory (expand-file-name (car entry2))))) | 2145 | ext-binding)))) |
| 2403 | (cond | ||
| 2404 | ((string< dir1 dir2) t) | ||
| 2405 | ((not (string= dir1 dir2)) nil) | ||
| 2406 | ((string< (car entry1) (car entry2)))))))) | ||
| 2407 | (if (not vc-dir-insert-directories) | ||
| 2408 | (let ((entry (car entries)) | ||
| 2409 | (node (ewoc-nth vc-ewoc 0))) | ||
| 2410 | (while (and entry node) | ||
| 2411 | (let ((entryfile (car entry)) | ||
| 2412 | (nodefile (vc-dir-fileinfo->name (ewoc-data node)))) | ||
| 2413 | (cond | ||
| 2414 | ((string-lessp nodefile entryfile) | ||
| 2415 | (setq node (ewoc-next vc-ewoc node))) | ||
| 2416 | ((string-lessp entryfile nodefile) | ||
| 2417 | (unless noinsert | ||
| 2418 | (ewoc-enter-before vc-ewoc node | ||
| 2419 | (apply 'vc-dir-create-fileinfo entry))) | ||
| 2420 | (setq entries (cdr entries) entry (car entries))) | ||
| 2421 | (t | ||
| 2422 | (setf (vc-dir-fileinfo->state (ewoc-data node)) (nth 1 entry)) | ||
| 2423 | (setf (vc-dir-fileinfo->extra (ewoc-data node)) (nth 2 entry)) | ||
| 2424 | (setf (vc-dir-fileinfo->needs-update (ewoc-data node)) nil) | ||
| 2425 | (ewoc-invalidate vc-ewoc node) | ||
| 2426 | (setq entries (cdr entries) entry (car entries)) | ||
| 2427 | (setq node (ewoc-next vc-ewoc node)))))) | ||
| 2428 | (unless (or node noinsert) | ||
| 2429 | ;; We're past the last node, all remaining entries go to the end. | ||
| 2430 | (while entries | ||
| 2431 | (ewoc-enter-last vc-ewoc | ||
| 2432 | (apply 'vc-dir-create-fileinfo (pop entries)))))) | ||
| 2433 | ;; Insert directory entries in the right places. | ||
| 2434 | (let ((entry (car entries)) | ||
| 2435 | (node (ewoc-nth vc-ewoc 0))) | ||
| 2436 | ;; Insert . if it is not present. | ||
| 2437 | (unless node | ||
| 2438 | (let ((rd (file-relative-name default-directory))) | ||
| 2439 | (ewoc-enter-last | ||
| 2440 | vc-ewoc (vc-dir-create-fileinfo | ||
| 2441 | rd nil nil nil (expand-file-name default-directory)))) | ||
| 2442 | (setq node (ewoc-nth vc-ewoc 0))) | ||
| 2443 | |||
| 2444 | (while (and entry node) | ||
| 2445 | (let* ((entryfile (car entry)) | ||
| 2446 | (entrydir (file-name-directory (expand-file-name entryfile))) | ||
| 2447 | (nodedir | ||
| 2448 | (or (vc-dir-fileinfo->directory (ewoc-data node)) | ||
| 2449 | (file-name-directory | ||
| 2450 | (expand-file-name | ||
| 2451 | (vc-dir-fileinfo->name (ewoc-data node))))))) | ||
| 2452 | (cond | ||
| 2453 | ;; First try to find the directory. | ||
| 2454 | ((string-lessp nodedir entrydir) | ||
| 2455 | (setq node (ewoc-next vc-ewoc node))) | ||
| 2456 | ((string-equal nodedir entrydir) | ||
| 2457 | ;; Found the directory, find the place for the file name. | ||
| 2458 | (let ((nodefile (vc-dir-fileinfo->name (ewoc-data node)))) | ||
| 2459 | (cond | ||
| 2460 | ((string-lessp nodefile entryfile) | ||
| 2461 | (setq node (ewoc-next vc-ewoc node))) | ||
| 2462 | ((string-equal nodefile entryfile) | ||
| 2463 | (setf (vc-dir-fileinfo->state (ewoc-data node)) (nth 1 entry)) | ||
| 2464 | (setf (vc-dir-fileinfo->extra (ewoc-data node)) (nth 2 entry)) | ||
| 2465 | (setf (vc-dir-fileinfo->needs-update (ewoc-data node)) nil) | ||
| 2466 | (ewoc-invalidate vc-ewoc node) | ||
| 2467 | (setq entries (cdr entries) entry (car entries)) | ||
| 2468 | (setq node (ewoc-next vc-ewoc node))) | ||
| 2469 | (t | ||
| 2470 | (ewoc-enter-before vc-ewoc node | ||
| 2471 | (apply 'vc-dir-create-fileinfo entry)) | ||
| 2472 | (setq entries (cdr entries) entry (car entries)))))) | ||
| 2473 | (t | ||
| 2474 | ;; We need to insert a directory node | ||
| 2475 | (let ((rd (file-relative-name entrydir))) | ||
| 2476 | (ewoc-enter-last | ||
| 2477 | vc-ewoc (vc-dir-create-fileinfo rd nil nil nil entrydir))) | ||
| 2478 | ;; Now insert the node itself. | ||
| 2479 | (ewoc-enter-before vc-ewoc node | ||
| 2480 | (apply 'vc-dir-create-fileinfo entry)) | ||
| 2481 | (setq entries (cdr entries) entry (car entries)))))) | ||
| 2482 | ;; We're past the last node, all remaining entries go to the end. | ||
| 2483 | (unless (or node noinsert) | ||
| 2484 | (let* ((lastnode (ewoc-nth vc-ewoc -1)) | ||
| 2485 | (lastdir | ||
| 2486 | (or (vc-dir-fileinfo->directory (ewoc-data lastnode)) | ||
| 2487 | (file-name-directory | ||
| 2488 | (expand-file-name | ||
| 2489 | (vc-dir-fileinfo->name (ewoc-data lastnode))))))) | ||
| 2490 | (dolist (entry entries) | ||
| 2491 | (let ((entrydir (file-name-directory (expand-file-name (car entry))))) | ||
| 2492 | ;; Insert a directory node if needed. | ||
| 2493 | (unless (string-equal lastdir entrydir) | ||
| 2494 | (setq lastdir entrydir) | ||
| 2495 | (let ((rd (file-relative-name entrydir))) | ||
| 2496 | (ewoc-enter-last | ||
| 2497 | vc-ewoc (vc-dir-create-fileinfo rd nil nil nil entrydir)))) | ||
| 2498 | ;; Now insert the node itself. | ||
| 2499 | (ewoc-enter-last vc-ewoc | ||
| 2500 | (apply 'vc-dir-create-fileinfo entry)))))))))) | ||
| 2501 | |||
| 2502 | (defun vc-dir-busy () | ||
| 2503 | (and (buffer-live-p vc-dir-process-buffer) | ||
| 2504 | (get-buffer-process vc-dir-process-buffer))) | ||
| 2505 | 2146 | ||
| 2506 | (defun vc-dir-refresh-files (files default-state) | 2147 | (defun vc-dir-refresh-files (files default-state) |
| 2507 | "Refresh some files in the VC status buffer." | 2148 | "Refresh some files in the VC status buffer." |
| @@ -2587,262 +2228,6 @@ Throw an error if another update process is in progress." | |||
| 2587 | 'up-to-date) | 2228 | 'up-to-date) |
| 2588 | (setq mode-line-process nil)))))))))))) | 2229 | (setq mode-line-process nil)))))))))))) |
| 2589 | 2230 | ||
| 2590 | (defun vc-dir-kill-dir-status-process () | ||
| 2591 | "Kill the temporary buffer and associated process." | ||
| 2592 | (interactive) | ||
| 2593 | (when (buffer-live-p vc-dir-process-buffer) | ||
| 2594 | (let ((proc (get-buffer-process vc-dir-process-buffer))) | ||
| 2595 | (when proc (delete-process proc)) | ||
| 2596 | (setq vc-dir-process-buffer nil) | ||
| 2597 | (setq mode-line-process nil)))) | ||
| 2598 | |||
| 2599 | (defun vc-dir-kill-query () | ||
| 2600 | ;; Make sure that when the VC status buffer is killed the update | ||
| 2601 | ;; process running in background is also killed. | ||
| 2602 | (if (vc-dir-busy) | ||
| 2603 | (when (y-or-n-p "Status update process running, really kill status buffer?") | ||
| 2604 | (vc-dir-kill-dir-status-process) | ||
| 2605 | t) | ||
| 2606 | t)) | ||
| 2607 | |||
| 2608 | (defun vc-dir-next-line (arg) | ||
| 2609 | "Go to the next line. | ||
| 2610 | If a prefix argument is given, move by that many lines." | ||
| 2611 | (interactive "p") | ||
| 2612 | (ewoc-goto-next vc-ewoc arg) | ||
| 2613 | (vc-dir-move-to-goal-column)) | ||
| 2614 | |||
| 2615 | (defun vc-dir-previous-line (arg) | ||
| 2616 | "Go to the previous line. | ||
| 2617 | If a prefix argument is given, move by that many lines." | ||
| 2618 | (interactive "p") | ||
| 2619 | (ewoc-goto-prev vc-ewoc arg) | ||
| 2620 | (vc-dir-move-to-goal-column)) | ||
| 2621 | |||
| 2622 | (defun vc-dir-mark-unmark (mark-unmark-function) | ||
| 2623 | (if (use-region-p) | ||
| 2624 | (let ((firstl (line-number-at-pos (region-beginning))) | ||
| 2625 | (lastl (line-number-at-pos (region-end)))) | ||
| 2626 | (save-excursion | ||
| 2627 | (goto-char (region-beginning)) | ||
| 2628 | (while (<= (line-number-at-pos) lastl) | ||
| 2629 | (funcall mark-unmark-function)))) | ||
| 2630 | (funcall mark-unmark-function))) | ||
| 2631 | |||
| 2632 | (defun vc-dir-parent-marked-p (arg) | ||
| 2633 | (when vc-dir-insert-directories | ||
| 2634 | ;; Return nil if none of the parent directories of arg is marked. | ||
| 2635 | (let* ((argdata (ewoc-data arg)) | ||
| 2636 | (argdir | ||
| 2637 | (let ((crtdir (vc-dir-fileinfo->directory argdata))) | ||
| 2638 | (if crtdir | ||
| 2639 | crtdir | ||
| 2640 | (file-name-directory (expand-file-name | ||
| 2641 | (vc-dir-fileinfo->name argdata)))))) | ||
| 2642 | (arglen (length argdir)) | ||
| 2643 | (crt arg) | ||
| 2644 | data dir) | ||
| 2645 | ;; Go through the predecessors, checking if any directory that is | ||
| 2646 | ;; a parent is marked. | ||
| 2647 | (while (setq crt (ewoc-prev vc-ewoc crt)) | ||
| 2648 | (setq data (ewoc-data crt)) | ||
| 2649 | (setq dir | ||
| 2650 | (let ((crtdir (vc-dir-fileinfo->directory data))) | ||
| 2651 | (if crtdir | ||
| 2652 | crtdir | ||
| 2653 | (file-name-directory (expand-file-name | ||
| 2654 | (vc-dir-fileinfo->name data)))))) | ||
| 2655 | |||
| 2656 | (when (and (vc-dir-fileinfo->directory data) | ||
| 2657 | (string-equal (substring argdir 0 (length dir)) dir)) | ||
| 2658 | (when (vc-dir-fileinfo->marked data) | ||
| 2659 | (error "Cannot mark `%s', parent directory `%s' marked" | ||
| 2660 | (vc-dir-fileinfo->name argdata) | ||
| 2661 | (vc-dir-fileinfo->name data))))) | ||
| 2662 | nil))) | ||
| 2663 | |||
| 2664 | (defun vc-dir-children-marked-p (arg) | ||
| 2665 | ;; Return nil if none of the children of arg is marked. | ||
| 2666 | (when vc-dir-insert-directories | ||
| 2667 | (let* ((argdata (ewoc-data arg)) | ||
| 2668 | (argdir (vc-dir-fileinfo->directory argdata)) | ||
| 2669 | (arglen (length argdir)) | ||
| 2670 | (is-child t) | ||
| 2671 | (crt arg) | ||
| 2672 | data dir) | ||
| 2673 | (while (and is-child (setq crt (ewoc-next vc-ewoc crt))) | ||
| 2674 | (setq data (ewoc-data crt)) | ||
| 2675 | (setq dir | ||
| 2676 | (let ((crtdir (vc-dir-fileinfo->directory data))) | ||
| 2677 | (if crtdir | ||
| 2678 | crtdir | ||
| 2679 | (file-name-directory (expand-file-name | ||
| 2680 | (vc-dir-fileinfo->name data)))))) | ||
| 2681 | (if (string-equal argdir (substring dir 0 arglen)) | ||
| 2682 | (when (vc-dir-fileinfo->marked data) | ||
| 2683 | (error "Cannot mark `%s', child `%s' marked" | ||
| 2684 | (vc-dir-fileinfo->name argdata) | ||
| 2685 | (vc-dir-fileinfo->name data))) | ||
| 2686 | ;; We are done, we got to an entry that is not a child of `arg'. | ||
| 2687 | (setq is-child nil))) | ||
| 2688 | nil))) | ||
| 2689 | |||
| 2690 | (defun vc-dir-mark-file (&optional arg) | ||
| 2691 | ;; Mark ARG or the current file and move to the next line. | ||
| 2692 | (let* ((crt (or arg (ewoc-locate vc-ewoc))) | ||
| 2693 | (file (ewoc-data crt)) | ||
| 2694 | (isdir (vc-dir-fileinfo->directory file))) | ||
| 2695 | (when (or (and isdir (not (vc-dir-children-marked-p crt))) | ||
| 2696 | (and (not isdir) (not (vc-dir-parent-marked-p crt)))) | ||
| 2697 | (setf (vc-dir-fileinfo->marked file) t) | ||
| 2698 | (ewoc-invalidate vc-ewoc crt) | ||
| 2699 | (unless (or arg (mouse-event-p last-command-event)) | ||
| 2700 | (vc-dir-next-line 1))))) | ||
| 2701 | |||
| 2702 | (defun vc-dir-mark () | ||
| 2703 | "Mark the current file or all files in the region. | ||
| 2704 | If the region is active, mark all the files in the region. | ||
| 2705 | Otherwise mark the file on the current line and move to the next | ||
| 2706 | line." | ||
| 2707 | (interactive) | ||
| 2708 | (vc-dir-mark-unmark 'vc-dir-mark-file)) | ||
| 2709 | |||
| 2710 | (defun vc-dir-mark-all-files (arg) | ||
| 2711 | "Mark all files with the same state as the current one. | ||
| 2712 | With a prefix argument mark all files. | ||
| 2713 | If the current entry is a directory, mark all child files. | ||
| 2714 | |||
| 2715 | The VC commands operate on files that are on the same state. | ||
| 2716 | This command is intended to make it easy to select all files that | ||
| 2717 | share the same state." | ||
| 2718 | (interactive "P") | ||
| 2719 | (if arg | ||
| 2720 | ;; Mark all files. | ||
| 2721 | (progn | ||
| 2722 | ;; First check that no directory is marked, we can't mark | ||
| 2723 | ;; files in that case. | ||
| 2724 | (ewoc-map | ||
| 2725 | (lambda (filearg) | ||
| 2726 | (when (and (vc-dir-fileinfo->directory filearg) | ||
| 2727 | (vc-dir-fileinfo->directory filearg)) | ||
| 2728 | (error "Cannot mark all files, directory `%s' marked" | ||
| 2729 | (vc-dir-fileinfo->name filearg)))) | ||
| 2730 | vc-ewoc) | ||
| 2731 | (ewoc-map | ||
| 2732 | (lambda (filearg) | ||
| 2733 | (unless (vc-dir-fileinfo->marked filearg) | ||
| 2734 | (setf (vc-dir-fileinfo->marked filearg) t) | ||
| 2735 | t)) | ||
| 2736 | vc-ewoc)) | ||
| 2737 | (let ((data (ewoc-data (ewoc-locate vc-ewoc)))) | ||
| 2738 | (if (vc-dir-fileinfo->directory data) | ||
| 2739 | ;; It's a directory, mark child files. | ||
| 2740 | (let ((crt (ewoc-locate vc-ewoc))) | ||
| 2741 | (unless (vc-dir-children-marked-p crt) | ||
| 2742 | (while (setq crt (ewoc-next vc-ewoc crt)) | ||
| 2743 | (let ((crt-data (ewoc-data crt))) | ||
| 2744 | (unless (vc-dir-fileinfo->directory crt-data) | ||
| 2745 | (setf (vc-dir-fileinfo->marked crt-data) t) | ||
| 2746 | (ewoc-invalidate vc-ewoc crt)))))) | ||
| 2747 | ;; It's a file | ||
| 2748 | (let ((state (vc-dir-fileinfo->state data)) | ||
| 2749 | (crt (ewoc-nth vc-ewoc 0))) | ||
| 2750 | (while crt | ||
| 2751 | (let ((crt-data (ewoc-data crt))) | ||
| 2752 | (when (and (not (vc-dir-fileinfo->marked crt-data)) | ||
| 2753 | (eq (vc-dir-fileinfo->state crt-data) state) | ||
| 2754 | (not (vc-dir-fileinfo->directory crt-data))) | ||
| 2755 | (vc-dir-mark-file crt))) | ||
| 2756 | (setq crt (ewoc-next vc-ewoc crt)))))))) | ||
| 2757 | |||
| 2758 | (defun vc-dir-unmark-file () | ||
| 2759 | ;; Unmark the current file and move to the next line. | ||
| 2760 | (let* ((crt (ewoc-locate vc-ewoc)) | ||
| 2761 | (file (ewoc-data crt))) | ||
| 2762 | (setf (vc-dir-fileinfo->marked file) nil) | ||
| 2763 | (ewoc-invalidate vc-ewoc crt) | ||
| 2764 | (unless (mouse-event-p last-command-event) | ||
| 2765 | (vc-dir-next-line 1)))) | ||
| 2766 | |||
| 2767 | (defun vc-dir-unmark () | ||
| 2768 | "Unmark the current file or all files in the region. | ||
| 2769 | If the region is active, unmark all the files in the region. | ||
| 2770 | Otherwise mark the file on the current line and move to the next | ||
| 2771 | line." | ||
| 2772 | (interactive) | ||
| 2773 | (vc-dir-mark-unmark 'vc-dir-unmark-file)) | ||
| 2774 | |||
| 2775 | (defun vc-dir-unmark-file-up () | ||
| 2776 | "Move to the previous line and unmark the file." | ||
| 2777 | (interactive) | ||
| 2778 | ;; If we're on the first line, we won't move up, but we will still | ||
| 2779 | ;; remove the mark. This seems a bit odd but it is what buffer-menu | ||
| 2780 | ;; does. | ||
| 2781 | (let* ((prev (ewoc-goto-prev vc-ewoc 1)) | ||
| 2782 | (file (ewoc-data prev))) | ||
| 2783 | (setf (vc-dir-fileinfo->marked file) nil) | ||
| 2784 | (ewoc-invalidate vc-ewoc prev) | ||
| 2785 | (vc-dir-move-to-goal-column))) | ||
| 2786 | |||
| 2787 | (defun vc-dir-unmark-all-files (arg) | ||
| 2788 | "Unmark all files with the same state as the current one. | ||
| 2789 | With a prefix argument unmark all files. | ||
| 2790 | If the current entry is a directory, unmark all the child files. | ||
| 2791 | |||
| 2792 | The VC commands operate on files that are on the same state. | ||
| 2793 | This command is intended to make it easy to deselect all files | ||
| 2794 | that share the same state." | ||
| 2795 | (interactive "P") | ||
| 2796 | (if arg | ||
| 2797 | (ewoc-map | ||
| 2798 | (lambda (filearg) | ||
| 2799 | (when (vc-dir-fileinfo->marked filearg) | ||
| 2800 | (setf (vc-dir-fileinfo->marked filearg) nil) | ||
| 2801 | t)) | ||
| 2802 | vc-ewoc) | ||
| 2803 | (let* ((crt (ewoc-locate vc-ewoc)) | ||
| 2804 | (data (ewoc-data crt))) | ||
| 2805 | (if (vc-dir-fileinfo->directory data) | ||
| 2806 | ;; It's a directory, unmark child files. | ||
| 2807 | (while (setq crt (ewoc-next vc-ewoc crt)) | ||
| 2808 | (let ((crt-data (ewoc-data crt))) | ||
| 2809 | (unless (vc-dir-fileinfo->directory crt-data) | ||
| 2810 | (setf (vc-dir-fileinfo->marked crt-data) nil) | ||
| 2811 | (ewoc-invalidate vc-ewoc crt)))) | ||
| 2812 | ;; It's a file | ||
| 2813 | (let ((crt-state (vc-dir-fileinfo->state (ewoc-data crt)))) | ||
| 2814 | (ewoc-map | ||
| 2815 | (lambda (filearg) | ||
| 2816 | (when (and (vc-dir-fileinfo->marked filearg) | ||
| 2817 | (eq (vc-dir-fileinfo->state filearg) crt-state)) | ||
| 2818 | (setf (vc-dir-fileinfo->marked filearg) nil) | ||
| 2819 | t)) | ||
| 2820 | vc-ewoc)))))) | ||
| 2821 | |||
| 2822 | (defun vc-dir-toggle-mark-file () | ||
| 2823 | (let* ((crt (ewoc-locate vc-ewoc)) | ||
| 2824 | (file (ewoc-data crt))) | ||
| 2825 | (if (vc-dir-fileinfo->marked file) | ||
| 2826 | (vc-dir-unmark-file) | ||
| 2827 | (vc-dir-mark-file)))) | ||
| 2828 | |||
| 2829 | (defun vc-dir-toggle-mark (e) | ||
| 2830 | (interactive "e") | ||
| 2831 | (vc-at-event e (vc-dir-mark-unmark 'vc-dir-toggle-mark-file))) | ||
| 2832 | |||
| 2833 | (defun vc-dir-register () | ||
| 2834 | "Register the marked files, or the current file if no marks." | ||
| 2835 | (interactive) | ||
| 2836 | ;; FIXME: Just pass the fileset to vc-register. | ||
| 2837 | (mapc (lambda (arg) (vc-register nil arg)) | ||
| 2838 | (or (vc-dir-marked-files) (list (vc-dir-current-file))))) | ||
| 2839 | |||
| 2840 | (defun vc-dir-delete-file () | ||
| 2841 | "Delete the marked files, or the current file if no marks." | ||
| 2842 | (interactive) | ||
| 2843 | (mapc 'vc-delete-file (or (vc-dir-marked-files) | ||
| 2844 | (list (vc-dir-current-file))))) | ||
| 2845 | |||
| 2846 | (defun vc-dir-show-fileentry (file) | 2231 | (defun vc-dir-show-fileentry (file) |
| 2847 | "Insert an entry for a specific file into the current VC status listing. | 2232 | "Insert an entry for a specific file into the current VC status listing. |
| 2848 | This is typically used if the file is up-to-date (or has been added | 2233 | This is typically used if the file is up-to-date (or has been added |
| @@ -2850,61 +2235,6 @@ outside of VC) and one wants to do some operation on it." | |||
| 2850 | (interactive "fShow file: ") | 2235 | (interactive "fShow file: ") |
| 2851 | (vc-dir-update (list (list (file-relative-name file) (vc-state file))) (current-buffer))) | 2236 | (vc-dir-update (list (list (file-relative-name file) (vc-state file))) (current-buffer))) |
| 2852 | 2237 | ||
| 2853 | (defun vc-dir-find-file () | ||
| 2854 | "Find the file on the current line." | ||
| 2855 | (interactive) | ||
| 2856 | (find-file (vc-dir-current-file))) | ||
| 2857 | |||
| 2858 | (defun vc-dir-find-file-other-window () | ||
| 2859 | "Find the file on the current line, in another window." | ||
| 2860 | (interactive) | ||
| 2861 | (find-file-other-window (vc-dir-current-file))) | ||
| 2862 | |||
| 2863 | (defun vc-dir-current-file () | ||
| 2864 | (let ((node (ewoc-locate vc-ewoc))) | ||
| 2865 | (unless node | ||
| 2866 | (error "No file available.")) | ||
| 2867 | (expand-file-name (vc-dir-fileinfo->name (ewoc-data node))))) | ||
| 2868 | |||
| 2869 | (defun vc-dir-marked-files () | ||
| 2870 | "Return the list of marked files." | ||
| 2871 | (mapcar | ||
| 2872 | (lambda (elem) (expand-file-name (vc-dir-fileinfo->name elem))) | ||
| 2873 | (ewoc-collect vc-ewoc 'vc-dir-fileinfo->marked))) | ||
| 2874 | |||
| 2875 | (defun vc-dir-marked-only-files () | ||
| 2876 | "Return the list of marked files, for marked directories, return child files." | ||
| 2877 | |||
| 2878 | (let ((crt (ewoc-nth vc-ewoc 0)) | ||
| 2879 | result) | ||
| 2880 | (while crt | ||
| 2881 | (let ((crt-data (ewoc-data crt))) | ||
| 2882 | (if (vc-dir-fileinfo->marked crt-data) | ||
| 2883 | (if (vc-dir-fileinfo->directory crt-data) | ||
| 2884 | (let* ((dir (vc-dir-fileinfo->directory crt-data)) | ||
| 2885 | (dirlen (length dir)) | ||
| 2886 | data) | ||
| 2887 | (while | ||
| 2888 | (and (setq crt (ewoc-next vc-ewoc crt)) | ||
| 2889 | (string-equal | ||
| 2890 | (substring | ||
| 2891 | (progn | ||
| 2892 | (setq data (ewoc-data crt)) | ||
| 2893 | (let ((crtdir (vc-dir-fileinfo->directory data))) | ||
| 2894 | (if crtdir | ||
| 2895 | crtdir | ||
| 2896 | (file-name-directory | ||
| 2897 | (expand-file-name | ||
| 2898 | (vc-dir-fileinfo->name data)))))) | ||
| 2899 | 0 dirlen) | ||
| 2900 | dir)) | ||
| 2901 | (unless (vc-dir-fileinfo->directory data) | ||
| 2902 | (push (vc-dir-fileinfo->name data) result)))) | ||
| 2903 | (push (expand-file-name (vc-dir-fileinfo->name crt-data)) result) | ||
| 2904 | (setq crt (ewoc-next vc-ewoc crt))) | ||
| 2905 | (setq crt (ewoc-next vc-ewoc crt))))) | ||
| 2906 | result)) | ||
| 2907 | |||
| 2908 | (defun vc-dir-hide-up-to-date () | 2238 | (defun vc-dir-hide-up-to-date () |
| 2909 | "Hide up-to-date items from display." | 2239 | "Hide up-to-date items from display." |
| 2910 | (interactive) | 2240 | (interactive) |
| @@ -2912,6 +2242,13 @@ outside of VC) and one wants to do some operation on it." | |||
| 2912 | vc-ewoc | 2242 | vc-ewoc |
| 2913 | (lambda (crt) (not (eq (vc-dir-fileinfo->state crt) 'up-to-date))))) | 2243 | (lambda (crt) (not (eq (vc-dir-fileinfo->state crt) 'up-to-date))))) |
| 2914 | 2244 | ||
| 2245 | (defun vc-dir-register () | ||
| 2246 | "Register the marked files, or the current file if no marks." | ||
| 2247 | (interactive) | ||
| 2248 | ;; FIXME: Just pass the fileset to vc-register. | ||
| 2249 | (mapc (lambda (arg) (vc-register nil arg)) | ||
| 2250 | (or (vc-dir-marked-files) (list (vc-dir-current-file))))) | ||
| 2251 | |||
| 2915 | (defun vc-default-status-fileinfo-extra (backend file) | 2252 | (defun vc-default-status-fileinfo-extra (backend file) |
| 2916 | nil) | 2253 | nil) |
| 2917 | 2254 | ||