# HG changeset patch # User Eric S. Raymond # Date 1209907053 0 # Node ID 78377ffa13633f6457c1af2d160f1cc5b5d24bdb # Parent 318ecca53bb5ab200bd9fddfbe1bcf05ff42d832 Bug fix for vc-dispatcher split. diff -r 318ecca53bb5 -r 78377ffa1363 lisp/vc-dispatcher.el --- a/lisp/vc-dispatcher.el Sun May 04 11:45:43 2008 +0000 +++ b/lisp/vc-dispatcher.el Sun May 04 13:17:33 2008 +0000 @@ -540,11 +540,9 @@ (when buffer (with-current-buffer buffer (vc-resynch-window file keep noquery))))) - ;; FIME: Call into vc.el (vc-directory-resynch-file file) (when (memq 'vc-dir-mark-buffer-changed after-save-hook) (let ((buffer (get-file-buffer file))) - ;; FIME: Call into vc.el (vc-dir-mark-buffer-changed file)))) ;; Command closures @@ -888,6 +886,24 @@ ;; To distinguish files and directories. directory) +;; Used to describe a dispatcher client mode. +(defstruct (vc-client-object + (:copier nil) + (:constructor + vc-create-client-object (name + headers + file-to-info + file-to-state + file-to-extra + updater)) + (:conc-name vc-client-object->)) + name + headers + file-to-info + file-to-state + file-to-extra + updater) + (defvar vc-ewoc nil) (defvar vc-dir-process-buffer nil "The buffer used for the asynchronous call that computes the VC status.") @@ -1027,25 +1043,17 @@ (define-key map "\t" 'vc-dir-next-line) (define-key map "p" 'vc-dir-previous-line) (define-key map [backtab] 'vc-dir-previous-line) - ;; VC commands. - ;; FIXME: These need to be in a client-local keymap - (define-key map "=" 'vc-diff) ;; C-x v = - (define-key map "a" 'vc-dir-register) - (define-key map "+" 'vc-update) ;; C-x v + - (define-key map "R" 'vc-revert) ;; u is taken by unmark. - (define-key map "A" 'vc-annotate);; Can't be "g" (as in vc map) - (define-key map "l" 'vc-print-log) ;; C-x v l ;; The remainder. (define-key map "f" 'vc-dir-find-file) (define-key map "\C-m" 'vc-dir-find-file) (define-key map "o" 'vc-dir-find-file-other-window) - (define-key map "x" 'vc-dir-hide-up-to-date) (define-key map "q" 'quit-window) (define-key map "g" 'vc-dir-refresh) (define-key map "\C-c\C-c" 'vc-dir-kill-dir-status-process) (define-key map [(down-mouse-3)] 'vc-dir-menu) (define-key map [(mouse-2)] 'vc-dir-toggle-mark) + ;; FIXME: Calls back into vc.el ;; Hook up the menu. (define-key map [menu-bar vc-dir-mode] '(menu-item @@ -1493,8 +1501,7 @@ (ewoc-collect vc-ewoc 'vc-dir-fileinfo->marked))) (defun vc-dir-marked-only-files () - "Return the list of marked files, for marked directories, return child files." - + "Return the list of marked files, For marked directories return child files." (let ((crt (ewoc-nth vc-ewoc 0)) result) (while crt @@ -1525,4 +1532,71 @@ (setq crt (ewoc-next vc-ewoc crt))))) result)) +(defun vc-dir-mark-buffer-changed (&optional fname) + (let* ((file (or fname (expand-file-name buffer-file-name))) + (found-vc-dir-buf nil)) + (save-excursion + (dolist (status-buf (buffer-list)) + (set-buffer status-buf) + ;; look for a vc-dir buffer that might show this file. + (when (eq major-mode 'vc-dir-mode) + (setq found-vc-dir-buf t) + (let ((ddir (expand-file-name default-directory))) + ;; This test is cvs-string-prefix-p + (when (eq t (compare-strings file nil (length ddir) ddir nil nil)) + (let* + ((file-short (substring file (length ddir))) + (state + (apply (client-mode->file-to-state client-mode) fname)) + (extra + (apply (client-mode->file-to-extra client-mode) fname)) + (entry + (list file-short state extra))) + (vc-dir-update (list entry) status-buf)))))) + ;; We didn't find any vc-dir buffers, remove the hook, it is + ;; not needed. + (unless found-vc-dir-buf (remove-hook 'after-save-hook 'vc-dir-mark-buffer-changed))))) + +(defun vc-dir-mode (client-object) + "Major mode for showing the VC status for a directory. +Marking/Unmarking key bindings and actions: +m - marks a file/directory or if the region is active, mark all the files + in region. + Restrictions: - a file cannot be marked if any parent directory is marked + - a directory cannot be marked if any child file or + directory is marked +u - marks a file/directory or if the region is active, unmark all the files + in region. +M - if the cursor is on a file: mark all the files with the same VC state as + the current file + - if the cursor is on a directory: mark all child files + - with a prefix argument: mark all files +U - if the cursor is on a file: unmark all the files with the same VC state + as the current file + - if the cursor is on a directory: unmark all child files + - with a prefix argument: unmark all files + + +\\{vc-dir-mode-map}" + (setq mode-name (vc-client-object->name client-object)) + (setq major-mode 'vc-dir-mode) + (setq buffer-read-only t) + (use-local-map vc-dir-mode-map) + (set (make-local-variable 'tool-bar-map) vc-dir-tool-bar-map) + (set (make-local-variable 'client-mode) client-object) + (let ((buffer-read-only nil)) + (erase-buffer) + (set (make-local-variable 'vc-dir-process-buffer) nil) + (set (make-local-variable 'vc-ewoc) + (ewoc-create (vc-client-object->file-to-info client-object) + (vc-client-object->headers client-object))) + (add-hook 'after-save-hook 'vc-dir-mark-buffer-changed) + ;; Make sure that if the VC status buffer is killed, the update + ;; process running in the background is also killed. + (add-hook 'kill-buffer-query-functions 'vc-dir-kill-query nil t) + (funcall (vc-client-object->updater client-object))) + (run-hooks 'vc-dir-mode-hook)) + +(put 'vc-dir-mode 'mode-class 'special) + ;;; vc-dispatcher.el ends here diff -r 318ecca53bb5 -r 78377ffa1363 lisp/vc.el --- a/lisp/vc.el Sun May 04 11:45:43 2008 +0000 +++ b/lisp/vc.el Sun May 04 13:17:33 2008 +0000 @@ -2054,63 +2054,6 @@ (defun vc-default-extra-status-menu (backend) nil) -(defun vc-dir-mode (entry-printer header-printer updater marker) - "Major mode for showing the VC status for a directory. -Marking/Unmarking key bindings and actions: -m - marks a file/directory or ff the region is active, mark all the files - in region. - Restrictions: - a file cannot be marked if any parent directory is marked - - a directory cannot be marked if any child file or - directory is marked -u - marks a file/directory or if the region is active, unmark all the files - in region. -M - if the cursor is on a file: mark all the files with the same VC state as - the current file - - if the cursor is on a directory: mark all child files - - with a prefix argument: mark all files -U - if the cursor is on a file: unmark all the files with the same VC state - as the current file - - if the cursor is on a directory: unmark all child files - - with a prefix argument: unmark all files - - -\\{vc-dir-mode-map}" - (setq mode-name "VC Status") - (setq major-mode 'vc-dir-mode) - (setq buffer-read-only t) - (use-local-map vc-dir-mode-map) - (set (make-local-variable 'tool-bar-map) vc-dir-tool-bar-map) - (let ((buffer-read-only nil) - entries) - (erase-buffer) - (set (make-local-variable 'vc-dir-process-buffer) nil) - (set (make-local-variable 'vc-ewoc) - (ewoc-create entry-printer - header-printer)) - (add-hook 'after-save-hook marker) - ;; Make sure that if the VC status buffer is killed, the update - ;; process running in the background is also killed. - (add-hook 'kill-buffer-query-functions 'vc-dir-kill-query nil t) - (eval updater)) - (run-hooks 'vc-dir-mode-hook)) - -(put 'vc-dir-mode 'mode-class 'special) - -;;;###autoload -(defun vc-dir (dir) - "Show the VC status for DIR." - (interactive "DVC status for directory: ") - (pop-to-buffer (vc-dir-prepare-status-buffer dir)) - (if (eq major-mode 'vc-dir-mode) - (vc-dir-refresh) - (let ((backend (vc-responsible-backend default-directory))) - (vc-dir-mode (lambda (fileentry) - (vc-call-backend backend 'status-printer fileentry)) - (lambda (dir) - (vc-dir-headers backend default-directory)) - #'vc-dir-mark-buffer-changed - #'vc-dir-refresh)))) - ;; This is used to that VC backends could add backend specific menu ;; items to vc-dir-menu-map. (defun vc-dir-menu-map-filter (orig-binding) @@ -2231,33 +2174,58 @@ (or (vc-dir-marked-files) (list (vc-dir-current-file))))) (defun vc-default-status-fileinfo-extra (backend file) + "Default absence of extra information returned for a file." nil) -(defun vc-dir-mark-buffer-changed (&optional fname) - (let* ((file (or fname (expand-file-name buffer-file-name))) - (found-vc-dir-buf nil)) - (save-excursion - (dolist (status-buf (buffer-list)) - (set-buffer status-buf) - ;; look for a vc-dir buffer that might show this file. - (when (eq major-mode 'vc-dir-mode) - (setq found-vc-dir-buf t) - (let ((ddir (expand-file-name default-directory))) - ;; This test is cvs-string-prefix-p - (when (eq t (compare-strings file nil (length ddir) ddir nil nil)) - (let* - ((file-short (substring file (length ddir))) - (backend (vc-backend file)) - (state (and backend (vc-state file))) - (extra - (and backend - (vc-call-backend backend 'status-fileinfo-extra file))) - (entry - (list file-short (if state state 'unregistered) extra))) - (vc-dir-update (list entry) status-buf)))))) - ;; We didn't find any vc-dir buffers, remove the hook, it is - ;; not needed. - (unless found-vc-dir-buf (remove-hook 'after-save-hook 'vc-dir-mark-buffer-changed))))) +;; FIXME: Replace these with a more efficient dispatch + +(defun vc-generic-status-printer (fileentry) + (let ((backend (vc-responsible-backend (vc-dir-fileinfo->name fileentry)))) + (vc-call-backend backend 'status-printer fileentry))) + +(defun vc-generic-state (file) + (let ((backend (vc-responsible-backend file))) + (vc-call-backend backend 'state))) + +(defun vc-generic-status-fileinfo-extra (file) + (let ((backend (vc-responsible-backend file))) + (vc-call-backend backend 'status-fileinfo-extra))) + +(defun vc-generic-dir-headers (dir) + (let ((backend (vc-responsible-backend dir))) + (vc-dir-headers backend dir))) + +(defun vc-make-backend-object (file-or-dir) + (vc-create-client-object + "VC status" + (let ((backend (vc-responsible-backend file-or-dir))) + (vc-dir-headers backend file-or-dir)) + #'vc-generic-status-printer + #'vc-generic-state + #'vc-generic-status-fileinfo-extra + #'vc-dir-refresh)) + +;;;###autoload +(defun vc-dir (dir) + "Show the VC status for DIR." + (interactive "DVC status for directory: ") + (pop-to-buffer (vc-dir-prepare-status-buffer dir)) + (if (eq major-mode 'vc-dir-mode) + (vc-dir-refresh) + ;; Otherwise, initialize a new view using the dispatcher layer + (progn + ;; Build a capability object and hand it to the dispatcher initializer + (vc-dir-mode (vc-make-backend-object backend)) + ;; Add VC-specific keybindings + (let ((map (current-local-map))) + (define-key map "=" 'vc-diff) ;; C-x v = + (define-key map "a" 'vc-dir-register) + (define-key map "+" 'vc-update) ;; C-x v + + (define-key map "R" 'vc-revert) ;; u is taken by dispatcher unmark. + (define-key map "A" 'vc-annotate) ;; g is taken by dispatcher referesh + (define-key map "l" 'vc-print-log) ;; C-x v l + (define-key map "x" 'vc-dir-hide-up-to-date) + )))) ;; Named-configuration entry points