Mercurial > emacs
changeset 96216:0c3be806e711
(vc-client-object): Remove.
(vc-dir-prepare-status-buffer): Take a backend as an argument and
use it when looking for a buffer.
(vc-dir): Add a backend argument. Set revert-buffer-function.
Don't create a client object. Move bindings ...
(vc-dir-menu-map, vc-dir-mode-map): ... here.
(vc-dir-revert-buffer-function): New function.
(vc-generic-status-printer): Rename to ...
(vc-dir-status-printer): ... this.
(vc-generic-state, vc-generic-status-fileinfo-extra)
(vc-dir-extra-menu, vc-make-backend-object): Remove.
(vc-default-status-printer): Use a different face for
directories. Don't display any text for directories in the state
column. Add tooltips.
| author | Dan Nicolaescu <dann@ics.uci.edu> |
|---|---|
| date | Tue, 24 Jun 2008 03:45:06 +0000 |
| parents | ad9760e68890 |
| children | e5a55b8c9892 |
| files | lisp/ChangeLog lisp/vc-dir.el |
| diffstat | 2 files changed, 119 insertions(+), 150 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Tue Jun 24 03:24:38 2008 +0000 +++ b/lisp/ChangeLog Tue Jun 24 03:45:06 2008 +0000 @@ -1,5 +1,20 @@ 2008-06-24 Dan Nicolaescu <dann@ics.uci.edu> + * vc-dir.el (vc-client-object): Remove. + (vc-dir-prepare-status-buffer): Take a backend as an argument and + use it when looking for a buffer. + (vc-dir): Add a backend argument. Set revert-buffer-function. + Don't create a client object. Move bindings ... + (vc-dir-menu-map, vc-dir-mode-map): ... here. + (vc-dir-revert-buffer-function): New function. + (vc-generic-status-printer): Rename to ... + (vc-dir-status-printer): ... this. + (vc-generic-state, vc-generic-status-fileinfo-extra) + (vc-dir-extra-menu, vc-make-backend-object): Remove. + (vc-default-status-printer): Use a different face for + directories. Don't display any text for directories in the state + column. Add tooltips. + * vc.el (Todo): Update. * vc-hg.el (vc-annotate-convert-time, vc-default-status-printer):
--- a/lisp/vc-dir.el Tue Jun 24 03:24:38 2008 +0000 +++ b/lisp/vc-dir.el Tue Jun 24 03:45:06 2008 +0000 @@ -62,7 +62,7 @@ (:conc-name vc-dir-fileinfo->)) name ;Keep it as first, for `member'. state - ;; For storing client-mode specific information. + ;; For storing backend specific information. extra marked ;; To keep track of not updated files during a global refresh @@ -70,30 +70,14 @@ ;; 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 - extra-menu)) - (:conc-name vc-client-object->)) - name - headers - file-to-info - file-to-state - file-to-extra - updater - extra-menu) +(defvar vc-ewoc nil) -(defvar vc-ewoc nil) (defvar vc-dir-process-buffer nil "The buffer used for the asynchronous call that computes status.") +(defvar vc-dir-backend nil + "The backend used by the current *vc-dir* buffer.") + (defun vc-dir-move-to-goal-column () ;; Used to keep the cursor on the file name column. (beginning-of-line) @@ -101,7 +85,7 @@ ;; Must be in sync with vc-default-status-printer. (forward-char 25))) -(defun vc-dir-prepare-status-buffer (bname dir &optional create-new) +(defun vc-dir-prepare-status-buffer (bname dir backend &optional create-new) "Find a buffer named BNAME showing DIR, or create a new one." (setq dir (expand-file-name dir)) (let* @@ -110,7 +94,8 @@ (unless create-new (dolist (buffer (buffer-list)) (set-buffer buffer) - (when (and (vc-dispatcher-browsing) + (when (and (derived-mode-p 'vc-dir-mode) + (eq vc-dir-backend backend) (string= (expand-file-name default-directory) dir)) (return buffer))))))) (or buf @@ -133,9 +118,12 @@ :enable (vc-dir-busy) :help "Kill the command that updates the directory buffer")) (define-key map [refresh] - '(menu-item "Refresh" vc-dir-refresh + '(menu-item "Refresh" revert-buffer :enable (not (vc-dir-busy)) :help "Refresh the contents of the directory buffer")) + (define-key map [remup] + '(menu-item "Hide up-to-date" vc-dir-hide-up-to-date + :help "Hide up-to-date items from display")) ;; Movement. (define-key map [sepmv] '("--")) (define-key map [next-line] @@ -173,21 +161,48 @@ (define-key map [open] '(menu-item "Open file" vc-dir-find-file :help "Find the file on the current line")) + (define-key map [sepvcdet] '("--")) + ;; FIXME: This needs a key binding. And maybe a better name + ;; ("Insert" like PCL-CVS uses does not sound that great either)... + (define-key map [ins] + '(menu-item "Show File" vc-dir-show-fileentry + :help "Show a file in the VC status listing even though it might be up to date")) + (define-key map [annotate] + '(menu-item "Annotate" vc-annotate + :help "Display the edit history of the current file using colors")) + (define-key map [diff] + '(menu-item "Compare with Base Version" vc-diff + :help "Compare file set with the base version")) + (define-key map [log] + '(menu-item "Show history" vc-print-log + :help "List the change log of the current file set in a window")) + ;; VC commands. + (define-key map [sepvccmd] '("--")) + (define-key map [update] + '(menu-item "Update to latest version" vc-update + :help "Update the current fileset's files to their tip revisions")) + (define-key map [revert] + '(menu-item "Revert to base version" vc-revert + :help "Revert working copies of the selected fileset to their repository contents.")) + (define-key map [next-action] + ;; FIXME: This really really really needs a better name! + ;; And a key binding too. + '(menu-item "Check In/Out" vc-next-action + :help "Do the next logical version control operation on the current fileset")) + (define-key map [register] + '(menu-item "Register" vc-register + :help "Register file set into the version control system")) map) "Menu for dispatcher status") -(defvar vc-client-mode) - -;; This is used so that client modes can add mode-specific menu -;; items to vc-dir-menu-map. +;; VC backends can use this to add mode-specific menu items to +;; vc-dir-menu-map. (defun vc-dir-menu-map-filter (orig-binding) (when (and (symbolp orig-binding) (fboundp orig-binding)) (setq orig-binding (indirect-function orig-binding))) (let ((ext-binding - ;; This may be executed at load-time for tool-bar-local-item-from-menu - ;; but at that time vc-client-mode is not known (or even bound) yet. - (when (and (boundp 'vc-client-mode) vc-client-mode) - (funcall (vc-client-object->extra-menu vc-client-mode))))) + (when (derived-mode-p 'vc-dir-mode) + (vc-call-backend vc-dir-backend 'extra-status-menu)))) (if (null ext-binding) orig-binding (append orig-binding @@ -197,6 +212,15 @@ (defvar vc-dir-mode-map (let ((map (make-keymap))) (suppress-keymap map) + ;; VC commands + (define-key map "v" 'vc-next-action) ;; C-x v v + (define-key map "=" 'vc-diff) ;; C-x v = + (define-key map "i" 'vc-register) ;; C-x v i + (define-key map "+" 'vc-update) ;; C-x v + + (define-key map "l" 'vc-print-log) ;; C-x v l + ;; More confusing than helpful, probably + ;;(define-key map "R" 'vc-revert) ;; u is taken by dispatcher unmark. + ;;(define-key map "A" 'vc-annotate) ;; g is taken by dispatcher refresh ;; Marking. (define-key map "m" 'vc-dir-mark) (define-key map "M" 'vc-dir-mark-all-files) @@ -219,17 +243,16 @@ (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 "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) + (define-key map "x" 'vc-dir-hide-up-to-date) ;; Hook up the menu. (define-key map [menu-bar vc-dir-mode] `(menu-item - ;; This is used so that client modes can add mode-specific - ;; menu items to vc-dir-menu-map. + ;; VC backends can use this to add mode-specific menu items to + ;; vc-dir-menu-map. "VC-dir" ,vc-dir-menu-map :filter vc-dir-menu-map-filter)) map) "Keymap for directory buffer.") @@ -265,7 +288,7 @@ :rtl "left-arrow") (tool-bar-local-item-from-menu 'vc-print-log "info" map vc-dir-mode-map) - (tool-bar-local-item-from-menu 'vc-dir-refresh "refresh" + (tool-bar-local-item-from-menu 'revert-buffer "refresh" map vc-dir-mode-map) (tool-bar-local-item-from-menu 'nonincremental-search-forward "search" map) @@ -733,12 +756,9 @@ (let* ;; FIXME: Any reason we don't use file-relative-name? ((file-short (substring file (length ddir))) - (state (funcall (vc-client-object->file-to-state - vc-client-mode) - file)) - (extra (funcall (vc-client-object->file-to-extra - vc-client-mode) - file)) + (state (vc-call-backend vc-dir-backend 'state file)) + (extra (vc-call-backend vc-dir-backend + 'status-fileinfo-extra file)) (entry (list file-short state extra))) (vc-dir-update (list entry) status-buf)))))) @@ -747,7 +767,9 @@ (unless found-vc-dir-buf (remove-hook 'after-save-hook 'vc-dir-resynch-file))))))) -(defun vc-dir-mode (client-object) +(defvar use-vc-backend) ;; dynamically bound + +(define-derived-mode vc-dir-mode special-mode "VC dir" "Major mode for dispatcher directory buffers. Marking/Unmarking key bindings and actions: m - marks a file/directory or if the region is active, mark all the files @@ -768,30 +790,23 @@ \\{vc-dir-mode-map}" - (setq mode-name (vc-client-object->name client-object)) - (setq major-mode 'vc-dir-mode) + (set (make-local-variable 'vc-dir-backend) use-vc-backend) (setq buffer-read-only t) - (use-local-map vc-dir-mode-map) - (if (boundp 'tool-bar-map) - (set (make-local-variable 'tool-bar-map) vc-dir-tool-bar-map)) - (set (make-local-variable 'vc-client-mode) client-object) + (when (boundp 'tool-bar-map) + (set (make-local-variable 'tool-bar-map) vc-dir-tool-bar-map)) (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))) + (ewoc-create #'vc-dir-status-printer + (vc-dir-headers vc-dir-backend default-directory))) + (set (make-local-variable 'revert-buffer-function) + 'vc-dir-revert-buffer-function) (add-hook 'after-save-hook 'vc-dir-resynch-file) ;; Make sure that if the directory 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) - -(defvar vc-dir-backend nil - "The backend used by the current *vc-dir* buffer.") + (vc-dir-refresh))) (defun vc-dir-headers (backend dir) "Display the headers in the *VC dir* buffer. @@ -849,6 +864,9 @@ (not (vc-dir-fileinfo->needs-update info)))))))))))) +(defun vc-dir-revert-buffer-function (&optional ignore-auto noconfirm) + (vc-dir-refresh)) + (defun vc-dir-refresh () "Refresh the contents of the *VC-dir* buffer. Throw an error if another update process is in progress." @@ -911,94 +929,30 @@ vc-ewoc (lambda (crt) (not (eq (vc-dir-fileinfo->state crt) 'up-to-date))))) -;; FIXME: Replace these with a more efficient dispatch - -(defun vc-generic-status-printer (fileentry) +(defun vc-dir-status-printer (fileentry) (vc-call-backend vc-dir-backend 'status-printer fileentry)) -(defun vc-generic-state (file) - (vc-call-backend vc-dir-backend 'state file)) - -(defun vc-generic-status-fileinfo-extra (file) - (vc-call-backend vc-dir-backend 'status-fileinfo-extra file)) - -(defun vc-dir-extra-menu () - (vc-call-backend vc-dir-backend 'extra-status-menu)) - -(defun vc-make-backend-object (file-or-dir) - "Create the backend capability object needed by vc-dispatcher." - (vc-create-client-object - "VC dir" - (vc-dir-headers vc-dir-backend file-or-dir) - #'vc-generic-status-printer - #'vc-generic-state - #'vc-generic-status-fileinfo-extra - #'vc-dir-refresh - #'vc-dir-extra-menu)) - ;;;###autoload -(defun vc-dir (dir) - "Show the VC status for DIR." - (interactive "DVC status for directory: ") - (pop-to-buffer (vc-dir-prepare-status-buffer "*vc-dir*" dir)) - (if (and (derived-mode-p 'vc-dir-mode) (boundp 'client-object)) +(defun vc-dir (dir backend) + "Show the VC status for DIR. +With a prefix argument ask what VC backend to use." + (interactive + (list + (read-file-name "VC status for directory: " + default-directory default-directory t) + (if current-prefix-arg + (intern + (completing-read + "Use VC backend: " + (mapcar (lambda (b) (list (symbol-name b))) vc-handled-backends) + nil t nil nil)) + (vc-responsible-backend default-directory)))) + (pop-to-buffer (vc-dir-prepare-status-buffer "*vc-dir*" dir backend)) + (if (derived-mode-p 'vc-dir-mode) (vc-dir-refresh) - ;; Otherwise, initialize a new view using the dispatcher layer - (progn - (set (make-local-variable 'vc-dir-backend) (vc-responsible-backend dir)) - ;; Build a capability object and hand it to the dispatcher initializer - (vc-dir-mode (vc-make-backend-object dir)) - ;; FIXME: Make a derived-mode instead. - ;; Add VC-specific keybindings - (let ((map (current-local-map))) - (define-key map "v" 'vc-next-action) ;; C-x v v - (define-key map "=" 'vc-diff) ;; C-x v = - (define-key map "i" 'vc-register) ;; C-x v i - (define-key map "+" 'vc-update) ;; C-x v + - (define-key map "l" 'vc-print-log) ;; C-x v l - ;; More confusing than helpful, probably - ;(define-key map "R" 'vc-revert) ;; u is taken by dispatcher unmark. - ;(define-key map "A" 'vc-annotate) ;; g is taken by dispatcher refresh - (define-key map "x" 'vc-dir-hide-up-to-date)) - ) - ;; FIXME: Needs to alter a buffer-local map, otherwise clients may clash - (let ((map vc-dir-menu-map)) - ;; VC info details - (define-key map [sepvcdet] '("--")) - (define-key map [remup] - '(menu-item "Hide up-to-date" vc-dir-hide-up-to-date - :help "Hide up-to-date items from display")) - ;; FIXME: This needs a key binding. And maybe a better name - ;; ("Insert" like PCL-CVS uses does not sound that great either)... - (define-key map [ins] - '(menu-item "Show File" vc-dir-show-fileentry - :help "Show a file in the VC status listing even though it might be up to date")) - (define-key map [annotate] - '(menu-item "Annotate" vc-annotate - :help "Display the edit history of the current file using colors")) - (define-key map [diff] - '(menu-item "Compare with Base Version" vc-diff - :help "Compare file set with the base version")) - (define-key map [log] - '(menu-item "Show history" vc-print-log - :help "List the change log of the current file set in a window")) - ;; VC commands. - (define-key map [sepvccmd] '("--")) - (define-key map [update] - '(menu-item "Update to latest version" vc-update - :help "Update the current fileset's files to their tip revisions")) - (define-key map [revert] - '(menu-item "Revert to base version" vc-revert - :help "Revert working copies of the selected fileset to their repository contents.")) - (define-key map [next-action] - ;; FIXME: This really really really needs a better name! - ;; And a key binding too. - '(menu-item "Check In/Out" vc-next-action - :help "Do the next logical version control operation on the current fileset")) - (define-key map [register] - '(menu-item "Register" vc-dir-register - :help "Register file set into the version control system")) - ))) + ;; FIXME: find a better way to pass the backend to `vc-dir-mode'. + (let ((use-vc-backend backend)) + (vc-dir-mode)))) (defun vc-default-status-extra-headers (backend dir) ;; Be loud by default to remind people to add code to display @@ -1013,13 +967,8 @@ "Pretty print FILEENTRY." ;; If you change the layout here, change vc-dir-move-to-goal-column. (let* ((isdir (vc-dir-fileinfo->directory fileentry)) - (state (if isdir 'DIRECTORY (vc-dir-fileinfo->state fileentry))) + (state (if isdir "" (vc-dir-fileinfo->state fileentry))) (filename (vc-dir-fileinfo->name fileentry))) - ;; FIXME: Backends that want to print the state in a different way - ;; can do it by defining the `status-printer' function. Using - ;; `prettify-state-info' adds two extra vc-calls per item, which - ;; is too expensive. - ;;(prettified (if isdir state (vc-call-backend backend 'prettify-state-info filename)))) (insert (propertize (format "%c" (if (vc-dir-fileinfo->marked fileentry) ?* ? )) @@ -1034,7 +983,12 @@ " " (propertize (format "%s" filename) - 'face 'font-lock-function-name-face + 'face + (if isdir 'font-lock-comment-delimiter-face 'font-lock-function-name-face) + 'help-echo + (if isdir + "Directory\nVC operations can be applied to it\nmouse-3: Pop-up menu" + "File\nmouse-3: Pop-up menu") 'mouse-face 'highlight)))) (defun vc-default-extra-status-menu (backend)