PageRenderTime 70ms CodeModel.GetById 2ms app.highlight 56ms RepoModel.GetById 3ms app.codeStats 0ms

/dvc/mode/lisp/dvc-core.el

https://bitbucket.org/atollena/tidyconfig-antoine-packs
Lisp | 1205 lines | 952 code | 149 blank | 104 comment | 41 complexity | 2121e17d30cf9c07615a6c314efca73a MD5 | raw file
   1;;; dvc-core.el --- Core functions for distributed version control
   2
   3;; Copyright (C) 2005-2009 by all contributors
   4
   5;; Author: Stefan Reichoer, <stefan@xsteve.at>
   6;; Contributions From:
   7;;         Matthieu Moy <Matthieu.Moy@imag.fr>
   8
   9;; This file is free software; you can redistribute it and/or modify
  10;; it under the terms of the GNU General Public License as published by
  11;; the Free Software Foundation; either version 3, or (at your option)
  12;; any later version.
  13
  14;; This file is distributed in the hope that it will be useful,
  15;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17;; GNU General Public License for more details.
  18
  19;; You should have received a copy of the GNU General Public License
  20;; along with GNU Emacs; see the file COPYING.  If not, write to
  21;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  22;; Boston, MA 02110-1301, USA.
  23
  24;;; Commentary:
  25
  26;; This file provides the low-level functions used by the DVC interfaces
  27;; to distributed revison control systems.
  28
  29
  30;;; History:
  31
  32;; This file holds general useful functions, previously only used for tla.
  33
  34;;; Code:
  35
  36(require 'dvc-defs)
  37(require 'dvc-register)
  38(eval-and-compile (require 'dvc-utils))
  39(require 'dvc-buffers)
  40(eval-when-compile (require 'cl))
  41(eval-when-compile (require 'dired))
  42(eval-and-compile (require 'dvc-lisp))
  43
  44(defvar dvc-sh-executable "sh" "The shell that is used for dvc interaction.")
  45
  46;; --------------------------------------------------------------------------------
  47;; Various constants
  48;; --------------------------------------------------------------------------------
  49
  50(defconst dvc-mark (dvc-face-add "*" 'dvc-mark) "Fontified string used for marking.")
  51(defconst dvc-exclude (dvc-face-add "E" 'dvc-mark) "Fontified string used for excluded files.")
  52
  53;; --------------------------------------------------------------------------------
  54;; Internal variables
  55;; --------------------------------------------------------------------------------
  56
  57(defvar dvc-memorized-log-header nil)
  58(defvar dvc-memorized-log-message nil)
  59(defvar dvc-memorized-version nil)
  60(defvar dvc-memorized-patch-sender nil)
  61
  62;; --------------------------------------------------------------------------------
  63;; Various helper functions
  64;; --------------------------------------------------------------------------------
  65
  66;; list-buffers-directory is used by uniquify to get the directory for
  67;; the buffer when buffer-file-name is nil, as it is for many dvc
  68;; buffers (dvc-diff-mode, etc). It needs to survive
  69;; kill-all-local-variables, so we declare it permanent local.
  70(make-variable-buffer-local 'list-buffers-directory)
  71(put 'list-buffers-directory 'permanent-local t)
  72
  73(defun dvc-find-tree-root-file-first (file-or-dir &optional location)
  74  "Find FILE-OR-DIR upward in the file system from LOCATION.
  75Finding is continued upward to \"/\" until FILE-OR-DIR can be found.
  76Once FILE-OR-DIR is found, the finding is broken off.
  77A directory which holds FILE-OR-DIR is returned. If no such directory
  78`nil' is returned. `default-directory' is used instead if LOCATION is not
  79given,
  80
  81The resulting directory is guaranteed to end in a \"/\" character.
  82
  83This function may be useful to find \{arch\} and/or _darcs directories."
  84  (let ((pwd (or location default-directory))
  85        (pwd-stack nil)
  86        new-pwd)
  87    (while (not (or (string= pwd "/")
  88                    (member pwd pwd-stack)
  89                    (file-exists-p (concat (file-name-as-directory pwd)
  90                                           file-or-dir))))
  91      (setq pwd-stack (cons pwd pwd-stack))
  92      (setq new-pwd
  93            (dvc-expand-file-name (concat (file-name-as-directory pwd) "..")))
  94
  95      ;; detect MS-Windows roots (c:/, d:/, ...)
  96      (setq pwd (if (string= new-pwd pwd) "/" new-pwd)))
  97
  98    (unless (string= pwd "/")
  99      (setq pwd (replace-regexp-in-string "\\([^:]\\)/*$" "\\1" pwd))
 100      (setq pwd (file-name-as-directory pwd))
 101      (if (memq system-type '(ms-dos windows-nt))
 102          (expand-file-name pwd)
 103        pwd))))
 104
 105(defun dvc-tree-root-helper (file-or-dir interactivep msg
 106                                         &optional location no-error)
 107  "Find FILE-OR-DIR upward in the file system from LOCATION.
 108
 109Calls `dvc-find-tree-root-file-first', shows a message when
 110called interactively, and manages no-error.
 111
 112If LOCATION is nil, the tree root is returned, and it is
 113guaranteed to end in a \"/\" character.
 114
 115MSG must be of the form \"%S is not a ...-managed tree\"."
 116  (let ((location (dvc-uniquify-file-name location)))
 117    (let ((pwd (dvc-find-tree-root-file-first
 118                file-or-dir location)))
 119      (when (and interactivep pwd)
 120        (dvc-trace "%s" pwd))
 121      (or pwd
 122          (if no-error
 123              nil
 124            (error msg
 125                   (or location default-directory)))))))
 126
 127(defun dvc-find-tree-root-file-last (file-or-dir &optional location)
 128  "Like `dvc-find-tree-root-file-upward' but recursively if FILE-OR-DIR is found.
 129Finding is started from LOCATION but is stoped when FILE-OR-DIR cannot be found.
 130Fiddled is continued upward while FILE-OR-DIR can be found.
 131The last found directory which holds FILE-OR-DIR is returned. `nil' is returned
 132if finding failed.
 133`default-directory' is used instead if LOCATION is not given,
 134
 135This function may be useful to find CVS or .svn directories"
 136  (let ((pwd (or location default-directory))
 137        old-pwd)
 138    (while (and pwd (not (string= pwd "/")))
 139      (if (file-exists-p (concat (file-name-as-directory pwd)
 140                                 file-or-dir))
 141          (setq old-pwd pwd
 142                pwd (expand-file-name (concat (file-name-as-directory pwd)
 143                                              "..")))
 144        (setq pwd nil)))
 145    (when old-pwd
 146      (expand-file-name
 147       (replace-regexp-in-string "/+$" "/" old-pwd)))))
 148
 149(defmacro dvc-make-bymouse-function (function)
 150  "Create a new function by adding mouse interface to FUNCTION.
 151The new function is named FUNCTION-by-mouse; and takes one argument,
 152a mouse click event.
 153Thew new function moves the point to the place where mouse is clicked
 154then invoke FUNCTION."
 155  (declare (debug (&define name :name -by-mouse)))
 156  `(defun ,(intern (concat (symbol-name function) "-by-mouse")) (event)
 157     ,(concat "`" (symbol-name function) "'" " with mouse interface.")
 158     (interactive "e")
 159     (mouse-set-point event)
 160     (,function)))
 161
 162;; Adapted from `dired-delete-file' in Emacs 22
 163(defun dvc-delete-recursively (file)
 164  "Delete FILE or directory recursively."
 165  (let (files)
 166    (if (not (eq t (car (file-attributes file))))
 167        (delete-file file)
 168      (when (setq files
 169                  (directory-files
 170                   file t "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))
 171        (while files
 172          (dvc-delete-recursively (car files))
 173          (setq files (cdr files))))
 174      (delete-directory file))))
 175
 176;; --------------------------------------------------------------------------------
 177;; File selection helpers
 178;; --------------------------------------------------------------------------------
 179
 180(defvar dvc-get-file-info-at-point-function nil
 181  "Function used to get the file at point, anywhere.")
 182
 183(defun dvc-get-file-info-at-point ()
 184  "Gets the filename at point, according to mode.
 185Calls the function `dvc-get-file-info-at-point-function' if defined.
 186When in dired mode, return the file where point is.
 187Otherwise return the buffer file name."
 188  (cond (dvc-get-file-info-at-point-function
 189         (funcall dvc-get-file-info-at-point-function))
 190        ((eq major-mode 'dired-mode)
 191         (dired-get-filename))
 192        (t (buffer-file-name))))
 193
 194;;;###autoload
 195(defun dvc-current-file-list (&optional selection-mode)
 196  "Return a list of currently active files.
 197When in dired mode, return the marked files or the file under point.
 198In a legacy DVC mode, return `dvc-buffer-marked-file-list' if non-nil.
 199In a fileinfo DVC mode, return `dvc-fileinfo-marked-files'.
 200otherwise the result depends on SELECTION-MODE:
 201* When 'nil-if-none-marked, return nil.
 202* When 'all-if-none-marked, return all files.
 203* Otherwise return result of calling `dvc-get-file-info-at-point'."
 204  (cond
 205   ((eq major-mode 'dired-mode)
 206    (dired-get-marked-files))
 207
 208   ((dvc-derived-mode-p 'dvc-diff-mode 'dvc-status-mode)
 209    (or (remove nil dvc-buffer-marked-file-list)
 210        (dvc-fileinfo-marked-files)
 211        (cond
 212         ((eq selection-mode 'nil-if-none-marked)
 213          nil)
 214
 215         ((eq selection-mode 'all-if-none-marked)
 216          (dvc-fileinfo-all-files))
 217
 218         (t (list (dvc-get-file-info-at-point))))))
 219
 220   ((eq major-mode 'dvc-bookmark-mode)
 221    (cond
 222     ((eq selection-mode 'nil-if-none-marked)
 223      nil)
 224
 225     (t
 226      (error "selection-mode %s not implemented for dvc bookmark buffer" selection-mode))))
 227
 228   ;; If other modes are added here, dvc-log-edit must be updated to
 229   ;; support them as well.
 230
 231   (t
 232    ;; Some other mode. We assume it has no notion of "marked files",
 233    ;; so there are none marked. The only file name available is
 234    ;; buffer-file-name, so we could just return that. But some DVC
 235    ;; mode might set dvc-get-file-info-at-point-function without
 236    ;; updating this function, so support that.
 237    (if (eq selection-mode 'nil-if-none-marked)
 238        nil
 239      (list (dvc-get-file-info-at-point))))))
 240
 241(defun dvc-confirm-read-file-name (prompt &optional mustmatch file-name default-filename)
 242  "A wrapper around `read-file-name' that provides some useful defaults."
 243  (unless file-name
 244    (setq file-name (dvc-get-file-info-at-point)))
 245  (read-file-name prompt
 246                  (file-name-directory (or file-name ""))
 247                  default-filename
 248                  mustmatch
 249                  (file-name-nondirectory (or file-name ""))))
 250
 251(defun dvc-confirm-read-file-name-list (prompt &optional files single-prompt mustmatch)
 252  (or
 253   (if dvc-test-mode files)
 254   (let ((num-files (length files)))
 255     (if (= num-files 1)
 256         (let ((confirmed-file-name
 257                (dvc-confirm-read-file-name single-prompt mustmatch (car files))))
 258           ;; I don't think `dvc-confirm-read-file-name' can return nil.
 259           (assert confirmed-file-name)
 260           (list confirmed-file-name))
 261       (and (y-or-n-p (format prompt num-files))
 262            files)))))
 263
 264(defcustom dvc-confirm-file-op-method 'y-or-n-p
 265  "Function to use for confirming file-based DVC operations.
 266Some valid options are:
 267y-or-n-p: Prompt for 'y' or 'n' keystroke.
 268yes-or-no-p: Prompt for \"yes\" or \"no\" string.
 269dvc-always-true: Do not display a prompt."
 270  :type 'function
 271  :group 'dvc)
 272
 273(defun dvc-always-true (&rest ignore)
 274  "Do nothing and return t.
 275This function accepts any number of arguments, but ignores them."
 276  (interactive)
 277  t)
 278
 279(defun dvc-confirm-file-op (operation files confirm)
 280  "Confirm OPERATION (a string, used in prompt) on FILE (list of strings).
 281If CONFIRM is nil, just return FILES (no prompt).
 282Returns FILES, or nil if not confirmed.
 283
 284If you want to adjust the function called to confirm the
 285operation, then customize the `dvc-confirm-file-op-method' function."
 286  (or
 287   ;; Allow bypassing confirmation with `dvc-test-mode'. See
 288   ;; tests/xmtn-tests.el dvc-status-add.
 289   (if dvc-test-mode files)
 290   ;; Abstracted from pcvs.el cvs-do-removal
 291   (if (not confirm)
 292       files
 293     (let ((nfiles (length files)))
 294       (if (funcall (or (and (functionp dvc-confirm-file-op-method)
 295                             dvc-confirm-file-op-method)
 296                        'y-or-n-p)
 297                    (if (= 1 nfiles)
 298                        (format "%s file: \"%s\" ? "
 299                                operation
 300                                (car files))
 301                      (format "%s %d files? "
 302                              operation
 303                              nfiles)))
 304           files
 305         nil)))))
 306
 307(defun dvc-dvc-files-to-commit ()
 308  ;;todo: set the correct modifier, one of dvc-modified, dvc-added, dvc-move, now use only nil
 309  ;; FIXME: this is only used by dvc-log-insert-commit-file-list; should just merge this code there.
 310  (let ((files
 311         (with-current-buffer dvc-partner-buffer (dvc-current-file-list 'all-if-none-marked))))
 312    (mapcar (lambda (arg) (cons nil arg)) files)))
 313
 314(defun dvc-find-file-at-point ()
 315  "Opens the file at point.
 316The filename is obtained with `dvc-get-file-info-at-point'."
 317  (interactive)
 318  (let* ((file (dvc-get-file-info-at-point)))
 319    (cond
 320     ((not file)
 321      (error "No file at point"))
 322     (t
 323      (find-file file)))))
 324
 325(dvc-make-bymouse-function dvc-find-file-at-point)
 326
 327(defun dvc-find-file-other-window ()
 328  "Visit the current file in the other window.
 329The filename is obtained with `dvc-get-file-info-at-point'."
 330  (interactive)
 331  (let ((file (dvc-get-file-info-at-point)))
 332    (if file
 333        (progn
 334          (find-file-other-window file))
 335      (error "No file at point"))))
 336
 337(defun dvc-view-file ()
 338  "Visit the current file in `view-mode'.
 339The filename is obtained with `dvc-get-file-info-at-point'."
 340  (interactive)
 341  (let ((file (dvc-get-file-info-at-point)))
 342    (if file
 343        (view-file-other-window file)
 344      (error "No file at point"))))
 345
 346(defun dvc-dired-jump ()
 347  "Jump to a dired buffer, containing the file at point."
 348  (interactive)
 349  (let ((file-full-path (expand-file-name (or (dvc-get-file-info-at-point) ""))))
 350    (let ((default-directory (file-name-directory file-full-path)))
 351      (dvc-funcall-if-exists dired-jump))
 352    (dired-goto-file file-full-path)))
 353
 354(defun dvc-purge-files (&rest files)
 355  "Delete FILES from the harddisk. No backup is created for these FILES.
 356These function bypasses the used revision control system."
 357  (interactive (dvc-current-file-list))
 358  (let ((multiprompt (format "Are you sure to purge %%d files? "))
 359        (singleprompt (format "Purge file: ")))
 360    (when (dvc-confirm-read-file-name-list multiprompt files singleprompt nil)
 361      (mapcar #'delete-file files)
 362      (message "Purged %S" files))))
 363
 364(defun dvc-current-executable ()
 365  "Return the name of the binary associated with the current dvc backend.
 366This uses `dvc-current-active-dvc'.
 367
 368\"DVC\" is returned if `dvc-current-active-dvc' returns nil."
 369  (let ((dvc (dvc-current-active-dvc)))
 370    (if (not dvc)
 371        "DVC"
 372      (dvc-variable dvc "executable"))))
 373
 374;; partner buffer stuff
 375(defvar dvc-partner-buffer nil
 376  "DVC Partner buffer; stores diff buffer for log-edit, etc.
 377Local to each buffer, not killed by kill-all-local-variables.")
 378(make-variable-buffer-local 'dvc-partner-buffer)
 379(put 'dvc-partner-buffer 'permanent-local t)
 380
 381(defun dvc-buffer-pop-to-partner-buffer ()
 382  "Pop to dvc-partner-buffer, if available."
 383  (interactive)
 384  (if (and (boundp 'dvc-partner-buffer) dvc-partner-buffer)
 385      (if (buffer-live-p dvc-partner-buffer)
 386          (pop-to-buffer dvc-partner-buffer)
 387        (message "Partner buffer has been killed"))
 388    (message "No partner buffer set for this buffer.")))
 389
 390
 391(defmacro dvc-with-keywords (keywords plist &rest body)
 392  "Execute a body of code with keywords bound.
 393Each keyword listed in KEYWORDS is bound to its value from PLIST, then
 394BODY is evaluated."
 395  (declare (indent 1) (debug (sexp form body)))
 396  (flet ((keyword-to-symbol (keyword)
 397                            (intern (substring (symbol-name keyword) 1))))
 398    (let ((keyword (make-symbol "keyword"))
 399          (default (make-symbol "default")))
 400      `(let ,(mapcar (lambda (keyword-entry)
 401                       (keyword-to-symbol (if (consp keyword-entry)
 402                                              (car keyword-entry)
 403                                            keyword-entry)))
 404                     keywords)
 405         (dolist (keyword-entry ',keywords)
 406           (let ((,keyword (if (consp keyword-entry)
 407                               (car keyword-entry)
 408                             keyword-entry))
 409                 (,default (if (consp keyword-entry)
 410                               (cadr keyword-entry)
 411                             nil)))
 412             (set (intern (substring (symbol-name ,keyword) 1))
 413                  (or (cadr (member ,keyword ,plist))
 414                      ,default))))
 415         ,@body))))
 416
 417
 418;; ----------------------------------------------------------------------------
 419;; Process management
 420;; ----------------------------------------------------------------------------
 421
 422;; Candidates for process handlers
 423(defun dvc-default-error-function (output error status arguments)
 424  "Default function called when a DVC process ends with a non-zero status.
 425OUTPUT is the buffer containing process standard output.
 426ERROR is the buffer containing process error output.
 427STATUS indicates the return status of the program.
 428ARGUMENTS is a list of the arguments that the process was called with."
 429  (if (> (with-current-buffer error (point-max)) 1)
 430      (dvc-show-error-buffer error)
 431    (if (> (with-current-buffer output (point-max)) 1)
 432        (dvc-show-error-buffer output)
 433      (error "`%s %s' failed with code %d and no output!"
 434             (dvc-current-executable)
 435             (mapconcat 'identity arguments " ")
 436             status)))
 437  (error "`%s %s' failed with code %d"
 438         (dvc-current-executable)
 439         (mapconcat 'identity arguments " ")
 440         status))
 441
 442(defvar dvc-default-killed-function-noerror 0
 443  "The number of killed processes we will ignore until throwing an error.
 444If the value is 0, `dvc-default-killed-function' will throw an error.
 445See `dvc-default-killed-function'.")
 446
 447(defun dvc-default-killed-function (output error status arguments)
 448  "Default function called when a DVC process is killed.
 449OUTPUT is the buffer containing process standard output.
 450ERROR is the buffer containing process error output.
 451STATUS indicates the return status of the program.
 452ARGUMENTS is a list of the arguments that the process was called with."
 453  (if (> dvc-default-killed-function-noerror 0)
 454      (setq dvc-default-killed-function-noerror
 455            (- dvc-default-killed-function-noerror 1))
 456    (dvc-switch-to-buffer error)
 457    (error "`%s %s' process killed !"
 458           (dvc-current-executable)
 459           (mapconcat 'identity arguments " "))))
 460
 461(defun dvc-null-handler (output error status arguments)
 462  "Handle a finished process without doing anything.
 463Candidate as an argument for one of the keywords :finished, :error or :killed
 464in `dvc-run-dvc-sync' or `dvc-run-dvc-async'.
 465OUTPUT is the buffer containing process standard output.
 466ERROR is the buffer containing process error output.
 467STATUS indicates the return status of the program.
 468ARGUMENTS is a list of the arguments that the process was called with."
 469  nil)
 470
 471(defun dvc-status-handler (output error status arguments)
 472  "Return an integer value that reflects the process status.
 473Candidate as an argument for one of the keywords :finished, :error or :killed
 474in `dvc-run-dvc-sync' or `dvc-run-dvc-async'.
 475OUTPUT is the buffer containing process standard output.
 476ERROR is the buffer containing process error output.
 477STATUS indicates the return status of the program.
 478ARGUMENTS is a list of the arguments that the process was called with."
 479  (cond ((numberp status) status)
 480        ((string-match "^exited abnormally with code \\(.*\\)" status)
 481         (string-to-number (match-string 1)))
 482        (t (error status))))
 483
 484(defun dvc-output-buffer-handler (output error status arguments)
 485  "Return the output of a finished process, stripping any trailing newline.
 486OUTPUT is the buffer containing process standard output.
 487ERROR is the buffer containing process error output.
 488STATUS indicates the return status of the program.
 489ARGUMENTS is a list of the arguments that the process was called with."
 490  (dvc-buffer-content output))
 491
 492(defun dvc-output-buffer-handler-withnewline (output error status arguments)
 493  "Same as dvc-output-buffer-handler, but keep potential final newline."
 494  (with-current-buffer output (buffer-string)))
 495
 496(defun dvc-output-and-error-buffer-handler (output error status arguments)
 497  "Return the output of a finished process, stripping any trailing newline.
 498OUTPUT is the buffer containing process standard output.
 499ERROR is the buffer containing process error output.
 500STATUS indicates the return status of the program.
 501ARGUMENTS is a list of the arguments that the process was called with."
 502  (concat (dvc-buffer-content output)
 503          (dvc-buffer-content error)))
 504
 505(defun dvc-output-buffer-split-handler (output error status arguments)
 506  "Return the output of a finished process as a list of lines.
 507OUTPUT is the buffer containing process standard output.
 508ERROR is the buffer containing process error output.
 509STATUS indicates the return status of the program.
 510ARGUMENTS is a list of the arguments that the process was called with."
 511  (split-string (dvc-buffer-content output) "\n"))
 512
 513(defun dvc-default-finish-function (output error status arguments)
 514  "Default function called when a DVC process terminates.
 515OUTPUT is the buffer containing process standard output.
 516ERROR is the buffer containing process error output.
 517STATUS indicates the return status of the program.
 518ARGUMENTS is a list of the arguments that the process was called with."
 519  (let ((has-output))
 520    (with-current-buffer output
 521      (dvc-process-buffer-mode)
 522      (setq has-output (> (point-max) 1)))
 523    (when has-output
 524      (dvc-switch-to-buffer output))
 525    (when (or dvc-debug has-output)
 526      (message "Process `%s %s' finished"
 527               (dvc-current-executable)
 528               (mapconcat 'identity arguments " ")))
 529    status))
 530
 531(defun dvc-finish-function-without-buffer-switch (output error status arguments)
 532  "Similar to `dvc-default-finish-function' but no buffer switch.
 533OUTPUT is the buffer containing process standard output.
 534ERROR is the buffer containing process error output.
 535STATUS indicates the return status of the program.
 536ARGUMENTS is a list of the arguments that the process was called
 537  with."
 538  (with-current-buffer output
 539    (dvc-trace "Process `%s %s' finished"
 540               (dvc-current-executable)
 541               (mapconcat 'identity arguments " "))
 542    status))
 543
 544(defvar dvc-process-running nil
 545  "List of DVC processes running.
 546A value of nil indicates no processes are running.
 547
 548The list is a list of pairs (process event) where EVENT is the event
 549corresponding to the beginning of the execution of process.  It can be
 550used to get more info about the process.")
 551
 552(defun dvc-build-dvc-command (dvc list-args)
 553  "Build a shell command to run DVC with args LIST-ARGS.
 554DVC can be one of 'baz, 'xhg, ..."
 555  (let ((executable (executable-find (dvc-variable dvc "executable"))))
 556    ;; 'executable-find' allows leading ~
 557    (if (not executable)
 558        (error "executable for %s not found" (symbol-name dvc)))
 559    (mapconcat 'shell-quote-argument
 560               (cons executable
 561                     (remq nil list-args))
 562               " ")))
 563
 564(defcustom dvc-password-prompt-regexp
 565  "[Pp]ass\\(word\\|phrase\\).*:\\s *\\'"
 566  "*Regexp matching prompts for passwords in the inferior process."
 567  :type 'regexp
 568  :group 'dvc)
 569
 570(defun dvc-process-filter (proc string &optional no-insert)
 571  "Filter PROC's STRING.
 572Prompt for password with `read-passwd' if the output of PROC matches
 573`dvc-password-prompt-regexp'.
 574
 575If NO-INSERT is non-nil, do not insert the string.
 576
 577In all cases, a new string is returned after normalizing newlines."
 578  (with-current-buffer (process-buffer proc)
 579    (setq string (replace-regexp-in-string "\015" "\n" string))
 580    (unless no-insert
 581      (goto-char (process-mark proc))
 582      (insert string)
 583      (set-marker (process-mark proc) (point)))
 584    (when (string-match dvc-password-prompt-regexp string)
 585      (string-match "^\\([^\n]+\\)\n*\\'" string)
 586      (let ((passwd (read-passwd (match-string 1 string))))
 587        (process-send-string proc (concat passwd "\n"))))
 588    string))
 589
 590(defun dvc-prepare-environment (env)
 591  "By default, do not touch the environment"
 592  env)
 593
 594(defun dvc-default-global-argument ()
 595  "By default, no global argument."
 596  nil)
 597
 598(defun dvc-run-dvc-async (dvc arguments &rest keys)
 599  "Run a process asynchronously.
 600Current directory for the process is the current `default-directory'.
 601ARGUMENTS is a list of arguments.  nil values in this list are removed.
 602KEYS is a list of keywords and values.  Possible keywords are:
 603
 604 :finished ....... Function run when the process finishes.  If none
 605                   specified, `dvc-default-finish-function' is run.
 606
 607 :killed ......... Function run when the process is killed.  If none
 608                   specified, `dvc-default-killed-function' is run.
 609
 610 :error .......... Function run when the process exits with a non 0
 611                   status.  If none specified,
 612                   `dvc-default-error-function' is run.
 613
 614All these functions take 4 arguments : output, error, status, and
 615arguments.
 616
 617   - \"output\" is the output buffer
 618   - \"error\" is the buffer where standard error is redirected
 619   - \"status\" is the numeric exit-status or the signal number
 620   - \"arguments\" is the list of arguments, as a list of strings,
 621              like '(\"changes\" \"--diffs\")
 622
 623   `dvc-null-handler' can be used here if there's nothing to do.
 624
 625 :filter           Function to call every time we receive output from
 626                   the process.  It should take arguments proc and string.
 627                   The string will have been run through
 628                   `dvc-process-filter' to deal with password prompts and
 629                   newlines.
 630
 631 :output-buffer .. Buffer where the output of the process should be
 632                   redirected.  If none specified, a new one is
 633                   created, and will be entered in
 634                   `dvc-dead-process-buffer-queue' to be killed
 635                   later.
 636
 637 :error-buffer ... Buffer where the standard error of the process
 638                   should be redirected.
 639
 640 :related-buffer . Defaults to `current-buffer'.  This is the buffer
 641                   where the result of the process will be used.  If
 642                   this buffer is killed before the end of the
 643                   execution, the user is prompted if he wants to kill
 644                   the process."
 645  (dvc-with-keywords
 646      (:finished :killed :error :filter
 647                 :output-buffer :error-buffer :related-buffer)
 648    keys
 649    (let* ((output-buf (or (and output-buffer
 650                                (get-buffer-create output-buffer))
 651                           (dvc-new-process-buffer nil dvc)))
 652           (error-buf  (or (and error-buffer (get-buffer-create error-buffer))
 653                           (dvc-new-error-buffer nil dvc)))
 654           (error-file (dvc-make-temp-name "dvc-errors"))
 655           (global-arg (funcall (dvc-function dvc "default-global-argument")))
 656           (command (dvc-build-dvc-command
 657                     dvc (append global-arg arguments)))
 658           ;; Make the `default-directory' unique. The trailing slash
 659           ;; may be necessary in some cases.
 660           (default-directory (dvc-uniquify-file-name default-directory))
 661           (process
 662            (let ((process-environment
 663                   (funcall (dvc-function dvc "prepare-environment")
 664                            process-environment)))
 665              (with-current-buffer output-buf
 666                ;; process filter will need to know which dvc to run
 667                ;; if there is a choice
 668                (setq dvc-buffer-current-active-dvc dvc))
 669
 670              ;; `start-process' sends both stderr and stdout to
 671              ;; `output-buf'. But we want to keep stderr separate. So
 672              ;; we use a shell to redirect stderr before Emacs sees
 673              ;; it. Note that this means we require "sh" even on
 674              ;; MS Windows.
 675              (start-process
 676               (dvc-variable dvc "executable") output-buf
 677               dvc-sh-executable "-c"
 678               (format "%s 2> %s"
 679                       command error-file))))
 680           (process-event
 681            (list process
 682                  (dvc-log-event output-buf
 683                                 error-buf
 684                                 command
 685                                 default-directory "started"))))
 686      (with-current-buffer (or related-buffer (current-buffer))
 687        (dvc-trace "Running process `%s' in `%s'" command default-directory)
 688        (add-to-list 'dvc-process-running process-event)
 689        (set-process-filter
 690         process
 691         (if (not filter)
 692             'dvc-process-filter
 693           (dvc-capturing-lambda (proc string)
 694             (funcall (capture filter)
 695                      proc
 696                      (dvc-process-filter proc string t)))))
 697        (set-process-sentinel
 698         process
 699         (dvc-capturing-lambda (process event)
 700           (let ((default-directory (capture default-directory)))
 701             (dvc-log-event (capture output-buf) (capture error-buf)
 702                            (capture command)
 703                            (capture default-directory)
 704                            (dvc-strip-final-newline event))
 705             (setq dvc-process-running
 706                   (delq (capture process-event) dvc-process-running))
 707             (when (file-exists-p (capture error-file))
 708               (with-current-buffer (capture error-buf)
 709                 (insert-file-contents (capture error-file)))
 710               (delete-file (capture error-file)))
 711             (let ((state (process-status process))
 712                   (status (process-exit-status process))
 713                   (dvc-temp-current-active-dvc (capture dvc)))
 714               (unwind-protect
 715                   (cond ((and (eq state 'exit) (= status 0))
 716                          (funcall (or (capture finished)
 717                                       'dvc-default-finish-function)
 718                                   (capture output-buf) (capture error-buf)
 719                                   status (capture arguments)))
 720                         ((eq state 'signal)
 721                          (funcall (or (capture killed)
 722                                       'dvc-default-killed-function)
 723                                   (capture output-buf) (capture error-buf)
 724                                   status (capture arguments)))
 725                         ((eq state 'exit) ;; status != 0
 726                          (funcall (or (capture error)
 727                                       'dvc-default-error-function)
 728                                   (capture output-buf) (capture error-buf)
 729                                   status (capture arguments)))))
 730               ;; Schedule any buffers we created for killing
 731               (unless (capture output-buffer)
 732                 (dvc-kill-process-buffer (capture output-buf)))
 733               (unless (capture error-buffer)
 734                 (dvc-kill-process-buffer (capture error-buf)))))))
 735        process))))
 736
 737(defun dvc-run-dvc-sync (dvc arguments &rest keys)
 738  "Run DVC synchronously.
 739See `dvc-run-dvc-async' for details on possible ARGUMENTS and KEYS."
 740  (dvc-with-keywords
 741      (:finished :killed :error :output-buffer :error-buffer :related-buffer)
 742    keys
 743    (let* ((output-buf (or (and output-buffer
 744                                (get-buffer-create output-buffer))
 745                           (dvc-new-process-buffer t dvc)))
 746           (error-buf  (or (and error-buffer (get-buffer-create error-buffer))
 747                           (dvc-new-error-buffer t dvc)))
 748           (global-arg (funcall (dvc-function dvc "default-global-argument")))
 749           (command (dvc-build-dvc-command
 750                     dvc (append global-arg arguments)))
 751           (arguments (remq nil arguments))
 752           (error-file (dvc-make-temp-name "arch-errors"))
 753           ;; Make the `default-directory' unique. The trailing slash
 754           ;; may be necessary in some cases.
 755           (default-directory (dvc-uniquify-file-name default-directory)))
 756      (with-current-buffer (or related-buffer (current-buffer))
 757        (dvc-log-event output-buf error-buf command default-directory
 758                       "started")
 759        (let ((status (let ((process-environment
 760                             (funcall (dvc-function dvc "prepare-environment")
 761                                      process-environment)))
 762                        (call-process dvc-sh-executable nil output-buf nil "-c"
 763                                      (format "%s 2> %s"
 764                                              command
 765                                              error-file)))))
 766          (when (file-exists-p error-file)
 767            (with-current-buffer error-buf
 768              (insert-file-contents error-file))
 769            (delete-file error-file))
 770          (unwind-protect
 771              (let ((dvc-temp-current-active-dvc dvc))
 772                (cond ((stringp status)
 773                       (when (string= status "Terminated")
 774                         (funcall (or killed 'dvc-default-killed-function)
 775                                  output-buf error-buf status arguments)))
 776                      ((numberp status)
 777                       (if (zerop status)
 778                           (funcall (or finished 'dvc-default-finish-function)
 779                                    output-buf error-buf status arguments)
 780                         (funcall (or error 'dvc-default-error-function)
 781                                  output-buf error-buf status arguments)))
 782                      (t (message "Unknown status - %s" status))))
 783            ;; Schedule any buffers we created for killing
 784            (unless output-buffer (dvc-kill-process-buffer output-buf))
 785            (unless error-buffer (dvc-kill-process-buffer error-buf))))))))
 786
 787(defun dvc-processes-related-to-buffer (buffer)
 788  "Returns a list of DVC process whose related buffer is BUFFER."
 789  (let ((accu nil))
 790    (dolist (entry dvc-process-running)
 791      (when (eq (dvc-event-related-buffer (cadr entry)) buffer)
 792        (push (car entry) accu)))
 793    (setq accu (nreverse accu))
 794    accu))
 795
 796(defun dvc-kill-process-maybe (buffer)
 797  "Prompts and possibly kill process whose related buffer is BUFFER."
 798  ;; FIXME: It would be reasonable to run this here, to give any
 799  ;;  process one last chance to run. But somehow this screws up
 800  ;;  package-maint-clean-some-elc. (accept-process-output)
 801  (let* ((processes (dvc-processes-related-to-buffer buffer))
 802         (l (length processes)))
 803    (when (and processes
 804               (y-or-n-p (format "%s process%s running in buffer %s.  Kill %s? "
 805                                 l (if (= l 1) "" "es")
 806                                 (buffer-name buffer)
 807                                 (if (= l 1) "it" "them"))))
 808      (dolist (process processes)
 809        (when (eq (process-status process) 'run)
 810          (incf dvc-default-killed-function-noerror)
 811          (kill-process process)))))
 812  ;; make sure it worked
 813  (let ((processes (dvc-processes-related-to-buffer buffer)))
 814    (when processes
 815      (error "Process still running in buffer %s" buffer))))
 816
 817(add-hook 'kill-buffer-hook 'dvc-kill-buffer-function)
 818
 819(defun dvc-kill-buffer-function ()
 820  "Function run when a buffer is killed."
 821  (dvc-buffers-tree-remove (current-buffer))
 822  (dvc-kill-process-maybe (current-buffer)))
 823
 824(defun dvc-run-dvc-display-as-info (dvc arg-list &optional show-error-buffer info-string asynchron)
 825  "Call either `dvc-run-dvc-async' or `dvc-run-dvc-sync' and display the result in an info buffer.
 826When INFO-STRING is given, insert it at the buffer beginning."
 827  (let ((buffer (dvc-get-buffer-create dvc 'info)))
 828    (funcall (if asynchron 'dvc-run-dvc-async 'dvc-run-dvc-sync) dvc arg-list
 829             :finished
 830             (dvc-capturing-lambda (output error status arguments)
 831               (progn
 832                 (with-current-buffer (capture buffer)
 833                   (let ((inhibit-read-only t))
 834                     (erase-buffer)
 835                     (dvc-info-buffer-mode)
 836                     (when (capture info-string)
 837                       (insert (capture info-string)))
 838                     (insert-buffer-substring output)
 839                     (when (capture show-error-buffer)
 840                       (insert-buffer-substring error))
 841                     (toggle-read-only 1)))
 842                 (dvc-switch-to-buffer (capture buffer)))))))
 843
 844(defvar dvc-info-buffer-mode-map
 845  (let ((map (make-sparse-keymap)))
 846    (define-key map (dvc-prefix-buffer ?L) 'dvc-open-internal-log-buffer)
 847    (define-key map dvc-keyvec-quit 'dvc-buffer-quit)
 848    map)
 849  "Keymap used in a dvc info buffer.")
 850
 851(define-derived-mode dvc-info-buffer-mode fundamental-mode
 852  "DVC info mode"
 853  "Major mode for dvc info buffers"
 854  (dvc-install-buffer-menu)
 855  (toggle-read-only 1))
 856
 857
 858(defvar dvc-log-cookie nil)
 859
 860(defstruct (dvc-event) output-buffer error-buffer related-buffer
 861  command tree event time)
 862
 863(defsubst dvc-log-printer-print-buffer (buffer function)
 864  "Helper function for `dvc-log-printer'.
 865Print a buffer filed for BUFFER during printing a log event.
 866The printed name of BUFFER is mouse sensitive.  If the user
 867clicks it, FUNCTION is invoked."
 868  (let ((alive-p (buffer-live-p buffer))
 869        map)
 870    (dvc-face-add
 871     (or
 872      ;; pp-to-string is very costly.
 873      ;; Handle the typical case with hard-coding.
 874      (unless alive-p "#<killed buffer>")
 875      ;; Normal case.
 876      (buffer-name buffer)
 877      ;; Extra case.
 878      (pp-to-string buffer))
 879     'dvc-buffer
 880     (when alive-p
 881       (setq map (make-sparse-keymap))
 882       (define-key map [mouse-2] function)
 883       map)
 884     nil
 885     "Show the buffer")))
 886
 887(defun dvc-log-recently-p (elem limit-minute)
 888  "Check ELEM recorded a recent event or not.
 889Return nil If ELEM recorded an event older than LIMIT-MINUTE.
 890Else return t."
 891  (let* ((recorded (dvc-event-time elem))
 892         (cur      (current-time))
 893         (diff-minute (/ (+ (* 65536 (- (nth 0 cur)
 894                                        (nth 0 recorded)))
 895                            (- (nth 1 cur)
 896                               (nth 1 recorded)))
 897                         60)))
 898    (if (> limit-minute diff-minute)
 899        t
 900      nil)))
 901
 902(defun dvc-log-printer (elem)
 903  "Arch event printer which prints ELEM."
 904  (let ((event (dvc-event-event elem))
 905        (p (point)))
 906    (insert
 907     "Command: " (dvc-event-command elem)
 908     "\nDirectory: " (dvc-face-add (or (dvc-event-tree elem) "(nil)")
 909                                   'dvc-local-directory)
 910     "\nDate: " (format-time-string "%c" (dvc-event-time elem))
 911     "\nRelated Buffer: " (dvc-log-printer-print-buffer
 912                           (dvc-event-related-buffer elem)
 913                           'dvc-switch-to-related-buffer-by-mouse)
 914     "\nOutput Buffer: "  (dvc-log-printer-print-buffer
 915                           (dvc-event-output-buffer elem)
 916                           'dvc-switch-to-output-buffer-by-mouse)
 917     "\nError Buffer: "   (dvc-log-printer-print-buffer
 918                           (dvc-event-error-buffer elem)
 919                           'dvc-switch-to-error-buffer-by-mouse)
 920     (if (not (string= event "started"))
 921         (concat "\nEvent: " event)
 922       "")
 923     "\n")
 924    ;; Reflect the point to `default-directory'.
 925    ;; NOTE: XEmacs doesn't have `point-entered' special text property.
 926    (put-text-property
 927     p (point)
 928     'point-entered (lambda (old new)
 929                      (setq default-directory
 930                            (dvc-event-tree
 931                             (ewoc-data
 932                              (ewoc-locate dvc-log-cookie))))))))
 933
 934(defmacro dvc-switch-to-buffer-macro (function accessor)
 935  "Define a FUNCTION for switching to the buffer associated with some event.
 936ACCESSOR is a function for retrieving the appropriate buffer from a
 937`dvc-event' structure."
 938  (declare (debug (&define name symbolp)))
 939  `(defun ,function ()
 940     "In a log buffer, pops to the output or error buffer corresponding to the
 941process at point"
 942     (interactive)
 943     (let ((buffer (,accessor
 944                    (ewoc-data (ewoc-locate dvc-log-cookie)))))
 945       (cond ((buffer-live-p buffer)
 946              (dvc-switch-to-buffer buffer)
 947              (unless (member buffer
 948                              (mapcar (lambda (p)
 949                                        (process-buffer (car p)))
 950                                      dvc-process-running))
 951                (dvc-process-buffer-mode)))
 952             (t (error "Buffer has been killed"))))))
 953
 954(dvc-switch-to-buffer-macro dvc-switch-to-output-buffer
 955                            dvc-event-output-buffer)
 956
 957(dvc-switch-to-buffer-macro dvc-switch-to-error-buffer
 958                            dvc-event-error-buffer)
 959
 960(dvc-switch-to-buffer-macro dvc-switch-to-related-buffer
 961                            dvc-event-related-buffer)
 962
 963(dvc-make-bymouse-function dvc-switch-to-output-buffer)
 964(dvc-make-bymouse-function dvc-switch-to-error-buffer)
 965(dvc-make-bymouse-function dvc-switch-to-related-buffer)
 966
 967(defun dvc-log-event (output error command tree event)
 968  "Log an event in the `dvc-log-buffer' buffer.
 969OUTPUT is the buffer containing process standard output.
 970ERROR is the buffer containing process error output.
 971COMMAND is the command that was executed.
 972TREE is the process's working directory.
 973EVENT is the event that occurred.
 974Returns that event."
 975  (unless (and dvc-log-cookie
 976               (buffer-live-p (ewoc-buffer dvc-log-cookie)))
 977    (with-current-buffer (get-buffer-create dvc-log-buffer)
 978      (setq dvc-log-cookie
 979            (ewoc-create (dvc-ewoc-create-api-select
 980                          #'dvc-log-printer)))
 981      (dvc-log-buffer-mode)))
 982  (let ((related-buffer (current-buffer)))
 983    (with-current-buffer (ewoc-buffer dvc-log-cookie)
 984      (let ((elem (make-dvc-event :output-buffer output
 985                                  :error-buffer error
 986                                  :related-buffer related-buffer
 987                                  :command command
 988                                  :tree tree
 989                                  :event event
 990                                  :time (current-time)))
 991            buffer-read-only)
 992        (ewoc-enter-last dvc-log-cookie elem)
 993        ;; If an event is too old (30 minutes after it has been
 994        ;; recorded), throw it away.
 995        (ewoc-filter dvc-log-cookie 'dvc-log-recently-p 30)
 996        (ewoc-refresh dvc-log-cookie)
 997        elem))))
 998
 999(defun dvc-log-next ()
1000  "Move to the next log entry."
1001  (interactive)
1002  (let ((next (ewoc-next dvc-log-cookie
1003                         (ewoc-locate dvc-log-cookie))))
1004    (when next (goto-char (ewoc-location next)))))
1005
1006(defun dvc-log-prev ()
1007  "Move to the previous log entry."
1008  (interactive)
1009  (let ((prev (ewoc-prev dvc-log-cookie
1010                         (ewoc-locate dvc-log-cookie))))
1011    (when prev (goto-char (ewoc-location prev)))))
1012
1013;;
1014;; Log buffer mode section
1015;;
1016(defvar dvc-log-buffer-mode-map
1017  (let ((map (make-sparse-keymap)))
1018    (define-key map dvc-keyvec-help 'describe-mode)
1019    (define-key map [?o] 'dvc-switch-to-output-buffer)
1020    (define-key map "\C-m" 'dvc-switch-to-output-buffer)
1021    (define-key map [?e] 'dvc-switch-to-error-buffer)
1022    (define-key map [?r] 'dvc-switch-to-related-buffer)
1023    (define-key map [?n] 'dvc-log-next)
1024    (define-key map [?p] 'dvc-log-prev)
1025    (define-key map dvc-keyvec-quit 'dvc-buffer-quit)
1026    map)
1027  "Keymap used in DVC's log buffer.")
1028
1029(define-derived-mode dvc-log-buffer-mode fundamental-mode "DVC Log"
1030  "Major mode for DVC's internal log buffer. You can open this buffer
1031with `dvc-open-internal-log-buffer'."
1032  (toggle-read-only 1))
1033
1034(defun dvc-open-internal-log-buffer ()
1035  "Switch to the DVC's internal log buffer.
1036This buffer contains a list of all the DVC commands previously executed.
1037The buffer uses the mode `dvc-log-buffer-mode'"
1038  (interactive)
1039  (let ((buffer-name (buffer-name)))
1040    (dvc-switch-to-buffer dvc-log-buffer)
1041    (goto-char (point-max))
1042    (when (re-search-backward (concat " Buffer: "
1043                                      (regexp-quote buffer-name)
1044                                      "$")
1045                              nil t)
1046      (dvc-flash-line))))
1047
1048(defun dvc-clear-log-buffer ()
1049  "Kill the log buffer."
1050  (when (bufferp (get-buffer dvc-log-buffer))
1051    (kill-buffer dvc-log-buffer)))
1052
1053(defun dvc-get-process-output ()
1054  "Return the content of the last process buffer.
1055Strips the final newline if there is one."
1056  (dvc-buffer-content dvc-last-process-buffer))
1057
1058(defun dvc-get-error-output ()
1059  "Return the content of the last error buffer.
1060Strips the final newline if there is one."
1061  (dvc-buffer-content dvc-last-error-buffer))
1062
1063
1064;; TODO: per backend cound.
1065(add-to-list 'minor-mode-alist
1066             '(dvc-process-running
1067               (:eval (if (equal (length dvc-process-running) 1)
1068                          " DVC running"
1069                        (concat " DVC running("
1070                                (int-to-string (length dvc-process-running))
1071                                ")")))))
1072
1073(defun dvc-log-edit-file-name ()
1074  "Return a suitable file name to edit the commit message"
1075  ;; FIXME: replace this with define-dvc-unified-command
1076  (dvc-call "dvc-log-edit-file-name-func"))
1077
1078(defun dvc-dvc-log-edit-file-name-func ()
1079  (concat (file-name-as-directory (dvc-tree-root))
1080          (dvc-variable (dvc-current-active-dvc)
1081                        "log-edit-file-name")))
1082
1083;;
1084;; Revision manipulation
1085;;
1086
1087;; revision grammar is specified in ../docs/DVC-API
1088
1089;; accessors
1090(defun dvc-revision-get-dvc (revision-id)
1091  (car revision-id))
1092
1093(defun dvc-revision-get-type (revision-id)
1094  (car (nth 1 revision-id)))
1095
1096(defun dvc-revision-get-data (revision-id)
1097  (cdr (nth 1 revision-id)))
1098
1099(defun dvc-revision-to-string (revision-id &optional prev-format orig-str)
1100  "Return a string representation for REVISION-ID.
1101
1102If PREV-FORMAT is specified, it is the format string to use for
1103entries that are before the given revision ID.  The format string
1104should take two parameters.  The first is the revision ID, and
1105the second is a number which indicates how many generations back
1106to travel.
1107
1108If ORIG-STR is specified, it is the string that indicates the
1109current revision of the working tree."
1110  (let* ((type (dvc-revision-get-type revision-id))
1111         (data (dvc-revision-get-data revision-id)))
1112    ;;(dvc-trace "dvc-revision-to-string: type: %s, data: %s, orig-str: %s" type data orig-str)
1113    (case type
1114      (revision (dvc-name-construct (nth 0 data)))
1115      (local-tree (car data))
1116      (last-revision (or orig-str "original"))
1117      (previous-revision
1118       (format (or prev-format "%s:-%s")
1119               (dvc-revision-to-string
1120                (list (dvc-revision-get-dvc revision-id) (nth 0 data)))
1121               (int-to-string (nth 1 data))))
1122      (t "UNKNOWN"))))
1123
1124(defun dvc-revision-get-buffer (file revision-id)
1125  "Return an empty buffer suitable for viewing FILE in REVISION-ID.
1126
1127The name of the buffer is chosen according to FILE and REVISION-ID.
1128
1129REVISION-ID may have the values described in docs/DVC-API."
1130  (let* ((type (dvc-revision-get-type revision-id))
1131         (name (concat
1132                (file-name-nondirectory file)
1133                "(" (dvc-revision-to-string revision-id) ")")))
1134    ;; replace / by | to work around uniquify
1135    (setq name (replace-regexp-in-string "\\/" "|" name))
1136    (let ((buffer (generate-new-buffer name)))
1137      (with-current-buffer buffer
1138        (let ((buffer-file-name file))
1139          (set-auto-mode t)))
1140      (dvc-buffers-tree-add (dvc-revision-get-dvc revision-id) type file buffer)
1141      buffer)))
1142
1143
1144(defun dvc-revision-get-file-in-buffer (file revision-id)
1145  "Return a buffer with the content of FILE at REVISION-ID.
1146
1147REVISION-ID is as specified in docs/DVC-API."
1148  (dvc-trace "dvc-revision-get-file-in-buffer. revision-id=%S" revision-id)
1149  (let* ((type (dvc-revision-get-type revision-id))
1150         (inhibit-read-only t)
1151         ;; find-file-noselect will call dvc-current-active-dvc in a
1152         ;; hook; specify dvc for dvc-call
1153         (dvc-temp-current-active-dvc (dvc-revision-get-dvc revision-id))
1154         (buffer (unless (eq type 'local-tree) (dvc-revision-get-buffer file revision-id))))
1155    (case type
1156      (local-tree (find-file-noselect file))
1157
1158      (revision
1159       (with-current-buffer buffer
1160         (dvc-call "revision-get-file-revision"
1161                   file (dvc-revision-get-data revision-id))
1162         (set-buffer-modified-p nil)
1163         (toggle-read-only 1)
1164         buffer))
1165
1166      (previous-revision
1167       (with-current-buffer buffer
1168         (let* ((dvc (dvc-revision-get-dvc revision-id))
1169                (data (nth 0 (dvc-revision-get-data revision-id)))
1170                (rev-id (list dvc data)))
1171           (dvc-call "revision-get-previous-revision" file rev-id))
1172         (set-buffer-modified-p nil)
1173         (toggle-read-only 1)
1174         buffer))
1175
1176      (last-revision
1177       (with-current-buffer buffer
1178         (dvc-call "revision-get-last-revision"
1179                   file (dvc-revision-get-data revision-id))
1180         (set-buffer-modified-p nil)
1181         (toggle-read-only 1)
1182         buffer))
1183
1184      (t (error "TODO: dvc-revision-get-file-in-buffer type %S" type)))))
1185
1186(defun dvc-dvc-revision-nth-ancestor (revision n)
1187  "Default function to get the n-th ancestor of REVISION."
1188  (let ((count n)
1189        (res revision))
1190    (while (> count 0)
1191      (setq res (dvc-revision-direct-ancestor res)
1192            count (- count 1)))
1193    res))
1194
1195;;
1196;; DVC command version
1197;;
1198(defun dvc-dvc-command-version ()
1199  "Fallback for `dvc-command-vesion'. Returns just `nil'.
1200This function is called only if the current backend doesn't
1201implement `command-version' function."
1202  nil)
1203
1204(provide 'dvc-core)
1205;;; dvc-core.el ends here