LCOV - code coverage report
Current view: top level - lisp/vc - vc-dir.el (source / functions) Hit Total Coverage
Test: tramp-tests-after.info Lines: 7 580 1.2 %
Date: 2017-08-30 10:12:24 Functions: 1 72 1.4 %

          Line data    Source code
       1             : ;;; vc-dir.el --- Directory status display under VC  -*- lexical-binding: t -*-
       2             : 
       3             : ;; Copyright (C) 2007-2017 Free Software Foundation, Inc.
       4             : 
       5             : ;; Author:   Dan Nicolaescu <dann@ics.uci.edu>
       6             : ;; Keywords: vc tools
       7             : ;; Package: vc
       8             : 
       9             : ;; This file is part of GNU Emacs.
      10             : 
      11             : ;; GNU Emacs is free software: you can redistribute it and/or modify
      12             : ;; it under the terms of the GNU General Public License as published by
      13             : ;; the Free Software Foundation, either version 3 of the License, or
      14             : ;; (at your option) any later version.
      15             : 
      16             : ;; GNU Emacs is distributed in the hope that it will be useful,
      17             : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
      18             : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
      19             : ;; GNU General Public License for more details.
      20             : 
      21             : ;; You should have received a copy of the GNU General Public License
      22             : ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
      23             : 
      24             : ;;; Credits:
      25             : 
      26             : ;; The original VC directory status implementation was based on dired.
      27             : ;; This implementation was inspired by PCL-CVS.
      28             : ;; Many people contributed comments, ideas and code to this
      29             : ;; implementation.  These include:
      30             : ;;
      31             : ;;   Alexandre Julliard  <julliard@winehq.org>
      32             : ;;   Stefan Monnier  <monnier@iro.umontreal.ca>
      33             : ;;   Tom Tromey  <tromey@redhat.com>
      34             : 
      35             : ;;; Commentary:
      36             : ;;
      37             : 
      38             : ;;; Todo:  see vc.el.
      39             : 
      40             : (require 'vc-hooks)
      41             : (require 'vc)
      42             : (require 'tool-bar)
      43             : (require 'ewoc)
      44             : 
      45             : ;;; Code:
      46             : (eval-when-compile (require 'cl-lib))
      47             : 
      48             : (defcustom vc-dir-mode-hook nil
      49             :   "Normal hook run by `vc-dir-mode'.
      50             : See `run-hooks'."
      51             :   :type 'hook
      52             :   :group 'vc)
      53             : 
      54             : ;; Used to store information for the files displayed in the directory buffer.
      55             : ;; Each item displayed corresponds to one of these defstructs.
      56             : (cl-defstruct (vc-dir-fileinfo
      57             :             (:copier nil)
      58             :             (:type list)            ;So we can use `member' on lists of FIs.
      59             :             (:constructor
      60             :              ;; We could define it as an alias for `list'.
      61             :              vc-dir-create-fileinfo (name state &optional extra marked directory))
      62             :             (:conc-name vc-dir-fileinfo->))
      63             :   name                                  ;Keep it as first, for `member'.
      64             :   state
      65             :   ;; For storing backend specific information.
      66             :   extra
      67             :   marked
      68             :   ;; To keep track of not updated files during a global refresh
      69             :   needs-update
      70             :   ;; To distinguish files and directories.
      71             :   directory)
      72             : 
      73             : (defvar vc-ewoc nil)
      74             : 
      75             : (defvar vc-dir-process-buffer nil
      76             :   "The buffer used for the asynchronous call that computes status.")
      77             : 
      78             : (defvar vc-dir-backend nil
      79             :   "The backend used by the current *vc-dir* buffer.")
      80             : 
      81             : (defun vc-dir-move-to-goal-column ()
      82             :   ;; Used to keep the cursor on the file name column.
      83           0 :   (beginning-of-line)
      84           0 :   (unless (eolp)
      85             :     ;; Must be in sync with vc-default-dir-printer.
      86           0 :     (forward-char 25)))
      87             : 
      88             : (defun vc-dir-prepare-status-buffer (bname dir backend &optional create-new)
      89             :   "Find a buffer named BNAME showing DIR, or create a new one."
      90           0 :   (setq dir (file-name-as-directory (expand-file-name dir)))
      91           0 :   (let* ;; Look for another buffer name BNAME visiting the same directory.
      92           0 :       ((buf (save-excursion
      93           0 :               (unless create-new
      94           0 :                 (cl-dolist (buffer vc-dir-buffers)
      95           0 :                   (when (buffer-live-p buffer)
      96           0 :                     (set-buffer buffer)
      97           0 :                     (when (and (derived-mode-p 'vc-dir-mode)
      98           0 :                                (eq vc-dir-backend backend)
      99           0 :                                (string= default-directory dir))
     100           0 :                       (cl-return buffer))))))))
     101           0 :     (or buf
     102             :         ;; Create a new buffer named BNAME.
     103             :         ;; We pass a filename to create-file-buffer because it is what
     104             :         ;; the function expects, and also what uniquify needs (if active)
     105           0 :         (with-current-buffer (create-file-buffer (expand-file-name bname dir))
     106           0 :           (setq default-directory dir)
     107           0 :           (vc-setup-buffer (current-buffer))
     108             :           ;; Reset the vc-parent-buffer-name so that it does not appear
     109             :           ;; in the mode-line.
     110           0 :           (setq vc-parent-buffer-name nil)
     111           0 :           (current-buffer)))))
     112             : 
     113             : (defvar vc-dir-menu-map
     114             :   (let ((map (make-sparse-keymap "VC-Dir")))
     115             :     (define-key map [quit]
     116             :       '(menu-item "Quit" quit-window
     117             :                   :help "Quit"))
     118             :     (define-key map [kill]
     119             :       '(menu-item "Kill Update Command" vc-dir-kill-dir-status-process
     120             :                   :enable (vc-dir-busy)
     121             :                   :help "Kill the command that updates the directory buffer"))
     122             :     (define-key map [refresh]
     123             :       '(menu-item "Refresh" revert-buffer
     124             :                   :enable (not (vc-dir-busy))
     125             :                   :help "Refresh the contents of the directory buffer"))
     126             :     (define-key map [remup]
     127             :       '(menu-item "Hide Up-to-date" vc-dir-hide-up-to-date
     128             :                   :help "Hide up-to-date items from display"))
     129             :     ;; Movement.
     130             :     (define-key map [sepmv] '("--"))
     131             :     (define-key map [next-line]
     132             :       '(menu-item "Next Line" vc-dir-next-line
     133             :                   :help "Go to the next line" :keys "n"))
     134             :     (define-key map [previous-line]
     135             :       '(menu-item "Previous Line" vc-dir-previous-line
     136             :                   :help "Go to the previous line"))
     137             :     ;; Marking.
     138             :     (define-key map [sepmrk] '("--"))
     139             :     (define-key map [unmark-all]
     140             :       '(menu-item "Unmark All" vc-dir-unmark-all-files
     141             :                   :help "Unmark all files that are in the same state as the current file\
     142             : \nWith prefix argument unmark all files"))
     143             :     (define-key map [unmark-previous]
     144             :       '(menu-item "Unmark Previous " vc-dir-unmark-file-up
     145             :                   :help "Move to the previous line and unmark the file"))
     146             : 
     147             :     (define-key map [mark-all]
     148             :       '(menu-item "Mark All" vc-dir-mark-all-files
     149             :                   :help "Mark all files that are in the same state as the current file\
     150             : \nWith prefix argument mark all files"))
     151             :     (define-key map [unmark]
     152             :       '(menu-item "Unmark" vc-dir-unmark
     153             :                   :help "Unmark the current file or all files in the region"))
     154             : 
     155             :     (define-key map [mark]
     156             :       '(menu-item "Mark" vc-dir-mark
     157             :                   :help "Mark the current file or all files in the region"))
     158             : 
     159             :     (define-key map [sepopn] '("--"))
     160             :     (define-key map [qr]
     161             :       '(menu-item "Query Replace in Files..." vc-dir-query-replace-regexp
     162             :                   :help "Replace a string in the marked files"))
     163             :     (define-key map [se]
     164             :       '(menu-item "Search Files..." vc-dir-search
     165             :                   :help "Search a regexp in the marked files"))
     166             :     (define-key map [ires]
     167             :       '(menu-item "Isearch Regexp Files..." vc-dir-isearch-regexp
     168             :                   :help "Incremental search a regexp in the marked files"))
     169             :     (define-key map [ise]
     170             :       '(menu-item "Isearch Files..." vc-dir-isearch
     171             :                   :help "Incremental search a string in the marked files"))
     172             :     (define-key map [display]
     173             :       '(menu-item "Display in Other Window" vc-dir-display-file
     174             :                   :help "Display the file on the current line, in another window"))
     175             :     (define-key map [open-other]
     176             :       '(menu-item "Open in Other Window" vc-dir-find-file-other-window
     177             :                   :help "Find the file on the current line, in another window"))
     178             :     (define-key map [open]
     179             :       '(menu-item "Open File" vc-dir-find-file
     180             :                   :help "Find the file on the current line"))
     181             :     (define-key map [sepvcdet] '("--"))
     182             :     ;; FIXME: This needs a key binding.  And maybe a better name
     183             :     ;; ("Insert" like PCL-CVS uses does not sound that great either)...
     184             :     (define-key map [ins]
     185             :       '(menu-item "Show File" vc-dir-show-fileentry
     186             :                   :help "Show a file in the VC status listing even though it might be up to date"))
     187             :     (define-key map [annotate]
     188             :       '(menu-item "Annotate" vc-annotate
     189             :                   :help "Display the edit history of the current file using colors"))
     190             :     (define-key map [diff]
     191             :       '(menu-item "Compare with Base Version" vc-diff
     192             :                   :help "Compare file set with the base version"))
     193             :     (define-key map [logo]
     194             :       '(menu-item "Show Outgoing Log" vc-log-outgoing
     195             :                   :help "Show a log of changes that will be sent with a push operation"))
     196             :     (define-key map [logi]
     197             :       '(menu-item "Show Incoming Log" vc-log-incoming
     198             :                   :help "Show a log of changes that will be received with a pull operation"))
     199             :     (define-key map [log]
     200             :       '(menu-item "Show History" vc-print-log
     201             :                   :help "List the change log of the current file set in a window"))
     202             :     (define-key map [rlog]
     203             :       '(menu-item "Show Top of the Tree History " vc-print-root-log
     204             :                   :help "List the change log for the current tree in a window"))
     205             :     ;; VC commands.
     206             :     (define-key map [sepvccmd] '("--"))
     207             :     (define-key map [push]
     208             :       '(menu-item "Push Changes" vc-push
     209             :                   :enable (vc-find-backend-function vc-dir-backend 'push)
     210             :                   :help "Push the current branch's changes"))
     211             :     (define-key map [update]
     212             :       '(menu-item "Update to Latest Version" vc-update
     213             :                   :help "Update the current fileset's files to their tip revisions"))
     214             :     (define-key map [revert]
     215             :       '(menu-item "Revert to Base Version" vc-revert
     216             :                   :help "Revert working copies of the selected fileset to their repository contents."))
     217             :     (define-key map [next-action]
     218             :       ;; FIXME: This really really really needs a better name!
     219             :       ;; And a key binding too.
     220             :       '(menu-item "Check In/Out" vc-next-action
     221             :                   :help "Do the next logical version control operation on the current fileset"))
     222             :     (define-key map [register]
     223             :       '(menu-item "Register" vc-register
     224             :                   :help "Register file set into the version control system"))
     225             :     (define-key map [ignore]
     226             :       '(menu-item "Ignore Current File" vc-dir-ignore
     227             :                   :help "Ignore the current file under current version control system"))
     228             :     map)
     229             :   "Menu for VC dir.")
     230             : 
     231             : ;; VC backends can use this to add mode-specific menu items to
     232             : ;; vc-dir-menu-map.
     233             : (defun vc-dir-menu-map-filter (orig-binding)
     234           0 :   (when (and (symbolp orig-binding) (fboundp orig-binding))
     235           0 :     (setq orig-binding (indirect-function orig-binding)))
     236           0 :   (let ((ext-binding
     237           0 :          (when (derived-mode-p 'vc-dir-mode)
     238           0 :            (vc-call-backend vc-dir-backend 'extra-status-menu))))
     239           0 :     (if (null ext-binding)
     240           0 :         orig-binding
     241           0 :       (append orig-binding
     242             :               '("----")
     243           0 :               ext-binding))))
     244             : 
     245             : (defvar vc-dir-mode-map
     246             :   (let ((map (make-sparse-keymap)))
     247             :     ;; VC commands
     248             :     (define-key map "v" 'vc-next-action)   ;; C-x v v
     249             :     (define-key map "=" 'vc-diff)        ;; C-x v =
     250             :     (define-key map "D" 'vc-root-diff)           ;; C-x v D
     251             :     (define-key map "i" 'vc-register)    ;; C-x v i
     252             :     (define-key map "+" 'vc-update)      ;; C-x v +
     253             :     ;; I'd prefer some kind of symmetry with vc-update:
     254             :     (define-key map "P" 'vc-push)        ;; C-x v P
     255             :     (define-key map "l" 'vc-print-log)           ;; C-x v l
     256             :     (define-key map "L" 'vc-print-root-log) ;; C-x v L
     257             :     (define-key map "I" 'vc-log-incoming)   ;; C-x v I
     258             :     (define-key map "O" 'vc-log-outgoing)   ;; C-x v O
     259             :     ;; More confusing than helpful, probably
     260             :     ;;(define-key map "R" 'vc-revert) ;; u is taken by vc-dir-unmark.
     261             :     ;;(define-key map "A" 'vc-annotate) ;; g is taken by revert-buffer
     262             :     ;;                                     bound by `special-mode'.
     263             :     ;; Marking.
     264             :     (define-key map "m" 'vc-dir-mark)
     265             :     (define-key map "M" 'vc-dir-mark-all-files)
     266             :     (define-key map "u" 'vc-dir-unmark)
     267             :     (define-key map "U" 'vc-dir-unmark-all-files)
     268             :     (define-key map "\C-?" 'vc-dir-unmark-file-up)
     269             :     (define-key map "\M-\C-?" 'vc-dir-unmark-all-files)
     270             :     ;; Movement.
     271             :     (define-key map "n" 'vc-dir-next-line)
     272             :     (define-key map " " 'vc-dir-next-line)
     273             :     (define-key map "\t" 'vc-dir-next-directory)
     274             :     (define-key map "p" 'vc-dir-previous-line)
     275             :     (define-key map [?\S-\ ] 'vc-dir-previous-line)
     276             :     (define-key map [backtab] 'vc-dir-previous-directory)
     277             :     ;;; Rebind paragraph-movement commands.
     278             :     (define-key map "\M-}" 'vc-dir-next-directory)
     279             :     (define-key map "\M-{" 'vc-dir-previous-directory)
     280             :     (define-key map [C-down] 'vc-dir-next-directory)
     281             :     (define-key map [C-up] 'vc-dir-previous-directory)
     282             :     ;; The remainder.
     283             :     (define-key map "f" 'vc-dir-find-file)
     284             :     (define-key map "e" 'vc-dir-find-file) ; dired-mode compatibility
     285             :     (define-key map "\C-m" 'vc-dir-find-file)
     286             :     (define-key map "o" 'vc-dir-find-file-other-window)
     287             :     (define-key map "\C-o" 'vc-dir-display-file)
     288             :     (define-key map "\C-c\C-c" 'vc-dir-kill-dir-status-process)
     289             :     (define-key map [down-mouse-3] 'vc-dir-menu)
     290             :     (define-key map [mouse-2] 'vc-dir-toggle-mark)
     291             :     (define-key map [follow-link] 'mouse-face)
     292             :     (define-key map "x" 'vc-dir-hide-up-to-date)
     293             :     (define-key map [?\C-k] 'vc-dir-kill-line)
     294             :     (define-key map "S" 'vc-dir-search) ;; FIXME: Maybe use A like dired?
     295             :     (define-key map "Q" 'vc-dir-query-replace-regexp)
     296             :     (define-key map (kbd "M-s a C-s")   'vc-dir-isearch)
     297             :     (define-key map (kbd "M-s a M-C-s") 'vc-dir-isearch-regexp)
     298             :     (define-key map "G" 'vc-dir-ignore)
     299             : 
     300             :     (let ((branch-map (make-sparse-keymap)))
     301             :       (define-key map "B" branch-map)
     302             :       (define-key branch-map "c" 'vc-create-tag)
     303             :       (define-key branch-map "l" 'vc-print-branch-log)
     304             :       (define-key branch-map "s" 'vc-retrieve-tag))
     305             : 
     306             :     ;; Hook up the menu.
     307             :     (define-key map [menu-bar vc-dir-mode]
     308             :       `(menu-item
     309             :         ;; VC backends can use this to add mode-specific menu items to
     310             :         ;; vc-dir-menu-map.
     311             :         "VC-Dir" ,vc-dir-menu-map :filter vc-dir-menu-map-filter))
     312             :     map)
     313             :   "Keymap for directory buffer.")
     314             : 
     315             : (defmacro vc-dir-at-event (event &rest body)
     316             :   "Evaluate BODY with point located at event-start of EVENT.
     317             : If BODY uses EVENT, it should be a variable,
     318             :  otherwise it will be evaluated twice."
     319           3 :   (let ((posn (make-symbol "vc-dir-at-event-posn")))
     320           3 :     `(save-excursion
     321           3 :        (unless (equal ,event '(tool-bar))
     322           3 :          (let ((,posn (event-start ,event)))
     323           3 :            (set-buffer (window-buffer (posn-window ,posn)))
     324           3 :            (goto-char (posn-point ,posn))))
     325           3 :        ,@body)))
     326             : 
     327             : (defun vc-dir-menu (e)
     328             :   "Popup the VC dir menu."
     329             :   (interactive "e")
     330           0 :   (vc-dir-at-event e (popup-menu vc-dir-menu-map e)))
     331             : 
     332             : (defvar vc-dir-tool-bar-map
     333             :   (let ((map (make-sparse-keymap)))
     334             :     (tool-bar-local-item-from-menu 'find-file "new" map nil
     335             :                                    :label "New File" :vert-only t)
     336             :     (tool-bar-local-item-from-menu 'menu-find-file-existing "open" map nil
     337             :                                    :label "Open" :vert-only t)
     338             :     (tool-bar-local-item-from-menu 'dired "diropen" map nil
     339             :                                    :vert-only t)
     340             :     (tool-bar-local-item-from-menu 'quit-window "close" map vc-dir-mode-map
     341             :                                    :vert-only t)
     342             :     (tool-bar-local-item-from-menu 'vc-next-action "saveas" map
     343             :                                    vc-dir-mode-map :label "Commit")
     344             :     (tool-bar-local-item-from-menu 'vc-print-log "info"
     345             :                                    map vc-dir-mode-map
     346             :                                    :label "Log")
     347             :     (define-key-after map [separator-1] menu-bar-separator)
     348             :     (tool-bar-local-item-from-menu 'vc-dir-kill-dir-status-process "cancel"
     349             :                                    map vc-dir-mode-map
     350             :                                    :label "Stop" :vert-only t)
     351             :     (tool-bar-local-item-from-menu 'revert-buffer "refresh"
     352             :                                    map vc-dir-mode-map :vert-only t)
     353             :     (define-key-after map [separator-2] menu-bar-separator)
     354             :     (tool-bar-local-item-from-menu (lookup-key menu-bar-edit-menu [cut])
     355             :                                    "cut" map nil :vert-only t)
     356             :     (tool-bar-local-item-from-menu (lookup-key menu-bar-edit-menu [copy])
     357             :                                    "copy" map nil :vert-only t)
     358             :     (tool-bar-local-item-from-menu (lookup-key menu-bar-edit-menu [paste])
     359             :                                    "paste" map nil :vert-only t)
     360             :     (define-key-after map [separator-3] menu-bar-separator)
     361             :     (tool-bar-local-item-from-menu 'isearch-forward
     362             :                                    "search" map nil
     363             :                                    :label "Search" :vert-only t)
     364             :     map))
     365             : 
     366             : (defun vc-dir-node-directory (node)
     367             :   ;; Compute the directory for NODE.
     368             :   ;; If it's a directory node, get it from the node.
     369           0 :   (let ((data (ewoc-data node)))
     370           0 :     (or (vc-dir-fileinfo->directory data)
     371             :         ;; Otherwise compute it from the file name.
     372           0 :         (file-name-directory
     373           0 :          (directory-file-name
     374           0 :           (expand-file-name
     375           0 :            (vc-dir-fileinfo->name data)))))))
     376             : 
     377             : (defun vc-dir-update (entries buffer &optional noinsert)
     378             :   "Update BUFFER's ewoc from the list of ENTRIES.
     379             : If NOINSERT, ignore elements on ENTRIES which are not in the ewoc."
     380             :   ;; Add ENTRIES to the vc-dir buffer BUFFER.
     381           0 :   (with-current-buffer buffer
     382             :     ;; Insert the entries sorted by name into the ewoc.
     383             :     ;; We assume the ewoc is sorted too, which should be the
     384             :     ;; case if we always add entries with vc-dir-update.
     385           0 :     (setq entries
     386             :           ;; Sort: first files and then subdirectories.
     387             :           ;; XXX: this is VERY inefficient, it computes the directory
     388             :           ;; names too many times
     389           0 :           (sort entries
     390             :                 (lambda (entry1 entry2)
     391           0 :                   (let ((dir1 (file-name-directory
     392           0 :                                 (directory-file-name (expand-file-name (car entry1)))))
     393           0 :                         (dir2 (file-name-directory
     394           0 :                                (directory-file-name (expand-file-name (car entry2))))))
     395           0 :                     (cond
     396           0 :                      ((string< dir1 dir2) t)
     397           0 :                      ((not (string= dir1 dir2)) nil)
     398           0 :                      ((string< (car entry1) (car entry2))))))))
     399             :     ;; Insert directory entries in the right places.
     400           0 :     (let ((entry (car entries))
     401           0 :           (node (ewoc-nth vc-ewoc 0))
     402             :           (to-remove nil)
     403           0 :           (dotname (file-relative-name default-directory)))
     404             :       ;; Insert . if it is not present.
     405           0 :       (unless node
     406           0 :         (ewoc-enter-last
     407           0 :          vc-ewoc (vc-dir-create-fileinfo
     408           0 :                   dotname nil nil nil default-directory))
     409           0 :         (setq node (ewoc-nth vc-ewoc 0)))
     410             : 
     411           0 :       (while (and entry node)
     412           0 :         (let* ((entryfile (car entry))
     413           0 :                (entrydir (file-name-directory (directory-file-name
     414           0 :                                                (expand-file-name entryfile))))
     415           0 :                (nodedir (vc-dir-node-directory node)))
     416           0 :           (cond
     417             :            ;; First try to find the directory.
     418           0 :            ((string-lessp nodedir entrydir)
     419           0 :             (setq node (ewoc-next vc-ewoc node)))
     420           0 :            ((string-equal nodedir entrydir)
     421             :             ;; Found the directory, find the place for the file name.
     422           0 :             (let ((nodefile (vc-dir-fileinfo->name (ewoc-data node))))
     423           0 :               (cond
     424           0 :                ((string= nodefile dotname)
     425           0 :                 (setq node (ewoc-next vc-ewoc node)))
     426           0 :                ((string-lessp nodefile entryfile)
     427           0 :                 (setq node (ewoc-next vc-ewoc node)))
     428           0 :                ((string-equal nodefile entryfile)
     429           0 :                 (if (nth 1 entry)
     430           0 :                     (progn
     431           0 :                       (setf (vc-dir-fileinfo->state (ewoc-data node)) (nth 1 entry))
     432           0 :                       (setf (vc-dir-fileinfo->extra (ewoc-data node)) (nth 2 entry))
     433           0 :                       (setf (vc-dir-fileinfo->needs-update (ewoc-data node)) nil)
     434           0 :                       (ewoc-invalidate vc-ewoc node))
     435             :                   ;; If the state is nil, the file does not exist
     436             :                   ;; anymore, so remember the entry so we can remove
     437             :                   ;; it after we are done inserting all ENTRIES.
     438           0 :                   (push node to-remove))
     439           0 :                 (setq entries (cdr entries))
     440           0 :                 (setq entry (car entries))
     441           0 :                 (setq node (ewoc-next vc-ewoc node)))
     442             :                (t
     443           0 :                 (unless noinsert
     444           0 :                   (ewoc-enter-before vc-ewoc node
     445           0 :                                      (apply 'vc-dir-create-fileinfo entry)))
     446           0 :                 (setq entries (cdr entries))
     447           0 :                 (setq entry (car entries))))))
     448             :            (t
     449           0 :             (unless noinsert
     450             :               ;; We might need to insert a directory node if the
     451             :               ;; previous node was in a different directory.
     452           0 :               (let* ((rd (file-relative-name entrydir))
     453           0 :                      (prev-node (ewoc-prev vc-ewoc node))
     454           0 :                      (prev-dir (if prev-node
     455           0 :                                    (vc-dir-node-directory prev-node))))
     456           0 :                 (unless (string-equal entrydir prev-dir)
     457           0 :                   (ewoc-enter-before
     458           0 :                    vc-ewoc node (vc-dir-create-fileinfo rd nil nil nil entrydir))))
     459             :               ;; Now insert the node itself.
     460           0 :               (ewoc-enter-before vc-ewoc node
     461           0 :                                  (apply 'vc-dir-create-fileinfo entry)))
     462           0 :             (setq entries (cdr entries) entry (car entries))))))
     463             :       ;; We're past the last node, all remaining entries go to the end.
     464           0 :       (unless (or node noinsert)
     465           0 :         (let ((lastdir (vc-dir-node-directory (ewoc-nth vc-ewoc -1))))
     466           0 :           (dolist (entry entries)
     467           0 :             (let ((entrydir (file-name-directory
     468           0 :                              (directory-file-name (expand-file-name (car entry))))))
     469             :               ;; Insert a directory node if needed.
     470           0 :               (unless (string-equal lastdir entrydir)
     471           0 :                 (setq lastdir entrydir)
     472           0 :                 (let ((rd (file-relative-name entrydir)))
     473           0 :                   (ewoc-enter-last
     474           0 :                    vc-ewoc (vc-dir-create-fileinfo rd nil nil nil entrydir))))
     475             :               ;; Now insert the node itself.
     476           0 :               (ewoc-enter-last vc-ewoc
     477           0 :                                (apply 'vc-dir-create-fileinfo entry))))))
     478           0 :       (when to-remove
     479           0 :         (let ((inhibit-read-only t))
     480           0 :           (apply 'ewoc-delete vc-ewoc (nreverse to-remove)))))))
     481             : 
     482             : (defun vc-dir-busy ()
     483           0 :   (and (buffer-live-p vc-dir-process-buffer)
     484           0 :        (get-buffer-process vc-dir-process-buffer)))
     485             : 
     486             : (defun vc-dir-kill-dir-status-process ()
     487             :   "Kill the temporary buffer and associated process."
     488             :   (interactive)
     489           0 :   (when (buffer-live-p vc-dir-process-buffer)
     490           0 :     (let ((proc (get-buffer-process vc-dir-process-buffer)))
     491           0 :       (when proc (delete-process proc))
     492           0 :       (setq vc-dir-process-buffer nil)
     493           0 :       (setq mode-line-process nil))))
     494             : 
     495             : (defun vc-dir-kill-query ()
     496             :   ;; Make sure that when the status buffer is killed the update
     497             :   ;; process running in background is also killed.
     498           0 :   (if (vc-dir-busy)
     499           0 :     (when (y-or-n-p "Status update process running, really kill status buffer? ")
     500           0 :       (vc-dir-kill-dir-status-process)
     501           0 :       t)
     502           0 :     t))
     503             : 
     504             : (defun vc-dir-next-line (arg)
     505             :   "Go to the next line.
     506             : If a prefix argument is given, move by that many lines."
     507             :   (interactive "p")
     508           0 :   (with-no-warnings
     509           0 :     (ewoc-goto-next vc-ewoc arg)
     510           0 :     (vc-dir-move-to-goal-column)))
     511             : 
     512             : (defun vc-dir-previous-line (arg)
     513             :   "Go to the previous line.
     514             : If a prefix argument is given, move by that many lines."
     515             :   (interactive "p")
     516           0 :   (ewoc-goto-prev vc-ewoc arg)
     517           0 :   (vc-dir-move-to-goal-column))
     518             : 
     519             : (defun vc-dir-next-directory ()
     520             :   "Go to the next directory."
     521             :   (interactive)
     522           0 :   (let ((orig (point)))
     523           0 :     (if
     524           0 :         (catch 'foundit
     525           0 :           (while t
     526           0 :             (let* ((next (ewoc-next vc-ewoc (ewoc-locate vc-ewoc))))
     527           0 :               (cond ((not next)
     528           0 :                      (throw 'foundit t))
     529             :                     (t
     530           0 :                      (progn
     531           0 :                        (ewoc-goto-node vc-ewoc next)
     532           0 :                        (vc-dir-move-to-goal-column)
     533           0 :                        (if (vc-dir-fileinfo->directory (ewoc-data next))
     534           0 :                            (throw 'foundit nil))))))))
     535           0 :         (goto-char orig))))
     536             : 
     537             : (defun vc-dir-previous-directory ()
     538             :   "Go to the previous directory."
     539             :   (interactive)
     540           0 :   (let ((orig (point)))
     541           0 :     (if
     542           0 :         (catch 'foundit
     543           0 :           (while t
     544           0 :             (let* ((prev (ewoc-prev vc-ewoc (ewoc-locate vc-ewoc))))
     545           0 :               (cond ((not prev)
     546           0 :                      (throw 'foundit t))
     547             :                     (t
     548           0 :                      (progn
     549           0 :                        (ewoc-goto-node vc-ewoc prev)
     550           0 :                        (vc-dir-move-to-goal-column)
     551           0 :                        (if (vc-dir-fileinfo->directory (ewoc-data prev))
     552           0 :                            (throw 'foundit nil))))))))
     553           0 :         (goto-char orig))))
     554             : 
     555             : (defun vc-dir-mark-unmark (mark-unmark-function)
     556           0 :   (if (use-region-p)
     557           0 :       (let (;; (firstl (line-number-at-pos (region-beginning)))
     558           0 :             (lastl (line-number-at-pos (region-end))))
     559           0 :         (save-excursion
     560           0 :           (goto-char (region-beginning))
     561           0 :           (while (<= (line-number-at-pos) lastl)
     562           0 :             (condition-case nil
     563           0 :                 (funcall mark-unmark-function)
     564             :               ;; `vc-dir-mark-file' signals an error if we try marking
     565             :               ;; a directory containing marked files in its tree, or a
     566             :               ;; file in a marked directory tree.  Just continue.
     567           0 :               (error (vc-dir-next-line 1))))))
     568           0 :     (funcall mark-unmark-function)))
     569             : 
     570             : (defun vc-dir-parent-marked-p (arg)
     571             :   ;; Non-nil iff a parent directory of arg is marked.
     572             :   ;; Return value, if non-nil is the `ewoc-data' for the marked parent.
     573           0 :   (let* ((argdir (vc-dir-node-directory arg))
     574             :          ;; (arglen (length argdir))
     575           0 :          (crt arg)
     576             :          (found nil))
     577             :     ;; Go through the predecessors, checking if any directory that is
     578             :     ;; a parent is marked.
     579           0 :     (while (and (null found)
     580           0 :                 (setq crt (ewoc-prev vc-ewoc crt)))
     581           0 :       (let ((data (ewoc-data crt))
     582           0 :             (dir (vc-dir-node-directory crt)))
     583           0 :         (and (vc-dir-fileinfo->directory data)
     584           0 :              (string-prefix-p dir argdir)
     585           0 :              (vc-dir-fileinfo->marked data)
     586           0 :              (setq found data))))
     587           0 :     found))
     588             : 
     589             : (defun vc-dir-children-marked-p (arg)
     590             :   ;; Non-nil iff a child of ARG is marked.
     591             :   ;; Return value, if non-nil, is the `ewoc-data' for the marked child.
     592           0 :   (let* ((argdir-re (concat "\\`" (regexp-quote (vc-dir-node-directory arg))))
     593             :          (is-child t)
     594           0 :          (crt arg)
     595             :          (found nil))
     596           0 :     (while (and is-child
     597           0 :                 (null found)
     598           0 :                 (setq crt (ewoc-next vc-ewoc crt)))
     599           0 :       (let ((data (ewoc-data crt))
     600           0 :             (dir (vc-dir-node-directory crt)))
     601           0 :         (if (string-match argdir-re dir)
     602           0 :             (if (vc-dir-fileinfo->marked data)
     603           0 :                 (setq found data))
     604             :           ;; We are done, we got to an entry that is not a child of `arg'.
     605           0 :           (setq is-child nil))))
     606           0 :     found))
     607             : 
     608             : (defun vc-dir-mark-file (&optional arg)
     609             :   ;; Mark ARG or the current file and move to the next line.
     610           0 :   (let* ((crt (or arg (ewoc-locate vc-ewoc)))
     611           0 :          (file (ewoc-data crt))
     612           0 :          (isdir (vc-dir-fileinfo->directory file))
     613             :          ;; Forbid marking a directory containing marked files in its
     614             :          ;; tree, or a file in a marked directory tree.
     615           0 :          (conflict (if isdir
     616           0 :                        (vc-dir-children-marked-p crt)
     617           0 :                      (vc-dir-parent-marked-p crt))))
     618           0 :     (when conflict
     619           0 :       (error (if isdir
     620             :                  "File `%s' in this directory is already marked"
     621           0 :                "Parent directory `%s' is already marked")
     622           0 :              (vc-dir-fileinfo->name conflict)))
     623           0 :     (setf (vc-dir-fileinfo->marked file) t)
     624           0 :     (ewoc-invalidate vc-ewoc crt)
     625           0 :     (unless (or arg (mouse-event-p last-command-event))
     626           0 :       (vc-dir-next-line 1))))
     627             : 
     628             : (defun vc-dir-mark ()
     629             :   "Mark the current file or all files in the region.
     630             : If the region is active, mark all the files in the region.
     631             : Otherwise mark the file on the current line and move to the next
     632             : line."
     633             :   (interactive)
     634           0 :   (vc-dir-mark-unmark 'vc-dir-mark-file))
     635             : 
     636             : (defun vc-dir-mark-all-files (arg)
     637             :   "Mark all files with the same state as the current one.
     638             : With a prefix argument mark all files.
     639             : If the current entry is a directory, mark all child files.
     640             : 
     641             : The commands operate on files that are on the same state.
     642             : This command is intended to make it easy to select all files that
     643             : share the same state."
     644             :   (interactive "P")
     645           0 :   (if arg
     646             :       ;; Mark all files.
     647           0 :       (progn
     648             :         ;; First check that no directory is marked, we can't mark
     649             :         ;; files in that case.
     650           0 :         (ewoc-map
     651             :          (lambda (filearg)
     652           0 :            (when (and (vc-dir-fileinfo->directory filearg)
     653           0 :                       (vc-dir-fileinfo->marked filearg))
     654           0 :              (error "Cannot mark all files, directory `%s' marked"
     655           0 :                     (vc-dir-fileinfo->name filearg))))
     656           0 :          vc-ewoc)
     657           0 :         (ewoc-map
     658             :          (lambda (filearg)
     659           0 :            (unless (vc-dir-fileinfo->marked filearg)
     660           0 :              (setf (vc-dir-fileinfo->marked filearg) t)
     661           0 :              t))
     662           0 :          vc-ewoc))
     663           0 :     (let* ((crt  (ewoc-locate vc-ewoc))
     664           0 :            (data (ewoc-data crt)))
     665           0 :       (if (vc-dir-fileinfo->directory data)
     666             :           ;; It's a directory, mark child files.
     667           0 :           (let (crt-data)
     668           0 :             (while (and (setq crt (ewoc-next vc-ewoc crt))
     669           0 :                         (setq crt-data (ewoc-data crt))
     670           0 :                         (not (vc-dir-fileinfo->directory crt-data)))
     671           0 :               (setf (vc-dir-fileinfo->marked crt-data) t)
     672           0 :               (ewoc-invalidate vc-ewoc crt)))
     673             :         ;; It's a file
     674           0 :         (let ((state (vc-dir-fileinfo->state data)))
     675           0 :           (setq crt (ewoc-nth vc-ewoc 0))
     676           0 :           (while crt
     677           0 :             (let ((crt-data (ewoc-data crt)))
     678           0 :               (when (and (not (vc-dir-fileinfo->marked crt-data))
     679           0 :                          (eq (vc-dir-fileinfo->state crt-data) state)
     680           0 :                          (not (vc-dir-fileinfo->directory crt-data)))
     681           0 :                 (vc-dir-mark-file crt)))
     682           0 :             (setq crt (ewoc-next vc-ewoc crt))))))))
     683             : 
     684             : (defun vc-dir-unmark-file ()
     685             :   ;; Unmark the current file and move to the next line.
     686           0 :   (let* ((crt (ewoc-locate vc-ewoc))
     687           0 :          (file (ewoc-data crt)))
     688           0 :     (setf (vc-dir-fileinfo->marked file) nil)
     689           0 :     (ewoc-invalidate vc-ewoc crt)
     690           0 :     (unless (mouse-event-p last-command-event)
     691           0 :       (vc-dir-next-line 1))))
     692             : 
     693             : (defun vc-dir-unmark ()
     694             :   "Unmark the current file or all files in the region.
     695             : If the region is active, unmark all the files in the region.
     696             : Otherwise mark the file on the current line and move to the next
     697             : line."
     698             :   (interactive)
     699           0 :   (vc-dir-mark-unmark 'vc-dir-unmark-file))
     700             : 
     701             : (defun vc-dir-unmark-file-up ()
     702             :   "Move to the previous line and unmark the file."
     703             :   (interactive)
     704             :   ;; If we're on the first line, we won't move up, but we will still
     705             :   ;; remove the mark.  This seems a bit odd but it is what buffer-menu
     706             :   ;; does.
     707           0 :   (let* ((prev (ewoc-goto-prev vc-ewoc 1))
     708           0 :          (file (ewoc-data prev)))
     709           0 :     (setf (vc-dir-fileinfo->marked file) nil)
     710           0 :     (ewoc-invalidate vc-ewoc prev)
     711           0 :     (vc-dir-move-to-goal-column)))
     712             : 
     713             : (defun vc-dir-unmark-all-files (arg)
     714             :   "Unmark all files with the same state as the current one.
     715             : With a prefix argument unmark all files.
     716             : If the current entry is a directory, unmark all the child files.
     717             : 
     718             : The commands operate on files that are on the same state.
     719             : This command is intended to make it easy to deselect all files
     720             : that share the same state."
     721             :   (interactive "P")
     722           0 :   (if arg
     723           0 :       (ewoc-map
     724             :        (lambda (filearg)
     725           0 :          (when (vc-dir-fileinfo->marked filearg)
     726           0 :            (setf (vc-dir-fileinfo->marked filearg) nil)
     727           0 :            t))
     728           0 :        vc-ewoc)
     729           0 :     (let* ((crt (ewoc-locate vc-ewoc))
     730           0 :            (data (ewoc-data crt)))
     731           0 :       (if (vc-dir-fileinfo->directory data)
     732             :           ;; It's a directory, unmark child files.
     733           0 :           (while (setq crt (ewoc-next vc-ewoc crt))
     734           0 :             (let ((crt-data (ewoc-data crt)))
     735           0 :               (unless (vc-dir-fileinfo->directory crt-data)
     736           0 :                 (setf (vc-dir-fileinfo->marked crt-data) nil)
     737           0 :                 (ewoc-invalidate vc-ewoc crt))))
     738             :         ;; It's a file
     739           0 :         (let ((crt-state (vc-dir-fileinfo->state (ewoc-data crt))))
     740           0 :           (ewoc-map
     741             :            (lambda (filearg)
     742           0 :              (when (and (vc-dir-fileinfo->marked filearg)
     743           0 :                         (eq (vc-dir-fileinfo->state filearg) crt-state))
     744           0 :                (setf (vc-dir-fileinfo->marked filearg) nil)
     745           0 :                t))
     746           0 :            vc-ewoc))))))
     747             : 
     748             : (defun vc-dir-toggle-mark-file ()
     749           0 :   (let* ((crt (ewoc-locate vc-ewoc))
     750           0 :          (file (ewoc-data crt)))
     751           0 :     (if (vc-dir-fileinfo->marked file)
     752           0 :         (vc-dir-unmark-file)
     753           0 :       (vc-dir-mark-file))))
     754             : 
     755             : (defun vc-dir-toggle-mark (e)
     756             :   (interactive "e")
     757           0 :   (vc-dir-at-event e (vc-dir-mark-unmark 'vc-dir-toggle-mark-file)))
     758             : 
     759             : (defun vc-dir-delete-file ()
     760             :   "Delete the marked files, or the current file if no marks."
     761             :   (interactive)
     762           0 :   (mapc 'vc-delete-file (or (vc-dir-marked-files)
     763           0 :                             (list (vc-dir-current-file)))))
     764             : 
     765             : (defun vc-dir-find-file ()
     766             :   "Find the file on the current line."
     767             :   (interactive)
     768           0 :   (find-file (vc-dir-current-file)))
     769             : 
     770             : (defun vc-dir-find-file-other-window (&optional event)
     771             :   "Find the file on the current line, in another window."
     772           0 :   (interactive (list last-nonmenu-event))
     773           0 :   (if event (posn-set-point (event-end event)))
     774           0 :   (find-file-other-window (vc-dir-current-file)))
     775             : 
     776             : (defun vc-dir-display-file (&optional event)
     777             :   "Display the file on the current line, in another window."
     778           0 :   (interactive (list last-nonmenu-event))
     779           0 :   (if event (posn-set-point (event-end event)))
     780           0 :   (display-buffer (find-file-noselect (vc-dir-current-file))
     781           0 :                   t))
     782             : 
     783             : (defun vc-dir-isearch ()
     784             :   "Search for a string through all marked buffers using Isearch."
     785             :   (interactive)
     786           0 :   (multi-isearch-files
     787           0 :    (mapcar 'car (vc-dir-marked-only-files-and-states))))
     788             : 
     789             : (defun vc-dir-isearch-regexp ()
     790             :   "Search for a regexp through all marked buffers using Isearch."
     791             :   (interactive)
     792           0 :   (multi-isearch-files-regexp
     793           0 :    (mapcar 'car (vc-dir-marked-only-files-and-states))))
     794             : 
     795             : (defun vc-dir-search (regexp)
     796             :   "Search through all marked files for a match for REGEXP.
     797             : For marked directories, use the files displayed from those directories.
     798             : Stops when a match is found.
     799             : To continue searching for next match, use command \\[tags-loop-continue]."
     800             :   (interactive "sSearch marked files (regexp): ")
     801           0 :   (tags-search regexp '(mapcar 'car (vc-dir-marked-only-files-and-states))))
     802             : 
     803             : (defun vc-dir-query-replace-regexp (from to &optional delimited)
     804             :   "Do `query-replace-regexp' of FROM with TO, on all marked files.
     805             : If a directory is marked, then use the files displayed for that directory.
     806             : Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
     807             : If you exit (\\[keyboard-quit], RET or q), you can resume the query replace
     808             : with the command \\[tags-loop-continue]."
     809             :   ;; FIXME: this is almost a copy of `dired-do-query-replace-regexp'.  This
     810             :   ;; should probably be made generic and used in both places instead of
     811             :   ;; duplicating it here.
     812             :   (interactive
     813           0 :    (let ((common
     814           0 :           (query-replace-read-args
     815           0 :            "Query replace regexp in marked files" t t)))
     816           0 :      (list (nth 0 common) (nth 1 common) (nth 2 common))))
     817           0 :   (dolist (file (mapcar 'car (vc-dir-marked-only-files-and-states)))
     818           0 :     (let ((buffer (get-file-buffer file)))
     819           0 :       (if (and buffer (with-current-buffer buffer
     820           0 :                         buffer-read-only))
     821           0 :           (error "File `%s' is visited read-only" file))))
     822           0 :   (tags-query-replace from to delimited
     823           0 :                       '(mapcar 'car (vc-dir-marked-only-files-and-states))))
     824             : 
     825             : (defun vc-dir-ignore ()
     826             :   "Ignore the current file."
     827             :   (interactive)
     828           0 :   (vc-ignore (vc-dir-current-file)))
     829             : 
     830             : (defun vc-dir-current-file ()
     831           0 :   (let ((node (ewoc-locate vc-ewoc)))
     832           0 :     (unless node
     833           0 :       (error "No file available"))
     834           0 :     (expand-file-name (vc-dir-fileinfo->name (ewoc-data node)))))
     835             : 
     836             : (defun vc-dir-marked-files ()
     837             :   "Return the list of marked files."
     838           0 :   (mapcar
     839           0 :    (lambda (elem) (expand-file-name (vc-dir-fileinfo->name elem)))
     840           0 :    (ewoc-collect vc-ewoc 'vc-dir-fileinfo->marked)))
     841             : 
     842             : (defun vc-dir-marked-only-files-and-states ()
     843             :   "Return the list of conses (FILE . STATE) for the marked files.
     844             : For marked directories return the corresponding conses for the
     845             : child files."
     846           0 :   (let ((crt (ewoc-nth vc-ewoc 0))
     847             :         result)
     848           0 :     (while crt
     849           0 :       (let ((crt-data (ewoc-data crt)))
     850           0 :         (if (vc-dir-fileinfo->marked crt-data)
     851             :             ;; FIXME: use vc-dir-child-files-and-states here instead of duplicating it.
     852           0 :             (if (vc-dir-fileinfo->directory crt-data)
     853           0 :                 (let* ((dir (vc-dir-fileinfo->directory crt-data))
     854             :                        ;; (dirlen (length dir))
     855             :                        data)
     856           0 :                   (while
     857           0 :                       (and (setq crt (ewoc-next vc-ewoc crt))
     858           0 :                            (string-prefix-p dir
     859           0 :                                                (progn
     860           0 :                                                  (setq data (ewoc-data crt))
     861           0 :                                                  (vc-dir-node-directory crt))))
     862           0 :                     (unless (vc-dir-fileinfo->directory data)
     863           0 :                       (push
     864           0 :                        (cons (expand-file-name (vc-dir-fileinfo->name data))
     865           0 :                              (vc-dir-fileinfo->state data))
     866           0 :                        result))))
     867           0 :               (push (cons (expand-file-name (vc-dir-fileinfo->name crt-data))
     868           0 :                           (vc-dir-fileinfo->state crt-data))
     869           0 :                     result)
     870           0 :               (setq crt (ewoc-next vc-ewoc crt)))
     871           0 :           (setq crt (ewoc-next vc-ewoc crt)))))
     872           0 :     (nreverse result)))
     873             : 
     874             : (defun vc-dir-child-files-and-states ()
     875             :   "Return the list of conses (FILE . STATE) for child files of the current entry if it's a directory.
     876             : If it is a file, return the corresponding cons for the file itself."
     877           0 :   (let* ((crt (ewoc-locate vc-ewoc))
     878           0 :          (crt-data (ewoc-data crt))
     879             :          result)
     880           0 :     (if (vc-dir-fileinfo->directory crt-data)
     881           0 :         (let* ((dir (vc-dir-fileinfo->directory crt-data))
     882             :                ;; (dirlen (length dir))
     883             :                data)
     884           0 :           (while
     885           0 :               (and (setq crt (ewoc-next vc-ewoc crt))
     886           0 :                    (string-prefix-p dir (progn
     887           0 :                                              (setq data (ewoc-data crt))
     888           0 :                                              (vc-dir-node-directory crt))))
     889           0 :             (unless (vc-dir-fileinfo->directory data)
     890           0 :               (push
     891           0 :                (cons (expand-file-name (vc-dir-fileinfo->name data))
     892           0 :                      (vc-dir-fileinfo->state data))
     893           0 :                result))))
     894           0 :       (push
     895           0 :        (cons (expand-file-name (vc-dir-fileinfo->name crt-data))
     896           0 :              (vc-dir-fileinfo->state crt-data)) result))
     897           0 :     (nreverse result)))
     898             : 
     899             : (defun vc-dir-recompute-file-state (fname def-dir)
     900           0 :   (let* ((file-short (file-relative-name fname def-dir))
     901             :          (_remove-me-when-CVS-works
     902           0 :           (when (eq vc-dir-backend 'CVS)
     903             :             ;; FIXME: Warning: UGLY HACK.  The CVS backend caches the state
     904             :             ;; info, this forces the backend to update it.
     905           0 :             (vc-call-backend vc-dir-backend 'registered fname)))
     906           0 :          (state (vc-call-backend vc-dir-backend 'state fname))
     907           0 :          (extra (vc-call-backend vc-dir-backend
     908           0 :                                  'status-fileinfo-extra fname)))
     909           0 :     (list file-short state extra)))
     910             : 
     911             : (defun vc-dir-find-child-files (dirname)
     912             :   ;; Give a DIRNAME string return the list of all child files shown in
     913             :   ;; the current *vc-dir* buffer.
     914           0 :   (let ((crt (ewoc-nth vc-ewoc 0))
     915             :         children)
     916             :     ;; Find DIR
     917           0 :     (while (and crt (not (string-prefix-p
     918           0 :                           dirname (vc-dir-node-directory crt))))
     919           0 :       (setq crt (ewoc-next vc-ewoc crt)))
     920           0 :     (while (and crt (string-prefix-p
     921           0 :                      dirname
     922           0 :                      (vc-dir-node-directory crt)))
     923           0 :       (let ((data (ewoc-data crt)))
     924           0 :         (unless (vc-dir-fileinfo->directory data)
     925           0 :           (push (expand-file-name (vc-dir-fileinfo->name data)) children)))
     926           0 :       (setq crt (ewoc-next vc-ewoc crt)))
     927           0 :     children))
     928             : 
     929             : (defun vc-dir-resync-directory-files (dirname)
     930             :   ;; Update the entries for all the child files of DIRNAME shown in
     931             :   ;; the current *vc-dir* buffer.
     932           0 :   (let ((files (vc-dir-find-child-files dirname))
     933           0 :         (ddir default-directory)
     934             :         fileentries)
     935           0 :     (when files
     936           0 :       (dolist (crt files)
     937           0 :         (push (vc-dir-recompute-file-state crt ddir)
     938           0 :               fileentries))
     939           0 :       (vc-dir-update fileentries (current-buffer)))))
     940             : 
     941             : (defun vc-dir-resynch-file (&optional fname)
     942             :   "Update the entries for FNAME in any directory buffers that list it."
     943           0 :   (let ((file (expand-file-name (or fname buffer-file-name)))
     944             :         (drop '()))
     945           0 :     (save-current-buffer
     946             :       ;; look for a vc-dir buffer that might show this file.
     947           0 :       (dolist (status-buf vc-dir-buffers)
     948           0 :         (if (not (buffer-live-p status-buf))
     949           0 :             (push status-buf drop)
     950           0 :           (set-buffer status-buf)
     951           0 :           (if (not (derived-mode-p 'vc-dir-mode))
     952           0 :               (push status-buf drop)
     953           0 :             (let ((ddir default-directory))
     954           0 :               (when (string-prefix-p ddir file)
     955           0 :                 (if (file-directory-p file)
     956           0 :                     (progn
     957           0 :                       (vc-dir-resync-directory-files file)
     958           0 :                       (ewoc-set-hf vc-ewoc
     959           0 :                                    (vc-dir-headers vc-dir-backend default-directory) ""))
     960           0 :                   (let* ((complete-state (vc-dir-recompute-file-state file ddir))
     961           0 :                          (state (cadr complete-state)))
     962           0 :                     (vc-dir-update
     963           0 :                      (list complete-state)
     964           0 :                      status-buf (or (not state)
     965           0 :                                     (eq state 'up-to-date)))))))))))
     966             :     ;; Remove out-of-date entries from vc-dir-buffers.
     967           0 :     (dolist (b drop) (setq vc-dir-buffers (delq b vc-dir-buffers)))))
     968             : 
     969             : (defvar use-vc-backend)  ;; dynamically bound
     970             : 
     971             : (define-derived-mode vc-dir-mode special-mode "VC dir"
     972             :   "Major mode for VC directory buffers.
     973             : Marking/Unmarking key bindings and actions:
     974             : m - mark a file/directory
     975             :   - if the region is active, mark all the files in region.
     976             :     Restrictions: - a file cannot be marked if any parent directory is marked
     977             :                   - a directory cannot be marked if any child file or
     978             :                     directory is marked
     979             : u - unmark a file/directory
     980             :   - if the region is active, unmark all the files in region.
     981             : M - if the cursor is on a file: mark all the files with the same state as
     982             :       the current file
     983             :   - if the cursor is on a directory: mark all child files
     984             :   - with a prefix argument: mark all files
     985             : U - if the cursor is on a file: unmark all the files with the same state
     986             :       as the current file
     987             :   - if the cursor is on a directory: unmark all child files
     988             :   - with a prefix argument: unmark all files
     989             : mouse-2  - toggles the mark state
     990             : 
     991             : VC commands
     992             : VC commands in the `C-x v' prefix can be used.
     993             : VC commands act on the marked entries.  If nothing is marked, VC
     994             : commands act on the current entry.
     995             : 
     996             : Search & Replace
     997             : S - searches the marked files
     998             : Q - does a query replace on the marked files
     999             : M-s a C-s - does an isearch on the marked files
    1000             : M-s a C-M-s - does a regexp isearch on the marked files
    1001             : If nothing is marked, these commands act on the current entry.
    1002             : When a directory is current or marked, the Search & Replace
    1003             : commands act on the child files of that directory that are displayed in
    1004             : the *vc-dir* buffer.
    1005             : 
    1006             : \\{vc-dir-mode-map}"
    1007           0 :   (set (make-local-variable 'vc-dir-backend) use-vc-backend)
    1008           0 :   (set (make-local-variable 'desktop-save-buffer)
    1009           0 :        'vc-dir-desktop-buffer-misc-data)
    1010           0 :   (setq buffer-read-only t)
    1011           0 :   (when (boundp 'tool-bar-map)
    1012           0 :     (set (make-local-variable 'tool-bar-map) vc-dir-tool-bar-map))
    1013           0 :   (let ((buffer-read-only nil))
    1014           0 :     (erase-buffer)
    1015           0 :     (set (make-local-variable 'vc-dir-process-buffer) nil)
    1016           0 :     (set (make-local-variable 'vc-ewoc) (ewoc-create #'vc-dir-printer))
    1017           0 :     (set (make-local-variable 'revert-buffer-function)
    1018           0 :          'vc-dir-revert-buffer-function)
    1019           0 :     (setq list-buffers-directory (expand-file-name "*vc-dir*" default-directory))
    1020           0 :     (add-to-list 'vc-dir-buffers (current-buffer))
    1021             :     ;; Make sure that if the directory buffer is killed, the update
    1022             :     ;; process running in the background is also killed.
    1023           0 :     (add-hook 'kill-buffer-query-functions 'vc-dir-kill-query nil t)
    1024           0 :     (hack-dir-local-variables-non-file-buffer)
    1025           0 :     (vc-dir-refresh)))
    1026             : 
    1027             : (defun vc-dir-headers (backend dir)
    1028             :   "Display the headers in the *VC dir* buffer.
    1029             : It calls the `dir-extra-headers' backend method to display backend
    1030             : specific headers."
    1031           0 :   (concat
    1032             :    ;; First layout the common headers.
    1033           0 :    (propertize "VC backend : " 'face 'font-lock-type-face)
    1034           0 :    (propertize (format "%s\n" backend) 'face 'font-lock-variable-name-face)
    1035           0 :    (propertize "Working dir: " 'face 'font-lock-type-face)
    1036           0 :    (propertize (format "%s\n" (abbreviate-file-name dir))
    1037           0 :                'face 'font-lock-variable-name-face)
    1038             :    ;; Then the backend specific ones.
    1039           0 :    (vc-call-backend backend 'dir-extra-headers dir)
    1040           0 :    "\n"))
    1041             : 
    1042             : (defun vc-dir-refresh-files (files)
    1043             :   "Refresh some files in the *VC-dir* buffer."
    1044           0 :   (let ((def-dir default-directory)
    1045           0 :         (backend vc-dir-backend))
    1046           0 :     (vc-set-mode-line-busy-indicator)
    1047             :     ;; Call the `dir-status-files' backend function.
    1048             :     ;; `dir-status-files' is supposed to be asynchronous.
    1049             :     ;; It should compute the results, and then call the function
    1050             :     ;; passed as an argument in order to update the vc-dir buffer
    1051             :     ;; with the results.
    1052           0 :     (unless (buffer-live-p vc-dir-process-buffer)
    1053           0 :       (setq vc-dir-process-buffer
    1054           0 :             (generate-new-buffer (format " *VC-%s* tmp status" backend))))
    1055           0 :     (let ((buffer (current-buffer)))
    1056           0 :       (with-current-buffer vc-dir-process-buffer
    1057           0 :         (setq default-directory def-dir)
    1058           0 :         (erase-buffer)
    1059           0 :         (vc-call-backend
    1060           0 :          backend 'dir-status-files def-dir files
    1061             :          (lambda (entries &optional more-to-come)
    1062             :            ;; ENTRIES is a list of (FILE VC_STATE EXTRA) items.
    1063             :            ;; If MORE-TO-COME is true, then more updates will come from
    1064             :            ;; the asynchronous process.
    1065           0 :            (with-current-buffer buffer
    1066           0 :              (vc-dir-update entries buffer)
    1067           0 :              (unless more-to-come
    1068           0 :                (setq mode-line-process nil)
    1069             :                ;; Remove the ones that haven't been updated at all.
    1070             :                ;; Those not-updated are those whose state is nil because the
    1071             :                ;; file/dir doesn't exist and isn't versioned.
    1072           0 :                (ewoc-filter vc-ewoc
    1073             :                             (lambda (info)
    1074             :                               ;; The state for directory entries might
    1075             :                               ;; have been changed to 'up-to-date,
    1076             :                               ;; reset it, otherwise it will be removed when doing 'x'
    1077             :                               ;; next time.
    1078             :                               ;; FIXME: There should be a more elegant way to do this.
    1079           0 :                               (when (and (vc-dir-fileinfo->directory info)
    1080           0 :                                          (eq (vc-dir-fileinfo->state info)
    1081           0 :                                              'up-to-date))
    1082           0 :                                 (setf (vc-dir-fileinfo->state info) nil))
    1083             : 
    1084           0 :                               (not (vc-dir-fileinfo->needs-update info))))))))))))
    1085             : 
    1086             : (defun vc-dir-revert-buffer-function (&optional _ignore-auto _noconfirm)
    1087           0 :   (vc-dir-refresh))
    1088             : 
    1089             : (defun vc-dir-refresh ()
    1090             :   "Refresh the contents of the *VC-dir* buffer.
    1091             : Throw an error if another update process is in progress."
    1092             :   (interactive)
    1093           0 :   (if (vc-dir-busy)
    1094           0 :       (error "Another update process is in progress, cannot run two at a time")
    1095           0 :     (let ((def-dir default-directory)
    1096           0 :           (backend vc-dir-backend))
    1097           0 :       (vc-set-mode-line-busy-indicator)
    1098             :       ;; Call the `dir-status' backend function.
    1099             :       ;; `dir-status' is supposed to be asynchronous.
    1100             :       ;; It should compute the results, and then call the function
    1101             :       ;; passed as an argument in order to update the vc-dir buffer
    1102             :       ;; with the results.
    1103             : 
    1104             :       ;; Create a buffer that can be used by `dir-status' and call
    1105             :       ;; `dir-status' with this buffer as the current buffer.  Use
    1106             :       ;; `vc-dir-process-buffer' to remember this buffer, so that
    1107             :       ;; it can be used later to kill the update process in case it
    1108             :       ;; takes too long.
    1109           0 :       (unless (buffer-live-p vc-dir-process-buffer)
    1110           0 :         (setq vc-dir-process-buffer
    1111           0 :               (generate-new-buffer (format " *VC-%s* tmp status" backend))))
    1112             :       ;; set the needs-update flag on all non-directory entries
    1113           0 :       (ewoc-map (lambda (info)
    1114           0 :                   (unless (vc-dir-fileinfo->directory info)
    1115           0 :                     (setf (vc-dir-fileinfo->needs-update info) t) nil))
    1116           0 :                 vc-ewoc)
    1117             :       ;; Bzr has serious locking problems, so setup the headers first (this is
    1118             :       ;; synchronous) rather than doing it while dir-status is running.
    1119           0 :       (ewoc-set-hf vc-ewoc (vc-dir-headers backend def-dir) "")
    1120           0 :       (let ((buffer (current-buffer)))
    1121           0 :         (with-current-buffer vc-dir-process-buffer
    1122           0 :           (setq default-directory def-dir)
    1123           0 :           (erase-buffer)
    1124           0 :           (vc-call-backend
    1125           0 :            backend 'dir-status-files def-dir nil
    1126             :            (lambda (entries &optional more-to-come)
    1127             :              ;; ENTRIES is a list of (FILE VC_STATE EXTRA) items.
    1128             :              ;; If MORE-TO-COME is true, then more updates will come from
    1129             :              ;; the asynchronous process.
    1130           0 :              (with-current-buffer buffer
    1131           0 :                (vc-dir-update entries buffer)
    1132           0 :                (unless more-to-come
    1133           0 :                  (let ((remaining
    1134           0 :                         (ewoc-collect
    1135           0 :                          vc-ewoc 'vc-dir-fileinfo->needs-update)))
    1136           0 :                    (if remaining
    1137           0 :                        (vc-dir-refresh-files
    1138           0 :                         (mapcar 'vc-dir-fileinfo->name remaining))
    1139           0 :                      (setq mode-line-process nil))))))))))))
    1140             : 
    1141             : (defun vc-dir-show-fileentry (file)
    1142             :   "Insert an entry for a specific file into the current *VC-dir* listing.
    1143             : This is typically used if the file is up-to-date (or has been added
    1144             : outside of VC) and one wants to do some operation on it."
    1145             :   (interactive "fShow file: ")
    1146           0 :   (vc-dir-update (list (list (file-relative-name file) (vc-state file))) (current-buffer)))
    1147             : 
    1148             : (defun vc-dir-hide-state (&optional state)
    1149             :   "Hide items that are in STATE from display.
    1150             : See `vc-state' for valid values of STATE.
    1151             : 
    1152             : If STATE is nil, hide both `up-to-date' and `ignored' items.
    1153             : 
    1154             : Interactively, if `current-prefix-arg' is non-nil, set STATE to
    1155             : state of item at point, if any."
    1156           0 :   (interactive (list
    1157           0 :                 (and current-prefix-arg
    1158             :                      ;; Command is prefixed.  Infer STATE from point.
    1159           0 :                      (let ((node (ewoc-locate vc-ewoc)))
    1160           0 :                        (and node (vc-dir-fileinfo->state (ewoc-data node)))))))
    1161           0 :   (if state
    1162           0 :       (message "Hiding items in state \"%s\"" state)
    1163           0 :     (message "Hiding up-to-date and ignored items"))
    1164           0 :   (let ((crt (ewoc-nth vc-ewoc -1))
    1165           0 :         (first (ewoc-nth vc-ewoc 0)))
    1166             :     ;; Go over from the last item to the first and remove the
    1167             :     ;; up-to-date files and directories with no child files.
    1168           0 :     (while (not (eq crt first))
    1169           0 :       (let* ((data (ewoc-data crt))
    1170           0 :              (dir (vc-dir-fileinfo->directory data))
    1171           0 :              (next (ewoc-next vc-ewoc crt))
    1172           0 :              (prev (ewoc-prev vc-ewoc crt))
    1173             :              ;; ewoc-delete does not work without this...
    1174             :              (inhibit-read-only t))
    1175           0 :         (when (or
    1176             :                ;; Remove directories with no child files.
    1177           0 :                (and dir
    1178           0 :                     (or
    1179             :                      ;; Nothing follows this directory.
    1180           0 :                      (not next)
    1181             :                      ;; Next item is a directory.
    1182           0 :                      (vc-dir-fileinfo->directory (ewoc-data next))))
    1183             :                ;; Remove files in specified STATE.  STATE can be a
    1184             :                ;; symbol, a user-name, or nil.
    1185           0 :                (if state
    1186           0 :                    (equal (vc-dir-fileinfo->state data) state)
    1187           0 :                  (memq (vc-dir-fileinfo->state data) '(up-to-date ignored))))
    1188           0 :           (ewoc-delete vc-ewoc crt))
    1189           0 :         (setq crt prev)))))
    1190             : 
    1191             : (defalias 'vc-dir-hide-up-to-date 'vc-dir-hide-state)
    1192             : 
    1193             : (defun vc-dir-kill-line ()
    1194             :   "Remove the current line from display."
    1195             :   (interactive)
    1196           0 :   (let ((crt (ewoc-locate vc-ewoc))
    1197             :         (inhibit-read-only t))
    1198           0 :     (ewoc-delete vc-ewoc crt)))
    1199             : 
    1200             : (defun vc-dir-printer (fileentry)
    1201           0 :   (vc-call-backend vc-dir-backend 'dir-printer fileentry))
    1202             : 
    1203             : (defun vc-dir-deduce-fileset (&optional state-model-only-files)
    1204           0 :   (let ((marked (vc-dir-marked-files))
    1205             :         files
    1206             :         only-files-list
    1207             :         state
    1208             :         model)
    1209           0 :     (if marked
    1210           0 :         (progn
    1211           0 :           (setq files marked)
    1212           0 :           (when state-model-only-files
    1213           0 :             (setq only-files-list (vc-dir-marked-only-files-and-states))))
    1214           0 :       (let ((crt (vc-dir-current-file)))
    1215           0 :         (setq files (list crt))
    1216           0 :         (when state-model-only-files
    1217           0 :           (setq only-files-list (vc-dir-child-files-and-states)))))
    1218             : 
    1219           0 :     (when state-model-only-files
    1220           0 :       (setq state (cdar only-files-list))
    1221             :       ;; Check that all files are in a consistent state, since we use that
    1222             :       ;; state to decide which operation to perform.
    1223           0 :       (dolist (crt (cdr only-files-list))
    1224           0 :         (unless (vc-compatible-state (cdr crt) state)
    1225           0 :           (error "When applying VC operations to multiple files, the files are required\nto  be in similar VC states.\n%s in state %s clashes with %s in state %s"
    1226           0 :                  (car crt) (cdr crt) (caar only-files-list) state)))
    1227           0 :       (setq only-files-list (mapcar 'car only-files-list))
    1228           0 :       (when (and state (not (eq state 'unregistered)))
    1229           0 :         (setq model (vc-checkout-model vc-dir-backend only-files-list))))
    1230           0 :     (list vc-dir-backend files only-files-list state model)))
    1231             : 
    1232             : ;;;###autoload
    1233             : (defun vc-dir (dir &optional backend)
    1234             :   "Show the VC status for \"interesting\" files in and below DIR.
    1235             : This allows you to mark files and perform VC operations on them.
    1236             : The list omits files which are up to date, with no changes in your copy
    1237             : or the repository, if there is nothing in particular to say about them.
    1238             : 
    1239             : Preparing the list of file status takes time; when the buffer
    1240             : first appears, it has only the first few lines of summary information.
    1241             : The file lines appear later.
    1242             : 
    1243             : Optional second argument BACKEND specifies the VC backend to use.
    1244             : Interactively, a prefix argument means to ask for the backend.
    1245             : 
    1246             : These are the commands available for use in the file status buffer:
    1247             : 
    1248             : \\{vc-dir-mode-map}"
    1249             : 
    1250             :   (interactive
    1251           0 :    (list
    1252             :     ;; When you hit C-x v d in a visited VC file,
    1253             :     ;; the *vc-dir* buffer visits the directory under its truename;
    1254             :     ;; therefore it makes sense to always do that.
    1255             :     ;; Otherwise if you do C-x v d -> C-x C-f -> C-c v d
    1256             :     ;; you may get a new *vc-dir* buffer, different from the original
    1257           0 :     (file-truename (read-directory-name "VC status for directory: "
    1258           0 :                                         (vc-root-dir) nil t
    1259           0 :                                         nil))
    1260           0 :     (if current-prefix-arg
    1261           0 :         (intern
    1262           0 :          (completing-read
    1263             :           "Use VC backend: "
    1264           0 :           (mapcar (lambda (b) (list (symbol-name b)))
    1265           0 :                   vc-handled-backends)
    1266           0 :           nil t nil nil)))))
    1267           0 :   (unless backend
    1268           0 :     (setq backend (vc-responsible-backend dir)))
    1269           0 :   (let (pop-up-windows)               ; based on cvs-examine; bug#6204
    1270           0 :     (pop-to-buffer (vc-dir-prepare-status-buffer "*vc-dir*" dir backend)))
    1271           0 :   (if (derived-mode-p 'vc-dir-mode)
    1272           0 :       (vc-dir-refresh)
    1273             :     ;; FIXME: find a better way to pass the backend to `vc-dir-mode'.
    1274           0 :     (let ((use-vc-backend backend))
    1275           0 :       (vc-dir-mode))))
    1276             : 
    1277             : (defun vc-default-dir-extra-headers (_backend _dir)
    1278             :   ;; Be loud by default to remind people to add code to display
    1279             :   ;; backend specific headers.
    1280             :   ;; XXX: change this to return nil before the release.
    1281           0 :   (concat
    1282           0 :    (propertize "Extra      : " 'face 'font-lock-type-face)
    1283           0 :    (propertize "Please add backend specific headers here.  It's easy!"
    1284           0 :                'face 'font-lock-warning-face)))
    1285             : 
    1286             : (defvar vc-dir-filename-mouse-map
    1287             :    (let ((map (make-sparse-keymap)))
    1288             :      (define-key map [mouse-2] 'vc-dir-find-file-other-window)
    1289             :     map)
    1290             :   "Local keymap for visiting a file.")
    1291             : 
    1292             : (defun vc-default-dir-printer (_backend fileentry)
    1293             :   "Pretty print FILEENTRY."
    1294             :   ;; If you change the layout here, change vc-dir-move-to-goal-column.
    1295             :   ;; VC backends can implement backend specific versions of this
    1296             :   ;; function.  Changes here might need to be reflected in the
    1297             :   ;; vc-BACKEND-dir-printer functions.
    1298           0 :   (let* ((isdir (vc-dir-fileinfo->directory fileentry))
    1299           0 :         (state (if isdir "" (vc-dir-fileinfo->state fileentry)))
    1300           0 :         (filename (vc-dir-fileinfo->name fileentry)))
    1301           0 :     (insert
    1302           0 :      (propertize
    1303           0 :       (format "%c" (if (vc-dir-fileinfo->marked fileentry) ?* ? ))
    1304           0 :       'face 'font-lock-type-face)
    1305             :      "   "
    1306           0 :      (propertize
    1307           0 :       (format "%-20s" state)
    1308           0 :       'face (cond ((eq state 'up-to-date) 'font-lock-builtin-face)
    1309           0 :                   ((memq state '(missing conflict)) 'font-lock-warning-face)
    1310           0 :                   ((eq state 'edited) 'font-lock-constant-face)
    1311           0 :                   (t 'font-lock-variable-name-face))
    1312           0 :       'mouse-face 'highlight)
    1313             :      " "
    1314           0 :      (propertize
    1315           0 :       (format "%s" filename)
    1316             :       'face
    1317           0 :       (if isdir 'font-lock-comment-delimiter-face 'font-lock-function-name-face)
    1318             :       'help-echo
    1319           0 :       (if isdir
    1320             :           "Directory\nVC operations can be applied to it\nmouse-3: Pop-up menu"
    1321           0 :         "File\nmouse-3: Pop-up menu")
    1322             :       'mouse-face 'highlight
    1323           0 :       'keymap vc-dir-filename-mouse-map))))
    1324             : 
    1325             : (defun vc-default-extra-status-menu (_backend)
    1326             :   nil)
    1327             : 
    1328             : (defun vc-default-status-fileinfo-extra (_backend _file)
    1329             :   "Default absence of extra information returned for a file."
    1330             :   nil)
    1331             : 
    1332             : 
    1333             : ;;; Support for desktop.el (adapted from what dired.el does).
    1334             : 
    1335             : (declare-function desktop-file-name "desktop" (filename dirname))
    1336             : 
    1337             : (defun vc-dir-desktop-buffer-misc-data (dirname)
    1338             :   "Auxiliary information to be saved in desktop file."
    1339           0 :   (cons (desktop-file-name default-directory dirname) vc-dir-backend))
    1340             : 
    1341             : (defvar desktop-missing-file-warning)
    1342             : 
    1343             : (defun vc-dir-restore-desktop-buffer (_filename _buffername misc-data)
    1344             :   "Restore a `vc-dir' buffer specified in a desktop file."
    1345           0 :   (let ((dir (car misc-data))
    1346           0 :         (backend (cdr misc-data)))
    1347           0 :     (if (file-directory-p dir)
    1348           0 :         (progn
    1349           0 :           (vc-dir dir backend)
    1350           0 :           (current-buffer))
    1351           0 :       (message "Desktop: Directory %s no longer exists." dir)
    1352           0 :       (when desktop-missing-file-warning (sit-for 1))
    1353           0 :       nil)))
    1354             : 
    1355             : (add-to-list 'desktop-buffer-mode-handlers
    1356             :              '(vc-dir-mode . vc-dir-restore-desktop-buffer))
    1357             : 
    1358             : 
    1359             : (provide 'vc-dir)
    1360             : 
    1361             : ;;; vc-dir.el ends here

Generated by: LCOV version 1.12