Mercurial > emacs

comparison lisp/vc-dispatcher.el @ 95320:51b445e6b312

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(vc-dir-child-files): New function. (vc-dir-node-directory): New function. (vc-dir-update, vc-dir-parent-marked-p) (vc-dir-children-marked-p, vc-dir-mark-all-files) (vc-dir-marked-only-files, vc-dispatcher-selection-set): Use it.
author Dan Nicolaescu <dann@ics.uci.edu>
date Mon, 26 May 2008 23:49:35 +0000
parents 685f73a291fb
children 3bf215f97a31
comparison
equal deleted inserted replaced
95319:d76d74f405b8 95320:51b445e6b312
697 ;; in the mode-line. 697 ;; in the mode-line.
698 (setq vc-parent-buffer-name nil) 698 (setq vc-parent-buffer-name nil)
699 (current-buffer))))) 699 (current-buffer)))))
700 700
701 (defvar vc-dir-menu-map 701 (defvar vc-dir-menu-map
702 (let ((map (make-sparse-keymap))) 702 (let ((map (make-sparse-keymap "VC-dir")))
703 (define-key map [quit] 703 (define-key map [quit]
704 '(menu-item "Quit" quit-window 704 '(menu-item "Quit" quit-window
705 :help "Quit")) 705 :help "Quit"))
706 (define-key map [kill] 706 (define-key map [kill]
707 '(menu-item "Kill Update Command" vc-dir-kill-dir-status-process 707 '(menu-item "Kill Update Command" vc-dir-kill-dir-status-process
798 ;; Hook up the menu. 798 ;; Hook up the menu.
799 (define-key map [menu-bar vc-dir-mode] 799 (define-key map [menu-bar vc-dir-mode]
800 `(menu-item 800 `(menu-item
801 ;; This is used so that client modes can add mode-specific 801 ;; This is used so that client modes can add mode-specific
802 ;; menu items to vc-dir-menu-map. 802 ;; menu items to vc-dir-menu-map.
803 "*vc-dispatcher*" ,vc-dir-menu-map :filter vc-dir-menu-map-filter)) 803 "VC-dir" ,vc-dir-menu-map :filter vc-dir-menu-map-filter))
804 map) 804 map)
805 "Keymap for directory buffer.") 805 "Keymap for directory buffer.")
806 806
807 (defmacro vc-at-event (event &rest body) 807 (defmacro vc-at-event (event &rest body)
808 "Evaluate `body' with point located at event-start of `event'. 808 "Evaluate `body' with point located at event-start of `event'.
842 (tool-bar-local-item-from-menu 'vc-dir-kill-dir-status-process "cancel" 842 (tool-bar-local-item-from-menu 'vc-dir-kill-dir-status-process "cancel"
843 map vc-dir-mode-map) 843 map vc-dir-mode-map)
844 (tool-bar-local-item-from-menu 'quit-window "exit" 844 (tool-bar-local-item-from-menu 'quit-window "exit"
845 map vc-dir-mode-map) 845 map vc-dir-mode-map)
846 map)) 846 map))
847
848 (defun vc-dir-node-directory (node)
849 ;; Compute the directory for NODE.
850 ;; If it's a directory node, get it from the the node.
851 (let ((data (ewoc-data node)))
852 (or (vc-dir-fileinfo->directory data)
853 ;; Otherwise compute it from the file name.
854 (file-name-directory
855 (expand-file-name
856 (vc-dir-fileinfo->name data))))))
847 857
848 (defun vc-dir-update (entries buffer &optional noinsert) 858 (defun vc-dir-update (entries buffer &optional noinsert)
849 "Update BUFFER's ewoc from the list of ENTRIES. 859 "Update BUFFER's ewoc from the list of ENTRIES.
850 If NOINSERT, ignore elements on ENTRIES which are not in the ewoc." 860 If NOINSERT, ignore elements on ENTRIES which are not in the ewoc."
851 ;; Add ENTRIES to the vc-dir buffer BUFFER. 861 ;; Add ENTRIES to the vc-dir buffer BUFFER.
873 (let ((rd (file-relative-name default-directory))) 883 (let ((rd (file-relative-name default-directory)))
874 (ewoc-enter-last 884 (ewoc-enter-last
875 vc-ewoc (vc-dir-create-fileinfo 885 vc-ewoc (vc-dir-create-fileinfo
876 rd nil nil nil (expand-file-name default-directory)))) 886 rd nil nil nil (expand-file-name default-directory))))
877 (setq node (ewoc-nth vc-ewoc 0))) 887 (setq node (ewoc-nth vc-ewoc 0)))
878 888
879 (while (and entry node) 889 (while (and entry node)
880 (let* ((entryfile (car entry)) 890 (let* ((entryfile (car entry))
881 (entrydir (file-name-directory (expand-file-name entryfile))) 891 (entrydir (file-name-directory (expand-file-name entryfile)))
882 (nodedir 892 (nodedir (vc-dir-node-directory node)))
883 (or (vc-dir-fileinfo->directory (ewoc-data node))
884 (file-name-directory
885 (expand-file-name
886 (vc-dir-fileinfo->name (ewoc-data node)))))))
887 (cond 893 (cond
888 ;; First try to find the directory. 894 ;; First try to find the directory.
889 ((string-lessp nodedir entrydir) 895 ((string-lessp nodedir entrydir)
890 (setq node (ewoc-next vc-ewoc node))) 896 (setq node (ewoc-next vc-ewoc node)))
891 ((string-equal nodedir entrydir) 897 ((string-equal nodedir entrydir)
897 ((string-equal nodefile entryfile) 903 ((string-equal nodefile entryfile)
898 (setf (vc-dir-fileinfo->state (ewoc-data node)) (nth 1 entry)) 904 (setf (vc-dir-fileinfo->state (ewoc-data node)) (nth 1 entry))
899 (setf (vc-dir-fileinfo->extra (ewoc-data node)) (nth 2 entry)) 905 (setf (vc-dir-fileinfo->extra (ewoc-data node)) (nth 2 entry))
900 (setf (vc-dir-fileinfo->needs-update (ewoc-data node)) nil) 906 (setf (vc-dir-fileinfo->needs-update (ewoc-data node)) nil)
901 (ewoc-invalidate vc-ewoc node) 907 (ewoc-invalidate vc-ewoc node)
902 (setq entries (cdr entries) entry (car entries)) 908 (setq entries (cdr entries))
909 (setq entry (car entries))
903 (setq node (ewoc-next vc-ewoc node))) 910 (setq node (ewoc-next vc-ewoc node)))
904 (t 911 (t
905 (ewoc-enter-before vc-ewoc node 912 (ewoc-enter-before vc-ewoc node
906 (apply 'vc-dir-create-fileinfo entry)) 913 (apply 'vc-dir-create-fileinfo entry))
907 (setq entries (cdr entries) entry (car entries)))))) 914 (setq entries (cdr entries))
915 (setq entry (car entries))))))
908 (t 916 (t
909 ;; We need to insert a directory node 917 ;; We might need to insert a directory node if the
910 (let ((rd (file-relative-name entrydir))) 918 ;; previous node was in a different directory.
911 (ewoc-enter-last 919 (let* ((rd (file-relative-name entrydir))
912 vc-ewoc (vc-dir-create-fileinfo rd nil nil nil entrydir))) 920 (prev-node (ewoc-prev vc-ewoc node))
921 (prev-dir (vc-dir-node-directory prev-node)))
922 (unless (string-equal entrydir prev-dir)
923 (ewoc-enter-before
924 vc-ewoc node (vc-dir-create-fileinfo rd nil nil nil entrydir))))
913 ;; Now insert the node itself. 925 ;; Now insert the node itself.
914 (ewoc-enter-before vc-ewoc node 926 (ewoc-enter-before vc-ewoc node
915 (apply 'vc-dir-create-fileinfo entry)) 927 (apply 'vc-dir-create-fileinfo entry))
916 (setq entries (cdr entries) entry (car entries)))))) 928 (setq entries (cdr entries) entry (car entries))))))
917 ;; We're past the last node, all remaining entries go to the end. 929 ;; We're past the last node, all remaining entries go to the end.
918 (unless (or node noinsert) 930 (unless (or node noinsert)
919 (let* ((lastnode (ewoc-nth vc-ewoc -1)) 931 (let ((lastdir (vc-dir-node-directory (ewoc-nth vc-ewoc -1))))
920 (lastdir
921 (or (vc-dir-fileinfo->directory (ewoc-data lastnode))
922 (file-name-directory
923 (expand-file-name
924 (vc-dir-fileinfo->name (ewoc-data lastnode)))))))
925 (dolist (entry entries) 932 (dolist (entry entries)
926 (let ((entrydir (file-name-directory (expand-file-name (car entry))))) 933 (let ((entrydir (file-name-directory (expand-file-name (car entry)))))
927 ;; Insert a directory node if needed. 934 ;; Insert a directory node if needed.
928 (unless (string-equal lastdir entrydir) 935 (unless (string-equal lastdir entrydir)
929 (setq lastdir entrydir) 936 (setq lastdir entrydir)
1017 (funcall mark-unmark-function)))) 1024 (funcall mark-unmark-function))))
1018 (funcall mark-unmark-function))) 1025 (funcall mark-unmark-function)))
1019 1026
1020 (defun vc-dir-parent-marked-p (arg) 1027 (defun vc-dir-parent-marked-p (arg)
1021 ;; Return nil if none of the parent directories of arg is marked. 1028 ;; Return nil if none of the parent directories of arg is marked.
1022 (let* ((argdata (ewoc-data arg)) 1029 (let* ((argdir (vc-dir-node-directory arg))
1023 (argdir
1024 (let ((crtdir (vc-dir-fileinfo->directory argdata)))
1025 (if crtdir
1026 crtdir
1027 (file-name-directory (expand-file-name
1028 (vc-dir-fileinfo->name argdata))))))
1029 (arglen (length argdir)) 1030 (arglen (length argdir))
1030 (crt arg) 1031 (crt arg)
1031 data dir) 1032 data dir)
1032 ;; Go through the predecessors, checking if any directory that is 1033 ;; Go through the predecessors, checking if any directory that is
1033 ;; a parent is marked. 1034 ;; a parent is marked.
1034 (while (setq crt (ewoc-prev vc-ewoc crt)) 1035 (while (setq crt (ewoc-prev vc-ewoc crt))
1035 (setq data (ewoc-data crt)) 1036 (setq data (ewoc-data crt))
1036 (setq dir 1037 (setq dir (vc-dir-node-directory crt))
1037 (let ((crtdir (vc-dir-fileinfo->directory data)))
1038 (if crtdir
1039 crtdir
1040 (file-name-directory (expand-file-name
1041 (vc-dir-fileinfo->name data))))))
1042
1043 (when (and (vc-dir-fileinfo->directory data) 1038 (when (and (vc-dir-fileinfo->directory data)
1044 (string-equal (substring argdir 0 (length dir)) dir)) 1039 (string-equal (substring argdir 0 (length dir)) dir))
1045 (when (vc-dir-fileinfo->marked data) 1040 (when (vc-dir-fileinfo->marked data)
1046 (error "Cannot mark `%s', parent directory `%s' marked" 1041 (error "Cannot mark `%s', parent directory `%s' marked"
1047 (vc-dir-fileinfo->name argdata) 1042 (vc-dir-fileinfo->name (ewoc-data arg))
1048 (vc-dir-fileinfo->name data))))) 1043 (vc-dir-fileinfo->name data)))))
1049 nil)) 1044 nil))
1050 1045
1051 (defun vc-dir-children-marked-p (arg) 1046 (defun vc-dir-children-marked-p (arg)
1052 ;; Return nil if none of the children of arg is marked. 1047 ;; Return nil if none of the children of arg is marked.
1053 (let* ((argdata (ewoc-data arg)) 1048 (let* ((argdir (vc-dir-node-directory arg))
1054 (argdir (vc-dir-fileinfo->directory argdata))
1055 (arglen (length argdir)) 1049 (arglen (length argdir))
1056 (is-child t) 1050 (is-child t)
1057 (crt arg) 1051 (crt arg)
1058 data dir) 1052 data dir)
1059 (while (and is-child (setq crt (ewoc-next vc-ewoc crt))) 1053 (while (and is-child (setq crt (ewoc-next vc-ewoc crt)))
1060 (setq data (ewoc-data crt)) 1054 (setq data (ewoc-data crt))
1061 (setq dir 1055 (setq dir (vc-dir-node-directory crt))
1062 (let ((crtdir (vc-dir-fileinfo->directory data)))
1063 (if crtdir
1064 crtdir
1065 (file-name-directory (expand-file-name
1066 (vc-dir-fileinfo->name data))))))
1067 (if (string-equal argdir (substring dir 0 arglen)) 1056 (if (string-equal argdir (substring dir 0 arglen))
1068 (when (vc-dir-fileinfo->marked data) 1057 (when (vc-dir-fileinfo->marked data)
1069 (error "Cannot mark `%s', child `%s' marked" 1058 (error "Cannot mark `%s', child `%s' marked"
1070 (vc-dir-fileinfo->name argdata) 1059 (vc-dir-fileinfo->name (ewoc-data arg))
1071 (vc-dir-fileinfo->name data))) 1060 (vc-dir-fileinfo->name data)))
1072 ;; We are done, we got to an entry that is not a child of `arg'. 1061 ;; We are done, we got to an entry that is not a child of `arg'.
1073 (setq is-child nil))) 1062 (setq is-child nil)))
1074 nil)) 1063 nil))
1075 1064
1108 ;; First check that no directory is marked, we can't mark 1097 ;; First check that no directory is marked, we can't mark
1109 ;; files in that case. 1098 ;; files in that case.
1110 (ewoc-map 1099 (ewoc-map
1111 (lambda (filearg) 1100 (lambda (filearg)
1112 (when (and (vc-dir-fileinfo->directory filearg) 1101 (when (and (vc-dir-fileinfo->directory filearg)
1113 (vc-dir-fileinfo->directory filearg)) 1102 (vc-dir-fileinfo->marked filearg))
1114 (error "Cannot mark all files, directory `%s' marked" 1103 (error "Cannot mark all files, directory `%s' marked"
1115 (vc-dir-fileinfo->name filearg)))) 1104 (vc-dir-fileinfo->name filearg))))
1116 vc-ewoc) 1105 vc-ewoc)
1117 (ewoc-map 1106 (ewoc-map
1118 (lambda (filearg) 1107 (lambda (filearg)
1243 (mapcar 1232 (mapcar
1244 (lambda (elem) (expand-file-name (vc-dir-fileinfo->name elem))) 1233 (lambda (elem) (expand-file-name (vc-dir-fileinfo->name elem)))
1245 (ewoc-collect vc-ewoc 'vc-dir-fileinfo->marked))) 1234 (ewoc-collect vc-ewoc 'vc-dir-fileinfo->marked)))
1246 1235
1247 (defun vc-dir-marked-only-files () 1236 (defun vc-dir-marked-only-files ()
1248 "Return the list of marked files, For marked directories return child files." 1237 "Return the list of marked files, for marked directories return child files."
1249 (let ((crt (ewoc-nth vc-ewoc 0)) 1238 (let ((crt (ewoc-nth vc-ewoc 0))
1250 result) 1239 result)
1251 (while crt 1240 (while crt
1252 (let ((crt-data (ewoc-data crt))) 1241 (let ((crt-data (ewoc-data crt)))
1253 (if (vc-dir-fileinfo->marked crt-data) 1242 (if (vc-dir-fileinfo->marked crt-data)
1243 ;; FIXME: use vc-dir-child-files here instead of duplicating it.
1254 (if (vc-dir-fileinfo->directory crt-data) 1244 (if (vc-dir-fileinfo->directory crt-data)
1255 (let* ((dir (vc-dir-fileinfo->directory crt-data)) 1245 (let* ((dir (vc-dir-fileinfo->directory crt-data))
1256 (dirlen (length dir)) 1246 (dirlen (length dir))
1257 data) 1247 data)
1258 (while 1248 (while
1259 (and (setq crt (ewoc-next vc-ewoc crt)) 1249 (and (setq crt (ewoc-next vc-ewoc crt))
1260 (string-equal 1250 (string-equal
1261 (substring 1251 (substring
1262 (progn 1252 (progn
1263 (setq data (ewoc-data crt)) 1253 (setq data (ewoc-data crt))
1264 (let ((crtdir (vc-dir-fileinfo->directory data))) 1254 (vc-dir-node-directory crt))
1265 (if crtdir
1266 crtdir
1267 (file-name-directory
1268 (expand-file-name
1269 (vc-dir-fileinfo->name data))))))
1270 0 dirlen) 1255 0 dirlen)
1271 dir)) 1256 dir))
1272 (unless (vc-dir-fileinfo->directory data) 1257 (unless (vc-dir-fileinfo->directory data)
1273 (push (vc-dir-fileinfo->name data) result)))) 1258 (push (expand-file-name (vc-dir-fileinfo->name data)) result))))
1274 (push (expand-file-name (vc-dir-fileinfo->name crt-data)) result) 1259 (push (expand-file-name (vc-dir-fileinfo->name crt-data)) result)
1275 (setq crt (ewoc-next vc-ewoc crt))) 1260 (setq crt (ewoc-next vc-ewoc crt)))
1276 (setq crt (ewoc-next vc-ewoc crt))))) 1261 (setq crt (ewoc-next vc-ewoc crt)))))
1262 result))
1263
1264 (defun vc-dir-child-files ()
1265 "Return the list of child files for the current entry if it's a directory.
1266 If it is a file, return the file itself."
1267 (let* ((crt (ewoc-locate vc-ewoc))
1268 (crt-data (ewoc-data crt))
1269 result)
1270 (if (vc-dir-fileinfo->directory crt-data)
1271 (let* ((dir (vc-dir-fileinfo->directory crt-data))
1272 (dirlen (length dir))
1273 data)
1274 (while
1275 (and (setq crt (ewoc-next vc-ewoc crt))
1276 (string-equal
1277 (substring
1278 (progn
1279 (setq data (ewoc-data crt))
1280 (vc-dir-node-directory crt))
1281 0 dirlen)
1282 dir))
1283 (unless (vc-dir-fileinfo->directory data)
1284 (push (expand-file-name (vc-dir-fileinfo->name data)) result))))
1285 (push (expand-file-name (vc-dir-fileinfo->name crt-data)) result))
1277 result)) 1286 result))
1278 1287
1279 (defun vc-directory-resynch-file (&optional fname) 1288 (defun vc-directory-resynch-file (&optional fname)
1280 "Update the entries for FILE in any directory buffers that list it." 1289 "Update the entries for FILE in any directory buffers that list it."
1281 (let ((file (or fname (expand-file-name buffer-file-name)))) 1290 (let ((file (or fname (expand-file-name buffer-file-name))))
1396 ;; No good set here, throw error 1405 ;; No good set here, throw error
1397 (t (error "No fileset is available here"))))) 1406 (t (error "No fileset is available here")))))
1398 ;; We assume, in order to avoid unpleasant surprises to the user, 1407 ;; We assume, in order to avoid unpleasant surprises to the user,
1399 ;; that a fileset is not in good shape to be handed to the user if the 1408 ;; that a fileset is not in good shape to be handed to the user if the
1400 ;; buffers visiting the fileset don't match the on-disk contents. 1409 ;; buffers visiting the fileset don't match the on-disk contents.
1401 (if (not observer) 1410 (unless observer
1402 (save-some-buffers 1411 (save-some-buffers
1403 nil (lambda () (vc-dispatcher-in-fileset-p (cdr selection))))) 1412 nil (lambda () (vc-dispatcher-in-fileset-p (cdr selection)))))
1404 selection)) 1413 selection))
1405 1414
1406 (provide 'vc-dispatcher) 1415 (provide 'vc-dispatcher)
1407 1416
1408 ;; arch-tag: 7d08b17f-5470-4799-914b-bfb9fcf6a246 1417 ;; arch-tag: 7d08b17f-5470-4799-914b-bfb9fcf6a246