aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorEric S. Raymond2008-05-03 11:46:05 +0000
committerEric S. Raymond2008-05-03 11:46:05 +0000
commit783b505b7bd8f28bdf73e8c34ae22e809cfe64db (patch)
treeb1c3c6968987362fb34dcb2ee44eb93115b7cd8b
parentdab955e836add3ce0ef2e974a28d9e554de23c4a (diff)
downloademacs-783b505b7bd8f28bdf73e8c34ae22e809cfe64db.tar.gz
emacs-783b505b7bd8f28bdf73e8c34ae22e809cfe64db.zip
Moved most of vc-dir from vc.el to vc-dispatcher.el.
-rw-r--r--lisp/vc-dispatcher.el675
-rw-r--r--lisp/vc.el721
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'.
831See `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'.
1023If `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.
1070If 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.
1207If 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.
1214If 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.
1301If the region is active, mark all the files in the region.
1302Otherwise mark the file on the current line and move to the next
1303line."
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.
1309With a prefix argument mark all files.
1310If the current entry is a directory, mark all child files.
1311
1312The VC commands operate on files that are on the same state.
1313This command is intended to make it easy to select all files that
1314share 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.
1366If the region is active, unmark all the files in the region.
1367Otherwise mark the file on the current line and move to the next
1368line."
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.
1386With a prefix argument unmark all files.
1387If the current entry is a directory, unmark all the child files.
1388
1389The VC commands operate on files that are on the same state.
1390This command is intended to make it easy to deselect all files
1391that 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'.
823See `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'.
2296If `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.
2340Marking/Unmarking key bindings and actions: 2083Marking/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)))
2389If 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.
2610If 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.
2617If 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.
2704If the region is active, mark all the files in the region.
2705Otherwise mark the file on the current line and move to the next
2706line."
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.
2712With a prefix argument mark all files.
2713If the current entry is a directory, mark all child files.
2714
2715The VC commands operate on files that are on the same state.
2716This command is intended to make it easy to select all files that
2717share 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.
2769If the region is active, unmark all the files in the region.
2770Otherwise mark the file on the current line and move to the next
2771line."
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.
2789With a prefix argument unmark all files.
2790If the current entry is a directory, unmark all the child files.
2791
2792The VC commands operate on files that are on the same state.
2793This command is intended to make it easy to deselect all files
2794that 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.
2848This is typically used if the file is up-to-date (or has been added 2233This 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