384 lines
15 KiB
EmacsLisp
384 lines
15 KiB
EmacsLisp
;;; xdarcs.el --- darcs interface for dvc
|
|
|
|
;; Copyright (C) 2006, 2007, 2008 by all contributors
|
|
|
|
;; Author: Stefan Reichoer, <stefan@xsteve.at>
|
|
|
|
;; This file is free software; you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation; either version 2, or (at your option)
|
|
;; any later version.
|
|
|
|
;; This file is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with GNU Emacs; see the file COPYING. If not, write to
|
|
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
|
;; Boston, MA 02110-1301, USA.
|
|
|
|
;;; Commentary:
|
|
|
|
;; The darcs interface for dvc
|
|
|
|
;;; History:
|
|
|
|
;;
|
|
|
|
;;; Code:
|
|
|
|
(require 'dvc-core)
|
|
(require 'dvc-utils)
|
|
(require 'dvc-diff)
|
|
(require 'xdarcs-core)
|
|
|
|
(defun xdarcs-initialize (&optional dir)
|
|
"Run darcs initialize."
|
|
(interactive
|
|
(list (expand-file-name (dvc-read-directory-name "Directory for darcs initialize: "
|
|
(or default-directory
|
|
(getenv "HOME"))))))
|
|
(let ((default-directory dir))
|
|
(dvc-run-dvc-sync 'xdarcs (list "initialize")
|
|
:finished (dvc-capturing-lambda
|
|
(output error status arguments)
|
|
(message "darcs initialize finished")))))
|
|
|
|
;;;###autoload
|
|
(defun xdarcs-dvc-add-files (&rest files)
|
|
"Run darcs add."
|
|
(dvc-trace "xdarcs-add-files: %s" files)
|
|
(dvc-run-dvc-sync 'xdarcs (append '("add") files)
|
|
:finished (dvc-capturing-lambda
|
|
(output error status arguments)
|
|
(message "darcs add finished"))))
|
|
|
|
(defun xdarcs-command-version ()
|
|
"Run darcs --version."
|
|
(interactive)
|
|
(let ((version (dvc-run-dvc-sync 'xdarcs '("--version")
|
|
:finished 'dvc-output-buffer-handler)))
|
|
(when (interactive-p)
|
|
(message "darcs version: %s" version))
|
|
version))
|
|
|
|
;; --------------------------------------------------------------------------------
|
|
;; whatsnew
|
|
;; --------------------------------------------------------------------------------
|
|
;;
|
|
;; (defun xdarcs-whatsnew ()
|
|
;; "Run darcs whatsnew.
|
|
;; When called with a prefix argument, specify the --look-for-adds parameter."
|
|
;; (interactive)
|
|
;; (let ((param-list '("whatsnew")))
|
|
;; (when current-prefix-arg
|
|
;; (add-to-list 'param-list "--look-for-adds" t))
|
|
;; (dvc-run-dvc-display-as-info 'xdarcs param-list)))
|
|
(defun xdarcs-parse-whatsnew (changes-buffer)
|
|
(dvc-trace "xdarcs-parse-whatsnew (dolist)")
|
|
(let ((status-list
|
|
(split-string (dvc-buffer-content (current-buffer)) "\n")))
|
|
(with-current-buffer changes-buffer
|
|
(setq dvc-header (format "darcs whatsnew --look-for-adds for %s\n" default-directory))
|
|
(let ((buffer-read-only)
|
|
status modif modif-char)
|
|
(dolist (elem status-list)
|
|
(unless (string= "" elem)
|
|
(setq modif-char (aref elem 0))
|
|
(cond ((eq modif-char ?M)
|
|
(setq status "M"
|
|
modif "M")
|
|
(when (or (string-match "\\(.+\\) -[0-9]+ \\+[0-9]+$"
|
|
elem)
|
|
(string-match "\\(.+\\) [+-][0-9]+$"
|
|
elem))
|
|
(setq elem (match-string 1 elem))))
|
|
;; ???a
|
|
((eq modif-char ?a)
|
|
(setq status "?"))
|
|
((eq modif-char ?A)
|
|
(setq status "A"
|
|
modif " "))
|
|
((eq modif-char ?R)
|
|
(setq status "D"))
|
|
((eq modif-char ??)
|
|
(setq status "?"))
|
|
(t
|
|
(setq modif nil
|
|
status nil)))
|
|
(when (or modif status)
|
|
(ewoc-enter-last
|
|
dvc-fileinfo-ewoc
|
|
(make-dvc-fileinfo-legacy
|
|
:data (list 'file
|
|
;; Skip the status and "./" in the filename
|
|
(substring elem 4)
|
|
status
|
|
modif))))))))))
|
|
|
|
;;;###autoload
|
|
(defun xdarcs-whatsnew (&optional path)
|
|
"Run darcs whatsnew."
|
|
(interactive (list default-directory))
|
|
(let* ((dir (or path default-directory))
|
|
(root (xdarcs-tree-root dir))
|
|
(buffer (dvc-prepare-changes-buffer
|
|
`(xdarcs (last-revision ,root 1))
|
|
`(xdarcs (local-tree ,root))
|
|
'status root 'xdarcs)))
|
|
(dvc-switch-to-buffer-maybe buffer)
|
|
(setq dvc-buffer-refresh-function 'xdarcs-whatsnew)
|
|
(dvc-save-some-buffers root)
|
|
(dvc-run-dvc-sync
|
|
'xdarcs '("whatsnew" "--look-for-adds")
|
|
:finished
|
|
(dvc-capturing-lambda (output error status arguments)
|
|
(with-current-buffer (capture buffer)
|
|
(if (> (point-max) (point-min))
|
|
(dvc-show-changes-buffer output 'xdarcs-parse-whatsnew
|
|
(capture buffer))
|
|
(dvc-diff-no-changes (capture buffer)
|
|
"No changes in %s"
|
|
(capture root))))
|
|
:error
|
|
(dvc-capturing-lambda (output error status arguments)
|
|
(dvc-diff-error-in-process (capture buffer)
|
|
"Error in diff process"
|
|
output error))))))
|
|
|
|
;;;###autoload
|
|
(defun xdarcs-dvc-missing (&optional other)
|
|
"Run 'darcs pull --dry-run -s -v' to see what's missing"
|
|
(interactive)
|
|
(let ((buffer (dvc-get-buffer-create 'xdarcs 'missing)))
|
|
(dvc-run-dvc-async
|
|
'xdarcs '("pull" "--dry-run" "-s" "-v")
|
|
:finished
|
|
(dvc-capturing-lambda (output error status arguments)
|
|
(progn
|
|
(with-current-buffer (capture buffer)
|
|
(let ((inhibit-read-only t))
|
|
(erase-buffer)
|
|
(insert-buffer-substring output)
|
|
(goto-char (point-min))
|
|
(re-search-forward "^Would pull the following changes:" nil t)
|
|
(xdarcs-missing-next 1)
|
|
(xdarcs-missing-mode)))
|
|
(goto-char (point-min))
|
|
(dvc-switch-to-buffer (capture buffer)))))))
|
|
|
|
(defvar xdarcs-review-recenter-position-on-next-diff 5)
|
|
|
|
(defvar xdarcs-missing-mode-map
|
|
(let ((map (make-sparse-keymap)))
|
|
(define-key map (dvc-prefix-buffer ?L) 'dvc-open-internal-log-buffer)
|
|
(define-key map dvc-keyvec-quit 'dvc-buffer-quit)
|
|
(define-key map [?n] 'xdarcs-missing-next)
|
|
(define-key map [?p] 'xdarcs-missing-previous)
|
|
(define-key map [?\ ] 'xdarcs-missing-dwim-next)
|
|
(define-key map (dvc-prefix-merge ?f) 'dvc-pull) ;; hint: fetch, p is reserved for push
|
|
map)
|
|
"Keymap used in a xdarcs missing buffer.")
|
|
|
|
(defvar xdarcs-missing-patch-start-regexp
|
|
"^\\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\).+$")
|
|
|
|
(defvar xdarcs-missing-font-lock-keywords
|
|
`((,xdarcs-missing-patch-start-regexp . font-lock-function-name-face)
|
|
("^hunk.+" . font-lock-variable-name-face))
|
|
"Keywords in `xdarcs-missing-mode'.")
|
|
|
|
(define-derived-mode xdarcs-missing-mode fundamental-mode
|
|
"xdarcs missing mode"
|
|
"Major mode to show the output of a call to `xdarcs-missing'."
|
|
(dvc-install-buffer-menu)
|
|
(set (make-local-variable 'font-lock-defaults)
|
|
(list 'xdarcs-missing-font-lock-keywords t nil nil))
|
|
(toggle-read-only 1))
|
|
|
|
(defun xdarcs-missing-next (n)
|
|
(interactive "p")
|
|
(end-of-line)
|
|
(re-search-forward xdarcs-missing-patch-start-regexp nil t n)
|
|
(beginning-of-line)
|
|
(when xdarcs-review-recenter-position-on-next-diff
|
|
(recenter xdarcs-review-recenter-position-on-next-diff)))
|
|
|
|
(defun xdarcs-missing-previous (n)
|
|
(interactive "p")
|
|
(end-of-line)
|
|
(re-search-backward xdarcs-missing-patch-start-regexp)
|
|
(re-search-backward xdarcs-missing-patch-start-regexp nil t n)
|
|
(when xdarcs-review-recenter-position-on-next-diff
|
|
(recenter xdarcs-review-recenter-position-on-next-diff)))
|
|
|
|
(defun xdarcs-missing-dwim-next ()
|
|
"Either move to the next changeset via `xdarcs-missing-next' or call `scroll-up'.
|
|
When the beginning of the next changeset is already visible, call `xdarcs-missing-next',
|
|
otherwise call `scroll-up'."
|
|
(interactive)
|
|
(let* ((start-pos (point))
|
|
(window-line (count-lines (window-start) start-pos))
|
|
(window-height (dvc-window-body-height))
|
|
(distance-to-next-changeset (save-window-excursion (xdarcs-missing-next 1) (count-lines start-pos (point)))))
|
|
(goto-char start-pos)
|
|
(when (eq distance-to-next-changeset 0) ; last changeset
|
|
(setq distance-to-next-changeset (count-lines start-pos (point-max))))
|
|
(if (< (- window-height window-line) distance-to-next-changeset)
|
|
(scroll-up)
|
|
(xdarcs-missing-next 1))))
|
|
|
|
|
|
(defun xdarcs-pull-finish-function (output error status arguments)
|
|
(let ((buffer (dvc-get-buffer-create 'xdarcs 'pull)))
|
|
(with-current-buffer buffer
|
|
(let ((inhibit-read-only t))
|
|
(erase-buffer)
|
|
(insert-buffer-substring output)
|
|
(toggle-read-only 1)))
|
|
(let ((dvc-switch-to-buffer-mode 'show-in-other-window))
|
|
(dvc-switch-to-buffer buffer))))
|
|
|
|
;;;###autoload
|
|
(defun xdarcs-pull (&optional other)
|
|
"Run darcs pull --all.
|
|
If OTHER is nil, pull from the repository most recently pulled
|
|
from or pushed to. If OTHER is a string, pull from that
|
|
repository."
|
|
(interactive)
|
|
(dvc-run-dvc-async 'xdarcs (list "pull" "--all" other)
|
|
:error 'xdarcs-pull-finish-function
|
|
:finished 'xdarcs-pull-finish-function))
|
|
|
|
;; --------------------------------------------------------------------------------
|
|
;; diff
|
|
;; --------------------------------------------------------------------------------
|
|
(defun xdarcs-parse-diff (changes-buffer)
|
|
(save-excursion
|
|
(while (re-search-forward
|
|
"^diff\\( -[^ ]*\\)* old-[^ ]* new-[^/]*/\\(.*\\)$" nil t)
|
|
|
|
(let* ((name (match-string-no-properties 2))
|
|
; Darcs does not appear to provide any of this information via
|
|
; "darcs diff". But maybe that won't always be the case?
|
|
; Also, going forwards might help all the diffs to appear...
|
|
(added (progn (forward-line 1)
|
|
(looking-at "^--- /dev/null")))
|
|
(removed (progn (forward-line 1)
|
|
(looking-at "^\\+\\+\\+ /dev/null"))))
|
|
|
|
; Darcs 2.30, at least, is not putting any blank lines between diffs...
|
|
(save-excursion
|
|
(forward-line -2)
|
|
(if (not (or (looking-back "^$")
|
|
(= (point) (point-min))))
|
|
(insert "\n")))
|
|
|
|
(with-current-buffer changes-buffer
|
|
(ewoc-enter-last
|
|
dvc-fileinfo-ewoc
|
|
(make-dvc-fileinfo-legacy
|
|
:data (list 'file
|
|
name
|
|
(cond (added "A")
|
|
(removed "D")
|
|
(t " "))
|
|
(cond ((or added removed) " ")
|
|
(t "M"))
|
|
" " ; dir. directories are not
|
|
; tracked in git
|
|
nil))))))))
|
|
|
|
;;;###autoload
|
|
(defun xdarcs-dvc-diff (&optional against path dont-switch)
|
|
(interactive (list nil nil current-prefix-arg))
|
|
(let* ((cur-dir (or path default-directory))
|
|
(orig-buffer (current-buffer))
|
|
(root (dvc-tree-root cur-dir))
|
|
(buffer (dvc-prepare-changes-buffer
|
|
`(xdarcs (last-revision ,root 1))
|
|
`(xdarcs (local-tree ,root))
|
|
'diff root 'xdarcs))
|
|
(command-list '("diff" "--unified")))
|
|
(dvc-switch-to-buffer-maybe buffer)
|
|
(when dont-switch (pop-to-buffer orig-buffer))
|
|
(dvc-save-some-buffers root)
|
|
(dvc-run-dvc-sync 'xdarcs command-list
|
|
:finished
|
|
(dvc-capturing-lambda (output error status arguments)
|
|
(dvc-show-changes-buffer output 'xdarcs-parse-diff
|
|
(capture buffer))))))
|
|
;; --------------------------------------------------------------------------------
|
|
;; dvc revision support
|
|
;; --------------------------------------------------------------------------------
|
|
;;
|
|
;; It seems that there if no subcommand in darcs to get specified
|
|
;; revision of a file. So I use following trick:
|
|
;; 1. Make a diff between the file in local copy and the last revision
|
|
;; of file. Then
|
|
;; 2. Apply the diff as patch reversely(-R) to the file in the local
|
|
;; copy with patch command. With -o option, patch command doesn't
|
|
;; modify the file in local copy; patch command create the applied
|
|
;; file at /tmp. Finally
|
|
;; 3. Do insert-file-contents to the current buffer.
|
|
;;
|
|
;; Darcs experts, if you know better way, please, let us know.
|
|
;;
|
|
;; - Masatake
|
|
;;
|
|
;;;###autoload
|
|
(defun xdarcs-revision-get-last-revision (file last-revision)
|
|
"Insert the content of FILE in LAST-REVISION, in current buffer.
|
|
|
|
LAST-REVISION looks like
|
|
\(\"path\" NUM)"
|
|
(dvc-trace "xdarcs-revision-get-last-revision file:%S last-revision:%S" file last-revision)
|
|
(let* (;;(xdarcs-rev (int-to-string (nth 1 last-revision)))
|
|
(default-directory (car last-revision))
|
|
;; TODO: support the last-revision parameter??
|
|
(patch (dvc-run-dvc-sync
|
|
'xdarcs (list "diff" "--unified" file)
|
|
:finished 'dvc-output-buffer-handler))
|
|
(output-buffer (current-buffer))
|
|
(output-file (dvc-make-temp-name "xdarcs-file-find"))
|
|
(patch-cmdline (format "cd \"%s\"; patch -R -o \"%s\""
|
|
default-directory
|
|
output-file))
|
|
;; TODO: Use dvc's process/buffer management facility.
|
|
(status (with-temp-buffer
|
|
(insert patch)
|
|
(shell-command-on-region (point-min)
|
|
(point-max)
|
|
patch-cmdline
|
|
output-buffer))))
|
|
(when (zerop status)
|
|
(with-current-buffer output-buffer
|
|
(insert-file-contents output-file)
|
|
;; TODO: remove output-file
|
|
))))
|
|
|
|
;;;###autoload
|
|
(defun xdarcs-dvc-revert-files (&rest files)
|
|
"Run darcs revert."
|
|
(dvc-trace "xdarcs-revert-files: %s" files)
|
|
(let ((default-directory (xdarcs-tree-root)))
|
|
(dvc-run-dvc-sync 'xdarcs (append '("revert" "-a") (mapcar #'file-relative-name files))
|
|
:finished (dvc-capturing-lambda
|
|
(output error status arguments)
|
|
(message "xdarcs revert finished")))))
|
|
|
|
;;;###autoload
|
|
(defun xdarcs-dvc-remove-files (&rest files)
|
|
"Run darcs remove."
|
|
(dvc-trace "xdarcs-remove-files: %s" files)
|
|
(dvc-run-dvc-sync 'xdarcs (append '("remove" "-a") files)
|
|
:finished (dvc-capturing-lambda
|
|
(output error status arguments)
|
|
(message "xdarcs remove finished"))))
|
|
|
|
|
|
(provide 'xdarcs)
|
|
;;; xdarcs.el ends here
|