219 lines
7.8 KiB
EmacsLisp
219 lines
7.8 KiB
EmacsLisp
;;; xhg-dvc.el --- The dvc layer for xhg
|
|
|
|
;; Copyright (C) 2005-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:
|
|
|
|
;; This file provides the common dvc layer for xhg
|
|
|
|
;;; Commands:
|
|
;;
|
|
;; Below is a complete command list:
|
|
;;
|
|
;; `xhg-select-committer-for-next-commit'
|
|
;; Select the committer for the next hg commit.
|
|
;; `xhg-dvc-missing'
|
|
;; Run hg incoming to show the missing patches for this tree.
|
|
;; `xhg-dvc-pull'
|
|
;; Run hg pull, when `xhg-dvc-pull-runs-update' is t, use the --update flag.
|
|
;; `xhg-dvc-create-branch'
|
|
;; Run xhg-branch.
|
|
;; `xhg-dvc-select-branch'
|
|
;; Switch to a named branch.
|
|
;;
|
|
|
|
|
|
;;; History:
|
|
|
|
;;
|
|
|
|
;;; Code:
|
|
|
|
(require 'xhg)
|
|
(eval-and-compile (require 'dvc-unified))
|
|
|
|
;;;###autoload
|
|
(dvc-register-dvc 'xhg "Mercurial")
|
|
|
|
;;;###autoload
|
|
(defalias 'xhg-dvc-tree-root 'xhg-tree-root)
|
|
|
|
;;;###autoload
|
|
(defalias 'xhg-dvc-merge 'xhg-merge)
|
|
|
|
;;;###autoload
|
|
(defun xhg-dvc-export-via-email ()
|
|
(interactive)
|
|
(call-interactively 'xhg-export-via-mail))
|
|
|
|
(defvar xhg-dvc-commit-extra-parameters nil "A list of extra parameters for the next hg commit.")
|
|
|
|
(defvar xhg-commit-done-hook '()
|
|
"*Hooks run after a successful commit via `xhg-dvc-log-edit-done'.")
|
|
|
|
(defun xhg-select-committer-for-next-commit (committer)
|
|
"Select the committer for the next hg commit.
|
|
This is done via setting `xhg-dvc-commit-extra-parameters'."
|
|
(interactive (list (read-string "Committer for next hg commit: " xhg-gnus-patch-from-user)))
|
|
(setq xhg-dvc-commit-extra-parameters `("--user" ,committer)))
|
|
|
|
;; Base functions that are required for every supported dvc system
|
|
(defun xhg-dvc-log-edit-done ()
|
|
"Finish a commit for Mercurial."
|
|
(let ((buffer (find-file-noselect (dvc-log-edit-file-name)))
|
|
(files-to-commit (with-current-buffer dvc-partner-buffer (dvc-current-file-list 'nil-if-none-marked))))
|
|
(dvc-log-flush-commit-file-list)
|
|
(save-buffer buffer)
|
|
(message "committing %S in %s" (or files-to-commit "all files") (dvc-tree-root))
|
|
(dvc-run-dvc-sync
|
|
'xhg (append (list "commit" "-l" (dvc-log-edit-file-name))
|
|
xhg-dvc-commit-extra-parameters files-to-commit)
|
|
:finished (dvc-capturing-lambda
|
|
(output error status arguments)
|
|
(dvc-show-error-buffer output 'commit)
|
|
(let ((inhibit-read-only t))
|
|
(goto-char (point-max))
|
|
(insert (with-current-buffer error
|
|
(buffer-string))))
|
|
(dvc-log-close (capture buffer))
|
|
;; doesn't work at the moment (Stefan, 10.02.2006)
|
|
;; (dvc-diff-clear-buffers 'xhg (capture default-directory)
|
|
;; "* Just committed! Please refresh buffer\n")
|
|
(setq xhg-dvc-commit-extra-parameters nil)
|
|
(message "Mercurial commit finished")
|
|
(dvc-tips-popup-maybe)
|
|
(run-hooks 'xhg-commit-done-hook)))))
|
|
|
|
;;;###autoload
|
|
(defalias 'xhg-dvc-save-diff 'xhg-save-diff)
|
|
|
|
;;;###autoload
|
|
(defalias 'xhg-dvc-command-version 'xhg-command-version)
|
|
|
|
(defun xhg-dvc-changelog (&optional arg)
|
|
"Shows the changelog in the current Mercurial tree.
|
|
ARG is passed as prefix argument"
|
|
(call-interactively 'xhg-log))
|
|
|
|
;; deactivated at them moment, use dvc-dvc-files-to-commit to allow selecting files to commit
|
|
;; (defun xhg-dvc-files-to-commit ()
|
|
;; ;; -mar: modified+added+removed
|
|
;; (dvc-run-dvc-sync 'xhg (list "status" "-mar")
|
|
;; :finished (dvc-capturing-lambda
|
|
;; (output error status arguments)
|
|
;; (let ((file-list)
|
|
;; (modif)
|
|
;; (file-name))
|
|
;; (set-buffer output)
|
|
;; (goto-char (point-min))
|
|
;; (while (> (point-max) (point))
|
|
;; (cond ((looking-at "M ")
|
|
;; (setq modif 'dvc-modified))
|
|
;; ((looking-at "A ")
|
|
;; (setq modif 'dvc-added))
|
|
;; ((looking-at "R ")
|
|
;; (setq modif 'dvc-move))
|
|
;; (t
|
|
;; (setq modif nil)))
|
|
;; (setq file-name (buffer-substring-no-properties (+ (point) 2) (line-end-position)))
|
|
;; (add-to-list 'file-list (cons modif file-name))
|
|
;; (forward-line 1))
|
|
;; file-list))))
|
|
|
|
(defun xhg-dvc-edit-ignore-files ()
|
|
(interactive)
|
|
(find-file-other-window (concat (xhg-tree-root) ".hgignore")))
|
|
|
|
(defun xhg-dvc-ignore-files (file-list)
|
|
(interactive (list (dvc-current-file-list)))
|
|
(when (y-or-n-p (format "Ignore %S for %s? " file-list (xhg-tree-root)))
|
|
(with-current-buffer
|
|
(find-file-noselect (concat (xhg-tree-root) ".hgignore"))
|
|
(goto-char (point-max))
|
|
(dolist (f-name file-list)
|
|
(insert (format "^%s$\n" (regexp-quote f-name))))
|
|
(save-buffer))))
|
|
|
|
(defun xhg-dvc-backend-ignore-file-extensions (extension-list)
|
|
(with-current-buffer
|
|
(find-file-noselect (concat (xhg-tree-root) ".hgignore"))
|
|
(goto-char (point-max))
|
|
(dolist (ext-name extension-list)
|
|
(insert (format "\\.%s$\n" (regexp-quote ext-name))))
|
|
(save-buffer)))
|
|
|
|
(defun xhg-dvc-missing (&optional other)
|
|
"Run hg incoming to show the missing patches for this tree.
|
|
When `last-command' was `dvc-pull', run `xhg-missing'."
|
|
(interactive)
|
|
(if (eq last-command 'dvc-pull)
|
|
(xhg-missing-1)
|
|
(xhg-incoming other t)))
|
|
|
|
(defun xhg-dvc-update ()
|
|
(interactive)
|
|
(xhg-update))
|
|
|
|
(defvar xhg-dvc-pull-runs-update t
|
|
"Whether `xhg-dvc-pull' should call hg pull with the --update flag.")
|
|
|
|
(defun xhg-dvc-pull (&optional other)
|
|
"Run hg pull, when `xhg-dvc-pull-runs-update' is t, use the --update flag."
|
|
(interactive)
|
|
(let ((source-path
|
|
(or other
|
|
(let* ((completions (xhg-paths 'both))
|
|
(initial-input (car (member "default" completions))))
|
|
(if (string= initial-input "default") initial-input
|
|
(dvc-completing-read
|
|
"Pull from hg repository: "
|
|
completions nil nil initial-input))))))
|
|
(xhg-pull source-path xhg-dvc-pull-runs-update)))
|
|
|
|
(defun xhg-dvc-create-branch (new-name)
|
|
"Run xhg-branch."
|
|
(interactive "sNewBranchName: ")
|
|
(xhg-branch new-name))
|
|
|
|
(defun xhg-dvc-select-branch ()
|
|
"Switch to a named branch."
|
|
(interactive)
|
|
(xhg-update nil t))
|
|
|
|
(defun xhg-dvc-ediff-file-revisions ()
|
|
"Layer function for `xhg-ediff-file-at-rev'."
|
|
(interactive)
|
|
(call-interactively #'xhg-ediff-file-at-rev))
|
|
|
|
(defalias 'xhg-dvc-revlog-get-revision 'xhg-revlog-get-revision)
|
|
|
|
(defalias 'xhg-dvc-name-construct 'xhg-name-construct)
|
|
|
|
(defalias 'xhg-dvc-delta 'xhg-delta)
|
|
|
|
(defalias 'xhg-dvc-clone 'xhg-clone)
|
|
|
|
(defalias 'xhg-dvc-init 'xhg-init)
|
|
|
|
(defalias 'xhg-dvc-push 'xhg-push)
|
|
|
|
(provide 'xhg-dvc)
|
|
;;; xhg-dvc.el ends here
|