* lisp/progmodes/ruby-mode.el (ruby-mode): Add `ruby-mode-set-encoding'
[bpt/emacs.git] / lisp / vc / vc-hg.el
index 30c91ad..ba882a3 100644 (file)
@@ -1,8 +1,9 @@
-;;; 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
 
@@ -92,7 +93,7 @@
 ;; - 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))
 
 ;;; Customization options
 
+(defgroup vc-hg nil
+  "VC Mercurial (hg) backend."
+  :version "24.1"
+  :group 'vc)
+
 (defcustom vc-hg-global-switches nil
   "Global switches to pass to any Hg command."
   :type '(choice (const :tag "None" nil)
          (string :tag "Argument String")
          (repeat :tag "Argument List" :value ("") string))
   :version "22.2"
-  :group 'vc)
+  :group 'vc-hg)
 
 (defcustom vc-hg-diff-switches t ; Hg doesn't support common args like -u
   "String or list of strings specifying switches for Hg diff under VC.
@@ -132,12 +138,12 @@ If nil, use the value of `vc-diff-switches'.  If t, use no switches."
                  (string :tag "Argument String")
                  (repeat :tag "Argument List" :value ("") string))
   :version "23.1"
-  :group 'vc)
+  :group 'vc-hg)
 
 (defcustom vc-hg-program "hg"
   "Name of the Mercurial executable (excluding any arguments)."
   :type 'string
-  :group 'vc)
+  :group 'vc-hg)
 
 (defcustom vc-hg-root-log-format
   '("{rev}:{tags}: {author|person} {date|shortdate} {desc|firstline}\\n"
@@ -146,14 +152,14 @@ If nil, use the value of `vc-diff-switches'.  If t, use no switches."
      (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
 output, and KEYWORDS is a list of `font-lock-keywords' for
 highlighting the Log View buffer."
   :type '(list string string (repeat sexp))
-  :group 'vc
+  :group 'vc-hg
   :version "24.1")
 
 \f
@@ -162,7 +168,7 @@ highlighting the Log View buffer."
 (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
 
@@ -170,7 +176,7 @@ highlighting the Log View buffer."
 ;;;###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
@@ -221,45 +227,14 @@ highlighting the Log View buffer."
 
 (defun vc-hg-working-revision (file)
   "Hg-specific version of `vc-working-revision'."
-  (let*
-      ((status nil)
-       (default-directory (file-name-directory file))
-       ;; Avoid localization of messages so we can parse the output.
-       (avoid-local-env (append (list "TERM=dumb" "LANGUAGE=C")
-                                    process-environment))
-       (out
-        (with-output-to-string
-          (with-current-buffer
-              standard-output
-            (setq status
-                  (condition-case nil
-                     (let ((process-environment avoid-local-env))
-                       ;; Ignore all errors.
-                       (process-file
-                        vc-hg-program nil t nil
-                        "--config" "alias.parents=parents"
-                        "--config" "defaults.parents="
-                        "parents" "--template" "{rev}" (file-relative-name file)))
-                    ;; Some problem happened.  E.g. We can't find an `hg'
-                    ;; executable.
-                    (error nil)))))))
-    (if (eq 0 status)
-       out
-      ;; Check if the file is in the 'added state, the above hg
-      ;; command does not distinguish between 'added and 'unregistered.
-      (setq status
-           (condition-case nil
-               (let ((process-environment avoid-local-env))
-                 (process-file
-                  vc-hg-program nil nil nil
-                  ;; We use "log" here, if there's a faster command
-                  ;; that returns true for an 'added file and false
-                  ;; for an 'unregistered one, we could use that.
-                  "log" "-l1" (file-relative-name file)))
-             ;; Some problem happened.  E.g. We can't find an `hg'
-             ;; executable.
-             (error nil)))
-      (when (eq 0 status) "0"))))
+  (let ((default-directory (if (file-directory-p file)
+                               (file-name-as-directory file)
+                             (file-name-directory file))))
+    (ignore-errors
+      (with-output-to-string
+        (process-file vc-hg-program nil standard-output nil
+                      "log" "-l" "1" "--template" "{rev}"
+                      (file-relative-name file))))))
 
 ;;; History functions
 
@@ -270,8 +245,13 @@ highlighting the Log View buffer."
                  (repeat :tag "Argument List" :value ("") string))
   :group 'vc-hg)
 
+(autoload 'vc-setup-buffer "vc-dispatcher")
+
 (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)
@@ -282,7 +262,7 @@ highlighting the Log View 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)))))
@@ -328,6 +308,8 @@ highlighting the Log View buffer."
            ("^tag: +\\([^ ]+\\)$" (1 'highlight))
            ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message)))))))
 
+(autoload 'vc-switches "vc")
+
 (defun vc-hg-diff (files &optional oldvers newvers buffer)
   "Get a difference report using hg between two revisions of FILES."
   (let* ((firstfile (car files))
@@ -363,10 +345,8 @@ highlighting the Log View buffer."
 
 ;; 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)
@@ -384,7 +364,7 @@ Optional arg REVISION is a revision to annotate from."
 ;;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)
@@ -402,16 +382,16 @@ Optional arg REVISION is a revision to annotate from."
              (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)))))
@@ -433,7 +413,7 @@ Optional arg REVISION is a revision to annotate from."
   "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."
@@ -463,7 +443,7 @@ 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
@@ -479,8 +459,13 @@ REV is ignored."
         (vc-hg-command buffer 0 file "cat" "-r" rev)
       (vc-hg-command buffer 0 file "cat"))))
 
+(defun vc-hg-find-ignore-file (file)
+  "Return the root directory of the repository of FILE."
+  (expand-file-name ".hgignore"
+                   (vc-hg-root file)))
+
 ;; 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."
@@ -491,6 +476,35 @@ 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)))
@@ -512,7 +526,7 @@ REV is the revision to check out into WORKFILE."
 
 (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->))
@@ -528,16 +542,15 @@ REV is the revision to check out into WORKFILE."
     (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)
@@ -587,15 +600,21 @@ REV is the revision to check out into WORKFILE."
         (forward-line))
       (funcall update-function result)))
 
+;; Follows vc-hg-command (or vc-do-async-command), which uses vc-do-command
+;; from vc-dispatcher.
+(declare-function vc-exec-after "vc-dispatcher" (code))
+;; Follows vc-exec-after.
+(declare-function vc-set-async-update "vc-dispatcher" (process-buffer))
+
 (defun vc-hg-dir-status (dir update-function)
   (vc-hg-command (current-buffer) 'async dir "status" "-C")
-  (vc-exec-after
-   `(vc-hg-after-dir-status (quote ,update-function))))
+  (vc-run-delayed
+   (vc-hg-after-dir-status 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))))
+  (vc-run-delayed
+   (vc-hg-after-dir-status update-function)))
 
 (defun vc-hg-dir-extra-header (name &rest commands)
   (concat (propertize name 'face 'font-lock-type-face)
@@ -639,6 +658,16 @@ REV is the revision to check out into WORKFILE."
                       (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.")
+
+(autoload 'vc-do-async-command "vc-dispatcher")
+
 (defun vc-hg-pull (prompt)
   "Issue a Mercurial pull command.
 If called interactively with a set of marked Log View buffers,
@@ -679,6 +708,8 @@ then attempts to update the working directory."
                args       (cddr args)))
        (apply 'vc-do-async-command buffer root hg-program
               command args)
+        (with-current-buffer buffer
+          (vc-run-delayed (vc-compilation-mode 'hg)))
        (vc-set-async-update buffer)))))
 
 (defun vc-hg-merge-branch ()
@@ -687,6 +718,7 @@ This runs the command \"hg merge\"."
   (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-run-delayed (vc-compilation-mode 'hg)))
     (vc-set-async-update buffer)))
 
 ;;; Internal functions