Mercurial > emacs
comparison lisp/vc-dispatcher.el @ 94584:f6d320d12050
Moved most of vc-dir from vc.el to vc-dispatcher.el.
author | Eric S. Raymond <esr@snark.thyrsus.com> |
---|---|
date | Sat, 03 May 2008 11:46:05 +0000 |
parents | 8393f040d26d |
children | 16008b90ad8c |
comparison
equal
deleted
inserted
replaced
94583:72db09a22236 | 94584:f6d320d12050 |
---|---|
599 (dired-move-to-filename)) | 599 (dired-move-to-filename)) |
600 (when (eq major-mode 'vc-dir-mode) | 600 (when (eq major-mode 'vc-dir-mode) |
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." |
608 :type 'string | 609 :type 'string |
609 :group 'vc | 610 :group 'vc |
621 :group 'vc | 622 :group 'vc |
622 :version "20.3") | 623 :version "20.3") |
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) |
629 | |
630 (make-variable-buffer-local 'vc-dired-mode) | |
634 | 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))) |
638 (define-key map "\C-xv" vmap) | 635 (define-key map "\C-xv" vmap) |
825 (switch-to-buffer | 822 (switch-to-buffer |
826 (dired-internal-noselect (expand-file-name (file-name-as-directory dir)) | 823 (dired-internal-noselect (expand-file-name (file-name-as-directory dir)) |
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 |