-;;; vc-hg.el --- VC backend for the mercurial version control system
+;;; vc-hg.el --- VC backend for the mercurial version control system -*- lexical-binding: t -*-
-;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2013 Free Software Foundation, Inc.
;; Author: Ivan Kanis
+;; Maintainer: FSF
;; Keywords: vc tools
;; Package: vc
;; - clear-headers () ??
;; - delete-file (file) TEST IT
;; - rename-file (old new) OK
-;; - find-file-hook () PROBABLY NOT NEEDED
+;; - find-file-hook () added for bug#10709
;; 2) Implement Stefan Monnier's advice:
;; vc-hg-registered and vc-hg-state
;;; Code:
(eval-when-compile
- (require 'cl)
+ (require 'cl-lib)
(require 'vc)
(require 'vc-dir))
(2 'change-log-list)
(3 'change-log-name)
(4 'change-log-date)))
- "Mercurial log template for `vc-print-root-log'.
+ "Mercurial log template for `vc-hg-print-log' short format.
This should be a list (TEMPLATE REGEXP KEYWORDS), where TEMPLATE
is the \"--template\" argument string to pass to Mercurial,
REGEXP is a regular expression matching the resulting Mercurial
(defvar vc-hg-history nil)
(defun vc-hg-revision-granularity () 'repository)
-(defun vc-hg-checkout-model (files) 'implicit)
+(defun vc-hg-checkout-model (_files) 'implicit)
;;; State querying functions
;;;###autoload "Return non-nil if FILE is registered with hg."
;;;###autoload (if (vc-find-root file ".hg") ; short cut
;;;###autoload (progn
-;;;###autoload (load "vc-hg")
+;;;###autoload (load "vc-hg" nil t)
;;;###autoload (vc-hg-registered file))))
;; Modeled after the similar function in vc-bzr.el
:group 'vc-hg)
(defun vc-hg-print-log (files buffer &optional shortlog start-revision limit)
- "Get change log associated with FILES."
+ "Print commit log associated with FILES into specified BUFFER.
+If SHORTLOG is non-nil, use a short format based on `vc-hg-root-log-format'.
+If START-REVISION is non-nil, it is the newest revision to show.
+If LIMIT is non-nil, show no more than this many entries."
;; `vc-do-command' creates the buffer, but we need it before running
;; the command.
(vc-setup-buffer buffer)
buffer
(apply 'vc-hg-command buffer 0 files "log"
(nconc
- (when start-revision (list (format "-r%s:" start-revision)))
+ (when start-revision (list (format "-r%s:0" start-revision)))
(when limit (list "-l" (format "%s" limit)))
(when shortlog (list "--template" (car vc-hg-root-log-format)))
vc-hg-log-switches)))))
;; Modeled after the similar function in vc-cvs.el
(defun vc-hg-revision-completion-table (files)
- (lexical-let ((files files)
- table)
- (setq table (lazy-completion-table
- table (lambda () (vc-hg-revision-table files))))
+ (letrec ((table (lazy-completion-table
+ table (lambda () (vc-hg-revision-table files)))))
table))
(defun vc-hg-annotate-command (file buffer &optional revision)
;;215 Wed Jun 20 21:22:58 2007 -0700 foo.c: CONTENTS
;; i.e. VERSION_NUMBER DATE FILENAME: CONTENTS
(defconst vc-hg-annotate-re
- "^[ \t]*\\([0-9]+\\) \\(.\\{30\\}\\)\\(?:\\(: \\)\\|\\(?: +\\(.+\\): \\)\\)")
+ "^[ \t]*\\([0-9]+\\) \\(.\\{30\\}\\)\\(?:\\(: \\)\\|\\(?: +\\([^:\n]+\\(?::\\(?:[^: \n][^:\n]*\\)?\\)*\\): \\)\\)")
(defun vc-hg-annotate-time ()
(when (looking-at vc-hg-annotate-re)
(expand-file-name (match-string-no-properties 4)
(vc-hg-root default-directory)))))))
-(defun vc-hg-previous-revision (file rev)
+(defun vc-hg-previous-revision (_file rev)
(let ((newrev (1- (string-to-number rev))))
(when (>= newrev 0)
(number-to-string newrev))))
-(defun vc-hg-next-revision (file rev)
+(defun vc-hg-next-revision (_file rev)
(let ((newrev (1+ (string-to-number rev)))
(tip-revision
(with-temp-buffer
- (vc-hg-command t 0 nil "tip")
+ (vc-hg-command t 0 nil "tip" "--style=default")
(goto-char (point-min))
(re-search-forward "^changeset:[ \t]*\\([0-9]+\\):")
(string-to-number (match-string-no-properties 1)))))
"Rename file from OLD to NEW using `hg mv'."
(vc-hg-command nil 0 new "mv" old))
-(defun vc-hg-register (files &optional rev comment)
+(defun vc-hg-register (files &optional _rev _comment)
"Register FILES under hg.
REV is ignored.
COMMENT is ignored."
(declare-function log-edit-extract-headers "log-edit" (headers string))
-(defun vc-hg-checkin (files rev comment)
+(defun vc-hg-checkin (files _rev comment)
"Hg-specific version of `vc-backend-checkin'.
REV is ignored."
(apply 'vc-hg-command nil 0 files
(vc-hg-command buffer 0 file "cat"))))
;; Modeled after the similar function in vc-bzr.el
-(defun vc-hg-checkout (file &optional editable rev)
+(defun vc-hg-checkout (file &optional _editable rev)
"Retrieve a revision of FILE.
EDITABLE is ignored.
REV is the revision to check out into WORKFILE."
(vc-hg-command t 0 file "cat" "-r" rev)
(vc-hg-command t 0 file "cat")))))
+(defun vc-hg-resolve-when-done ()
+ "Call \"hg resolve -m\" if the conflict markers have been removed."
+ (save-excursion
+ (goto-char (point-min))
+ (unless (re-search-forward "^<<<<<<< " nil t)
+ (vc-hg-command nil 0 buffer-file-name "resolve" "-m")
+ ;; Remove the hook so that it is not called multiple times.
+ (remove-hook 'after-save-hook 'vc-hg-resolve-when-done t))))
+
+(defun vc-hg-find-file-hook ()
+ (when (and buffer-file-name
+ (file-exists-p (concat buffer-file-name ".orig"))
+ ;; Hg does not seem to have a "conflict" status, eg
+ ;; hg http://bz.selenic.com/show_bug.cgi?id=2724
+ (memq (vc-file-getprop buffer-file-name 'vc-state)
+ '(edited conflict))
+ ;; Maybe go on to check that "hg resolve -l" says "U"?
+ ;; If "hg resolve -l" says there's a conflict but there are no
+ ;; conflict markers, it's not clear what we should do.
+ (save-excursion
+ (goto-char (point-min))
+ (re-search-forward "^<<<<<<< " nil t)))
+ ;; Hg may not recognize "conflict" as a state, but we can do better.
+ (vc-file-setprop buffer-file-name 'vc-state 'conflict)
+ (smerge-start-session)
+ (add-hook 'after-save-hook 'vc-hg-resolve-when-done nil t)
+ (message "There are unresolved conflicts in this file")))
+
+
;; Modeled after the similar function in vc-bzr.el
(defun vc-hg-workfile-unchanged-p (file)
(eq 'up-to-date (vc-hg-state file)))
(defvar log-view-vc-backend)
-(defstruct (vc-hg-extra-fileinfo
+(cl-defstruct (vc-hg-extra-fileinfo
(:copier nil)
(:constructor vc-hg-create-extra-fileinfo (rename-state extra-name))
(:conc-name vc-hg-extra-fileinfo->))
(when extra
(insert (propertize
(format " (%s %s)"
- (case (vc-hg-extra-fileinfo->rename-state extra)
- (copied "copied from")
- (renamed-from "renamed from")
- (renamed-to "renamed to"))
+ (pcase (vc-hg-extra-fileinfo->rename-state extra)
+ (`copied "copied from")
+ (`renamed-from "renamed from")
+ (`renamed-to "renamed to"))
(vc-hg-extra-fileinfo->extra-name extra))
'face 'font-lock-comment-face)))))
(defun vc-hg-after-dir-status (update-function)
- (let ((status-char nil)
- (file nil)
+ (let ((file nil)
(translation '((?= . up-to-date)
(?C . up-to-date)
(?A . added)
(vc-exec-after
`(vc-hg-after-dir-status (quote ,update-function))))
-(defun vc-hg-dir-status-files (dir files default-state update-function)
+(defun vc-hg-dir-status-files (dir files _default-state update-function)
(apply 'vc-hg-command (current-buffer) 'async dir "status" "-C" files)
(vc-exec-after
`(vc-hg-after-dir-status (quote ,update-function))))
(mapcar (lambda (arg) (list "-r" arg)) marked-list)))
(error "No log entries selected for push"))))
+(defvar vc-hg-error-regexp-alist nil
+ ;; 'hg pull' does not list modified files, so, for now, the only
+ ;; benefit of `vc-compilation-mode' is that one can get rid of
+ ;; *vc-hg* buffer with 'q' or 'z'.
+ ;; TODO: call 'hg incoming' before pull/merge to get the list of
+ ;; modified files
+ "Value of `compilation-error-regexp-alist' in *vc-hg* buffers.")
+
(defun vc-hg-pull (prompt)
"Issue a Mercurial pull command.
If called interactively with a set of marked Log View buffers,
args (cddr args)))
(apply 'vc-do-async-command buffer root hg-program
command args)
+ (with-current-buffer buffer (vc-exec-after '(vc-compilation-mode 'hg)))
(vc-set-async-update buffer)))))
(defun vc-hg-merge-branch ()
(let* ((root (vc-hg-root default-directory))
(buffer (format "*vc-hg : %s*" (expand-file-name root))))
(apply 'vc-do-async-command buffer root vc-hg-program '("merge"))
+ (with-current-buffer buffer (vc-exec-after '(vc-compilation-mode 'hg)))
(vc-set-async-update buffer)))
;;; Internal functions
HCoop / bpt / emacs.git / blobdiff