LCOV - code coverage report
Current view: top level - lisp/vc - vc-hg.el (source / functions) Hit Total Coverage
Test: tramp-tests-after.info Lines: 3 650 0.5 %
Date: 2017-08-30 10:12:24 Functions: 3 76 3.9 %

          Line data    Source code
       1             : ;;; vc-hg.el --- VC backend for the mercurial version control system  -*- lexical-binding: t -*-
       2             : 
       3             : ;; Copyright (C) 2006-2017 Free Software Foundation, Inc.
       4             : 
       5             : ;; Author: Ivan Kanis
       6             : ;; Maintainer: emacs-devel@gnu.org
       7             : ;; Keywords: vc tools
       8             : ;; Package: vc
       9             : 
      10             : ;; This file is part of GNU Emacs.
      11             : 
      12             : ;; GNU Emacs is free software: you can redistribute it and/or modify
      13             : ;; it under the terms of the GNU General Public License as published by
      14             : ;; the Free Software Foundation, either version 3 of the License, or
      15             : ;; (at your option) any later version.
      16             : 
      17             : ;; GNU Emacs is distributed in the hope that it will be useful,
      18             : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
      19             : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
      20             : ;; GNU General Public License for more details.
      21             : 
      22             : ;; You should have received a copy of the GNU General Public License
      23             : ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
      24             : 
      25             : ;;; Commentary:
      26             : 
      27             : ;; This is a mercurial version control backend
      28             : 
      29             : ;;; Thanks:
      30             : 
      31             : ;;; Bugs:
      32             : 
      33             : ;;; Installation:
      34             : 
      35             : ;;; Todo:
      36             : 
      37             : ;; 1) Implement the rest of the vc interface. See the comment at the
      38             : ;; beginning of vc.el. The current status is:
      39             : 
      40             : ;; FUNCTION NAME                               STATUS
      41             : ;; BACKEND PROPERTIES
      42             : ;; * revision-granularity                      OK
      43             : ;; STATE-QUERYING FUNCTIONS
      44             : ;; * registered (file)                         OK
      45             : ;; * state (file)                              OK
      46             : ;; - dir-status-files (dir files uf)           OK
      47             : ;; - dir-extra-headers (dir)                   OK
      48             : ;; - dir-printer (fileinfo)                    OK
      49             : ;; * working-revision (file)                   OK
      50             : ;; * checkout-model (files)                    OK
      51             : ;; - mode-line-string (file)                   OK
      52             : ;; STATE-CHANGING FUNCTIONS
      53             : ;; * register (files &optional rev comment)    OK
      54             : ;; * create-repo ()                            OK
      55             : ;; - responsible-p (file)                      OK
      56             : ;; - receive-file (file rev)                   ?? PROBABLY NOT NEEDED
      57             : ;; - unregister (file)                         OK
      58             : ;; * checkin (files rev comment)               OK
      59             : ;; * find-revision (file rev buffer)           OK
      60             : ;; * checkout (file &optional rev)             OK
      61             : ;; * revert (file &optional contents-done)     OK
      62             : ;; - merge (file rev1 rev2)                    NEEDED
      63             : ;; - merge-news (file)                         NEEDED
      64             : ;; - steal-lock (file &optional revision)      NOT NEEDED
      65             : ;; HISTORY FUNCTIONS
      66             : ;; * print-log (files buffer &optional shortlog start-revision limit) OK
      67             : ;; - log-view-mode ()                          OK
      68             : ;; - show-log-entry (revision)                 NOT NEEDED, DEFAULT IS GOOD
      69             : ;; - comment-history (file)                    NOT NEEDED
      70             : ;; - update-changelog (files)                  NOT NEEDED
      71             : ;; * diff (files &optional rev1 rev2 buffer)   OK
      72             : ;; - revision-completion-table (files)         OK?
      73             : ;; - annotate-command (file buf &optional rev) OK
      74             : ;; - annotate-time ()                          OK
      75             : ;; - annotate-current-time ()                  NOT NEEDED
      76             : ;; - annotate-extract-revision-at-line ()      OK
      77             : ;; TAG SYSTEM
      78             : ;; - create-tag (dir name branchp)             OK
      79             : ;; - retrieve-tag (dir name update)            OK
      80             : ;; MISCELLANEOUS
      81             : ;; - make-version-backups-p (file)             ??
      82             : ;; - previous-revision (file rev)              OK
      83             : ;; - next-revision (file rev)                  OK
      84             : ;; - check-headers ()                          ??
      85             : ;; - delete-file (file)                        TEST IT
      86             : ;; - rename-file (old new)                     OK
      87             : ;; - find-file-hook ()                         added for bug#10709
      88             : 
      89             : ;; 2) Implement Stefan Monnier's advice:
      90             : ;; vc-hg-registered and vc-hg-state
      91             : ;; Both of those functions should be super extra careful to fail gracefully in
      92             : ;; unexpected circumstances. The reason this is important is that any error
      93             : ;; there will prevent the user from even looking at the file :-(
      94             : ;; Ideally, just like in vc-arch and vc-cvs, checking that the file is under
      95             : ;; mercurial's control and extracting the current revision should be done
      96             : ;; without even using `hg' (this way even if you don't have `hg' installed,
      97             : ;; Emacs is able to tell you this file is under mercurial's control).
      98             : 
      99             : ;;; History:
     100             : ;;
     101             : 
     102             : ;;; Code:
     103             : 
     104             : (eval-when-compile
     105             :   (require 'vc)
     106             :   (require 'vc-dir))
     107             : 
     108             : (require 'cl-lib)
     109             : 
     110             : (declare-function vc-compilation-mode "vc-dispatcher" (backend))
     111             : 
     112             : ;;; Customization options
     113             : 
     114             : (defgroup vc-hg nil
     115             :   "VC Mercurial (hg) backend."
     116             :   :version "24.1"
     117             :   :group 'vc)
     118             : 
     119             : (defcustom vc-hg-global-switches nil
     120             :   "Global switches to pass to any Hg command."
     121             :   :type '(choice (const :tag "None" nil)
     122             :          (string :tag "Argument String")
     123             :          (repeat :tag "Argument List" :value ("") string))
     124             :   :version "22.2"
     125             :   :group 'vc-hg)
     126             : 
     127             : (defcustom vc-hg-diff-switches t ; Hg doesn't support common args like -u
     128             :   "String or list of strings specifying switches for Hg diff under VC.
     129             : If nil, use the value of `vc-diff-switches'.  If t, use no switches."
     130             :   :type '(choice (const :tag "Unspecified" nil)
     131             :                  (const :tag "None" t)
     132             :                  (string :tag "Argument String")
     133             :                  (repeat :tag "Argument List" :value ("") string))
     134             :   :version "23.1"
     135             :   :group 'vc-hg)
     136             : 
     137             : (defcustom vc-hg-annotate-switches '("-u" "--follow")
     138             :   "String or list of strings specifying switches for hg annotate under VC.
     139             : If nil, use the value of `vc-annotate-switches'.  If t, use no
     140             : switches."
     141             :   :type '(choice (const :tag "Unspecified" nil)
     142             :                  (const :tag "None" t)
     143             :                  (string :tag "Argument String")
     144             :                  (repeat :tag "Argument List" :value ("") string))
     145             :   :version "25.1"
     146             :   :group 'vc-hg)
     147             : 
     148             : (defcustom vc-hg-program "hg"
     149             :   "Name of the Mercurial executable (excluding any arguments)."
     150             :   :type 'string
     151             :   :group 'vc-hg)
     152             : 
     153             : (defcustom vc-hg-root-log-format
     154             :   `(,(concat "{rev}:{ifeq(branch, 'default','', '{branch}')}"
     155             :              ":{bookmarks}:{tags}:{author|person}"
     156             :              " {date|shortdate} {desc|firstline}\\n")
     157             :     ,(concat "^\\(?:[+@o x|-]*\\)"      ;Graph data.
     158             :              "\\([0-9]+\\):\\([^:]*\\)"
     159             :              ":\\([^:]*\\):\\([^:]*\\):\\(.*?\\)"
     160             :              "[ \t]+\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)")
     161             :     ((1 'log-view-message)
     162             :      (2 'change-log-file)
     163             :      (3 'change-log-list)
     164             :      (4 'change-log-conditionals)
     165             :      (5 'change-log-name)
     166             :      (6 'change-log-date)))
     167             :   "Mercurial log template for `vc-hg-print-log' short format.
     168             : This should be a list (TEMPLATE REGEXP KEYWORDS), where TEMPLATE
     169             : is the \"--template\" argument string to pass to Mercurial,
     170             : REGEXP is a regular expression matching the resulting Mercurial
     171             : output, and KEYWORDS is a list of `font-lock-keywords' for
     172             : highlighting the Log View buffer."
     173             :   :type '(list string string (repeat sexp))
     174             :   :group 'vc-hg
     175             :   :version "24.5")
     176             : 
     177             : 
     178             : ;;; Properties of the backend
     179             : 
     180             : (defvar vc-hg-history nil)
     181             : 
     182             : (defun vc-hg-revision-granularity () 'repository)
     183             : (defun vc-hg-checkout-model (_files) 'implicit)
     184             : 
     185             : ;;; State querying functions
     186             : 
     187             : ;;;###autoload (defun vc-hg-registered (file)
     188             : ;;;###autoload   "Return non-nil if FILE is registered with hg."
     189             : ;;;###autoload   (if (vc-find-root file ".hg")       ; short cut
     190             : ;;;###autoload       (progn
     191             : ;;;###autoload         (load "vc-hg" nil t)
     192             : ;;;###autoload         (vc-hg-registered file))))
     193             : 
     194             : ;; Modeled after the similar function in vc-bzr.el
     195             : (defun vc-hg-registered (file)
     196             :   "Return non-nil if FILE is registered with hg."
     197          17 :   (when (vc-hg-root file)           ; short cut
     198           0 :     (let ((state (vc-hg-state file)))  ; expensive
     199          17 :       (and state (not (memq state '(ignored unregistered)))))))
     200             : 
     201             : (defun vc-hg-state (file)
     202             :   "Hg-specific version of `vc-state'."
     203           0 :   (let ((state (vc-hg-state-fast file)))
     204           0 :     (if (eq state 'unsupported) (vc-hg-state-slow file) state)))
     205             : 
     206             : (defun vc-hg-state-slow (file)
     207             :   "Determine status of FILE by running hg."
     208           0 :   (setq file (expand-file-name file))
     209           0 :   (let*
     210             :       ((status nil)
     211           0 :        (default-directory (file-name-directory file))
     212             :        (out
     213           0 :         (with-output-to-string
     214           0 :           (with-current-buffer
     215           0 :               standard-output
     216           0 :             (setq status
     217           0 :                   (condition-case nil
     218             :                       ;; Ignore all errors.
     219           0 :                       (let ((process-environment
     220             :                              ;; Avoid localization of messages so we
     221             :                              ;; can parse the output.  Disable pager.
     222           0 :                              (append
     223           0 :                               (list "TERM=dumb" "LANGUAGE=C" "HGPLAIN=1")
     224           0 :                               process-environment)))
     225           0 :                         (process-file
     226           0 :                          vc-hg-program nil t nil
     227             :                          "--config" "alias.status=status"
     228             :                          "--config" "defaults.status="
     229           0 :                          "status" "-A" (file-relative-name file)))
     230             :                     ;; Some problem happened.  E.g. We can't find an `hg'
     231             :                     ;; executable.
     232           0 :                     (error nil)))))))
     233           0 :     (when (and (eq 0 status)
     234           0 :                (> (length out) 0)
     235           0 :                (null (string-match ".*: No such file or directory$" out)))
     236           0 :       (let ((state (aref out 0)))
     237           0 :         (cond
     238           0 :          ((eq state ?=) 'up-to-date)
     239           0 :          ((eq state ?A) 'added)
     240           0 :          ((eq state ?M) 'edited)
     241           0 :          ((eq state ?I) 'ignored)
     242           0 :          ((eq state ?R) 'removed)
     243           0 :          ((eq state ?!) 'missing)
     244           0 :          ((eq state ??) 'unregistered)
     245           0 :          ((eq state ?C) 'up-to-date) ;; Older mercurial versions use this.
     246           0 :          (t 'up-to-date))))))
     247             : 
     248             : (defun vc-hg-working-revision (file)
     249             :   "Hg-specific version of `vc-working-revision'."
     250           0 :   (or (ignore-errors
     251           0 :         (with-output-to-string
     252           0 :           (vc-hg-command standard-output 0 file
     253           0 :                          "parent" "--template" "{rev}")))
     254           0 :       "0"))
     255             : 
     256             : (defcustom vc-hg-symbolic-revision-styles
     257             :   '(builtin-active-bookmark
     258             :     "{if(bookmarks,sub(' ',',',bookmarks),if(phabdiff,phabdiff,shortest(node,6)))}")
     259             :   "List of ways to present versions symbolically.  The version
     260             : that we use is the first one that successfully produces a
     261             : non-empty string.
     262             : 
     263             : Each entry in the list can be either:
     264             : 
     265             : - The symbol `builtin-active-bookmark', which indicates that we
     266             : should use the active bookmark if one exists.  A template can
     267             : supply this information as well, but `builtin-active-bookmark' is
     268             : handled entirely inside Emacs and so is more efficient than using
     269             : the generic Mercurial mechanism.
     270             : 
     271             : - A string giving the Mercurial template to supply to \"hg
     272             : parent\".  \"hg help template\" may be useful reading.
     273             : 
     274             : - A function to call; it should accept two arguments (a revision
     275             : and an optional path to which to limit history) and produce a
     276             : string.  The function is called with `default-directory' set to
     277             : within the repository.
     278             : 
     279             : If no list entry produces a useful revision, return `nil'."
     280             :   :type '(repeat (choice
     281             :                   (const :tag "Active bookmark" 'bookmark)
     282             :                   (string :tag "Hg template")
     283             :                   (function :tag "Custom")))
     284             :   :version "26.1"
     285             :   :group 'vc-hg)
     286             : 
     287             : (defcustom vc-hg-use-file-version-for-mode-line-version nil
     288             :   "When enabled, the modeline contains revision information for the visited file.
     289             : When not, the revision in the modeline is for the repository
     290             : working copy.  `nil' is the much faster setting for
     291             : large repositories."
     292             :   :type 'boolean
     293             :   :version "26.1"
     294             :   :group 'vc-hg)
     295             : 
     296             : (defun vc-hg--active-bookmark-internal (rev)
     297           0 :   (when (equal rev ".")
     298           0 :     (let* ((current-bookmarks-file ".hg/bookmarks.current"))
     299           0 :       (when (file-exists-p current-bookmarks-file)
     300           0 :         (ignore-errors
     301           0 :           (with-temp-buffer
     302           0 :             (insert-file-contents current-bookmarks-file)
     303           0 :             (buffer-substring-no-properties
     304           0 :              (point-min) (point-max))))))))
     305             : 
     306             : (defun vc-hg--run-log (template rev path)
     307           0 :   (ignore-errors
     308           0 :     (with-output-to-string
     309           0 :       (if path
     310           0 :           (vc-hg-command
     311           0 :            standard-output 0 nil
     312           0 :            "log" "-f" "-l1" "--template" template path)
     313           0 :         (vc-hg-command
     314           0 :          standard-output 0 nil
     315           0 :          "log" "-r" rev "-l1" "--template" template)))))
     316             : 
     317             : (defun vc-hg--symbolic-revision (rev &optional path)
     318             :   "Make a Mercurial revision human-readable.
     319             : REV is a Mercurial revision.  `default-directory' is assumed to
     320             : be in the repository root of interest.  PATH, if set, is a
     321             : specific file to query."
     322           0 :   (let ((symbolic-revision nil)
     323           0 :         (styles vc-hg-symbolic-revision-styles))
     324           0 :     (while (and (not symbolic-revision) styles)
     325           0 :       (let ((style (pop styles)))
     326           0 :         (setf symbolic-revision
     327           0 :               (cond ((and (null path) (eq style 'builtin-active-bookmark))
     328           0 :                      (vc-hg--active-bookmark-internal rev))
     329           0 :                     ((stringp style)
     330           0 :                      (vc-hg--run-log style rev path))
     331           0 :                     ((functionp style)
     332           0 :                      (funcall style rev path))))))
     333           0 :     symbolic-revision))
     334             : 
     335             : (defun vc-hg-mode-line-string (file)
     336             :   "Hg-specific version of `vc-mode-line-string'."
     337           0 :   (let* ((backend-name "Hg")
     338           0 :          (truename (file-truename file))
     339           0 :          (state (vc-state truename))
     340             :          (state-echo nil)
     341             :          (face nil)
     342           0 :          (rev (and state
     343           0 :                    (let ((default-directory
     344           0 :                           (expand-file-name (vc-hg-root truename))))
     345           0 :                      (vc-hg--symbolic-revision
     346             :                       "."
     347           0 :                       (and vc-hg-use-file-version-for-mode-line-version
     348           0 :                            truename)))))
     349           0 :          (rev (or rev "???")))
     350           0 :     (propertize
     351           0 :      (cond ((or (eq state 'up-to-date)
     352           0 :                 (eq state 'needs-update))
     353           0 :             (setq state-echo "Up to date file")
     354           0 :             (setq face 'vc-up-to-date-state)
     355           0 :             (concat backend-name "-" rev))
     356           0 :            ((eq state 'added)
     357           0 :             (setq state-echo "Locally added file")
     358           0 :             (setq face 'vc-locally-added-state)
     359           0 :             (concat backend-name "@" rev))
     360           0 :            ((eq state 'conflict)
     361           0 :             (setq state-echo "File contains conflicts after the last merge")
     362           0 :             (setq face 'vc-conflict-state)
     363           0 :             (concat backend-name "!" rev))
     364           0 :            ((eq state 'removed)
     365           0 :             (setq state-echo "File removed from the VC system")
     366           0 :             (setq face 'vc-removed-state)
     367           0 :             (concat backend-name "!" rev))
     368           0 :            ((eq state 'missing)
     369           0 :             (setq state-echo "File tracked by the VC system, but missing from the file system")
     370           0 :             (setq face 'vc-missing-state)
     371           0 :             (concat backend-name "?" rev))
     372             :            (t
     373           0 :             (setq state-echo "Locally modified file")
     374           0 :             (setq face 'vc-edited-state)
     375           0 :             (concat backend-name ":" rev)))
     376           0 :      'face face
     377           0 :      'help-echo (concat state-echo " under the " backend-name
     378           0 :                         " version control system"))))
     379             : 
     380             : ;;; History functions
     381             : 
     382             : (defcustom vc-hg-log-switches nil
     383             :   "String or list of strings specifying switches for hg log under VC."
     384             :   :type '(choice (const :tag "None" nil)
     385             :                  (string :tag "Argument String")
     386             :                  (repeat :tag "Argument List" :value ("") string))
     387             :   :group 'vc-hg)
     388             : 
     389             : (autoload 'vc-setup-buffer "vc-dispatcher")
     390             : 
     391             : (defvar vc-hg-log-graph nil
     392             :   "If non-nil, use `--graph' in the short log output.")
     393             : 
     394             : (defvar vc-hg-log-format (concat "changeset:   {rev}:{node|short}\n"
     395             :                                  "{tags % 'tag:         {tag}\n'}"
     396             :                                  "{if(parents, 'parents:     {parents}\n')}"
     397             :                                  "user:        {author}\n"
     398             :                                  "Date:        {date|date}\n"
     399             :                                  "summary:     {desc|tabindent}\n\n")
     400             :   "Mercurial log template for `vc-hg-print-log' long format.")
     401             : 
     402             : (defun vc-hg-print-log (files buffer &optional shortlog start-revision limit)
     403             :   "Print commit log associated with FILES into specified BUFFER.
     404             : If SHORTLOG is non-nil, use a short format based on `vc-hg-root-log-format'.
     405             : If START-REVISION is non-nil, it is the newest revision to show.
     406             : If LIMIT is non-nil, show no more than this many entries."
     407             :   ;; `vc-do-command' creates the buffer, but we need it before running
     408             :   ;; the command.
     409           0 :   (vc-setup-buffer buffer)
     410             :   ;; If the buffer exists from a previous invocation it might be
     411             :   ;; read-only.
     412           0 :   (let ((inhibit-read-only t))
     413           0 :     (with-current-buffer
     414           0 :         buffer
     415           0 :       (apply 'vc-hg-command buffer 'async files "log"
     416           0 :              (nconc
     417           0 :               (when start-revision (list (format "-r%s:0" start-revision)))
     418           0 :               (when limit (list "-l" (format "%s" limit)))
     419           0 :               (if shortlog
     420           0 :                   `(,@(if vc-hg-log-graph '("--graph"))
     421             :                     "--template"
     422           0 :                     ,(car vc-hg-root-log-format))
     423           0 :                 `("--template" ,vc-hg-log-format))
     424           0 :               vc-hg-log-switches)))))
     425             : 
     426             : (defvar log-view-message-re)
     427             : (defvar log-view-file-re)
     428             : (defvar log-view-font-lock-keywords)
     429             : (defvar log-view-per-file-logs)
     430             : (defvar log-view-expanded-log-entry-function)
     431             : 
     432             : (define-derived-mode vc-hg-log-view-mode log-view-mode "Hg-Log-View"
     433           0 :   (require 'add-log) ;; we need the add-log faces
     434           0 :   (set (make-local-variable 'log-view-file-re) "\\`a\\`")
     435           0 :   (set (make-local-variable 'log-view-per-file-logs) nil)
     436           0 :   (set (make-local-variable 'log-view-message-re)
     437           0 :        (if (eq vc-log-view-type 'short)
     438           0 :            (cadr vc-hg-root-log-format)
     439           0 :          "^changeset:[ \t]*\\([0-9]+\\):\\(.+\\)"))
     440           0 :   (set (make-local-variable 'tab-width) 2)
     441             :   ;; Allow expanding short log entries
     442           0 :   (when (eq vc-log-view-type 'short)
     443           0 :     (setq truncate-lines t)
     444           0 :     (set (make-local-variable 'log-view-expanded-log-entry-function)
     445           0 :          'vc-hg-expanded-log-entry))
     446           0 :   (set (make-local-variable 'log-view-font-lock-keywords)
     447           0 :        (if (eq vc-log-view-type 'short)
     448           0 :            (list (cons (nth 1 vc-hg-root-log-format)
     449           0 :                        (nth 2 vc-hg-root-log-format)))
     450           0 :          (append
     451           0 :           log-view-font-lock-keywords
     452             :           '(
     453             :             ;; Handle the case:
     454             :             ;; user: FirstName LastName <foo@bar>
     455             :             ("^user:[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]"
     456             :              (1 'change-log-name)
     457             :              (2 'change-log-email))
     458             :             ;; Handle the cases:
     459             :             ;; user: foo@bar
     460             :             ;; and
     461             :             ;; user: foo
     462             :             ("^user:[ \t]+\\([A-Za-z0-9_.+-]+\\(?:@[A-Za-z0-9_.-]+\\)?\\)"
     463             :              (1 'change-log-email))
     464             :             ("^date: \\(.+\\)" (1 'change-log-date))
     465             :             ("^tag: +\\([^ ]+\\)$" (1 'highlight))
     466           0 :             ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message)))))))
     467             : 
     468             : (autoload 'vc-switches "vc")
     469             : 
     470             : (defun vc-hg-diff (files &optional oldvers newvers buffer _async)
     471             :   "Get a difference report using hg between two revisions of FILES."
     472           0 :   (let* ((firstfile (car files))
     473           0 :          (working (and firstfile (vc-working-revision firstfile))))
     474           0 :     (when (and (equal oldvers working) (not newvers))
     475           0 :       (setq oldvers nil))
     476           0 :     (when (and (not oldvers) newvers)
     477           0 :       (setq oldvers working))
     478           0 :     (apply #'vc-hg-command
     479           0 :            (or buffer "*vc-diff*")
     480             :            nil ; bug#21969
     481           0 :            files "diff"
     482           0 :            (append
     483           0 :             (vc-switches 'hg 'diff)
     484           0 :             (when oldvers
     485           0 :               (if newvers
     486           0 :                   (list "-r" oldvers "-r" newvers)
     487           0 :                 (list "-r" oldvers)))))))
     488             : 
     489             : (defun vc-hg-expanded-log-entry (revision)
     490           0 :   (with-temp-buffer
     491           0 :     (vc-hg-command t nil nil "log" "-r" revision "--template" vc-hg-log-format)
     492           0 :     (goto-char (point-min))
     493           0 :     (unless (eobp)
     494             :       ;; Indent the expanded log entry.
     495           0 :       (indent-region (point-min) (point-max) 2)
     496           0 :       (goto-char (point-max))
     497           0 :       (buffer-string))))
     498             : 
     499             : (defun vc-hg-revision-table (files)
     500           0 :   (let ((default-directory (file-name-directory (car files))))
     501           0 :     (with-temp-buffer
     502           0 :       (vc-hg-command t nil files "log" "--template" "{rev} ")
     503           0 :       (split-string
     504           0 :        (buffer-substring-no-properties (point-min) (point-max))))))
     505             : 
     506             : ;; Modeled after the similar function in vc-cvs.el
     507             : (defun vc-hg-revision-completion-table (files)
     508           0 :   (letrec ((table (lazy-completion-table
     509           0 :                    table (lambda () (vc-hg-revision-table files)))))
     510           0 :     table))
     511             : 
     512             : (defun vc-hg-annotate-command (file buffer &optional revision)
     513             :   "Execute \"hg annotate\" on FILE, inserting the contents in BUFFER.
     514             : Optional arg REVISION is a revision to annotate from."
     515           0 :   (apply #'vc-hg-command buffer 0 file "annotate" "-dq" "-n"
     516           0 :          (append (vc-switches 'hg 'annotate)
     517           0 :                  (if revision (list (concat "-r" revision))))))
     518             : 
     519             : (declare-function vc-annotate-convert-time "vc-annotate" (&optional time))
     520             : 
     521             : ;; One line printed by "hg annotate -dq -n -u --follow" looks like this:
     522             : ;;   b56girard 114590 2012-03-13 CLOBBER: Lorem ipsum dolor sit
     523             : ;; i.e. AUTHOR REVISION DATE FILENAME: CONTENTS
     524             : ;; The user can omit options "-u" and/or "--follow".  Then it'll look like:
     525             : ;;   114590 2012-03-13 CLOBBER:
     526             : ;; or
     527             : ;;   b56girard 114590 2012-03-13:
     528             : (defconst vc-hg-annotate-re
     529             :   (concat
     530             :    "^\\(?: *[^ ]+ +\\)?\\([0-9]+\\) "   ;User and revision.
     531             :    "\\([0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9]\\)" ;Date.
     532             :    "\\(?: +\\([^:]+\\)\\)?:"))                        ;Filename.
     533             : 
     534             : (defun vc-hg-annotate-time ()
     535           0 :   (when (looking-at vc-hg-annotate-re)
     536           0 :     (goto-char (match-end 0))
     537           0 :     (vc-annotate-convert-time
     538           0 :      (let ((str (match-string-no-properties 2)))
     539           0 :        (encode-time 0 0 0
     540           0 :                     (string-to-number (substring str 6 8))
     541           0 :                     (string-to-number (substring str 4 6))
     542           0 :                     (string-to-number (substring str 0 4)))))))
     543             : 
     544             : (defun vc-hg-annotate-extract-revision-at-line ()
     545           0 :   (save-excursion
     546           0 :     (beginning-of-line)
     547           0 :     (when (looking-at vc-hg-annotate-re)
     548           0 :       (if (match-beginning 3)
     549           0 :           (cons (match-string-no-properties 1)
     550           0 :                 (expand-file-name (match-string-no-properties 3)
     551           0 :                                   (vc-hg-root default-directory)))
     552           0 :         (match-string-no-properties 1)))))
     553             : 
     554             : ;;; Tag system
     555             : 
     556             : (defun vc-hg-create-tag (dir name branchp)
     557             :   "Attach the tag NAME to the state of the working copy."
     558           0 :   (let ((default-directory dir))
     559           0 :     (and (vc-hg-command nil 0 nil "status")
     560           0 :          (vc-hg-command nil 0 nil (if branchp "bookmark" "tag") name))))
     561             : 
     562             : (defun vc-hg-retrieve-tag (dir name _update)
     563             :   "Retrieve the version tagged by NAME of all registered files at or below DIR."
     564           0 :   (let ((default-directory dir))
     565           0 :     (vc-hg-command nil 0 nil "update" name)
     566             :     ;; TODO: update *vc-change-log* buffer so can see @ if --graph
     567           0 :     ))
     568             : 
     569             : ;;; Native data structure reading
     570             : 
     571             : (defcustom vc-hg-parse-hg-data-structures t
     572             :   "If true, try directly parsing Mercurial data structures
     573             : directly instead of always running Mercurial.  We try to be safe
     574             : against Mercurial data structure format changes and always fall
     575             : back to running Mercurial directly."
     576             :   :type 'boolean
     577             :   :version "26.1"
     578             :   :group 'vc-hg)
     579             : 
     580             : (defsubst vc-hg--read-u8 ()
     581             :   "Read and advance over an unsigned byte.
     582             : Return a fixnum."
     583           0 :   (prog1 (char-after)
     584           0 :     (forward-char)))
     585             : 
     586             : (defsubst vc-hg--read-u32-be ()
     587             :   "Read and advance over a big-endian unsigned 32-bit integer.
     588             : Return a fixnum; on overflow, result is undefined."
     589             :   ;; Because elisp bytecode has an instruction for multiply and
     590             :   ;; doesn't have one for lsh, it's somewhat counter-intuitively
     591             :   ;; faster to multiply than to shift.
     592           0 :   (+ (* (vc-hg--read-u8) (* 256 256 256))
     593           0 :      (* (vc-hg--read-u8) (* 256 256))
     594           0 :      (* (vc-hg--read-u8) 256)
     595           0 :      (identity (vc-hg--read-u8))))
     596             : 
     597             : (defun vc-hg--raw-dirstate-search (dirstate fname)
     598           0 :   (with-temp-buffer
     599           0 :     (set-buffer-multibyte nil)
     600           0 :     (insert-file-contents-literally dirstate)
     601           0 :     (let* ((result nil)
     602           0 :            (flen (length fname))
     603             :            (case-fold-search nil)
     604             :            (inhibit-changing-match-data t)
     605             :            ;; Find a conservative bound for the loop below by using
     606             :            ;; Boyer-Moore on the raw dirstate without parsing it; we
     607             :            ;; know we can't possibly find fname _after_ the last place
     608             :            ;; it appears, so we can bail out early if we try to parse
     609             :            ;; past it, which especially helps when the file we're
     610             :            ;; trying to find isn't in dirstate at all.  There's no way
     611             :            ;; to similarly bound the starting search position, since
     612             :            ;; the file format is such that we need to parse it from
     613             :            ;; the beginning to find record boundaries.
     614             :            (search-limit
     615           0 :             (progn
     616           0 :               (goto-char (point-max))
     617           0 :               (or (search-backward fname (+ (point-min) 40) t)
     618           0 :                   (point-min)))))
     619             :       ;; 40 is just after the header, which contains the working
     620             :       ;; directory parents
     621           0 :       (goto-char (+ (point-min) 40))
     622             :       ;; Iterate over all dirstate entries; we might run this loop
     623             :       ;; hundreds of thousands of times, so performance is important
     624             :       ;; here
     625           0 :       (while (< (point) search-limit)
     626             :         ;; 1+4*4 is the length of the dirstate item header, which we
     627             :         ;; spell as a literal for performance, since the elisp
     628             :         ;; compiler lacks constant propagation
     629           0 :         (forward-char (1+ (* 3 4)))
     630           0 :         (let ((this-flen (vc-hg--read-u32-be)))
     631           0 :           (if (and (or (eq this-flen flen)
     632           0 :                        (and (> this-flen flen)
     633           0 :                             (eq (char-after (+ (point) flen)) 0)))
     634           0 :                    (search-forward fname (+ (point) flen) t))
     635           0 :               (progn
     636           0 :                 (backward-char (+ flen (1+ (* 4 4))))
     637           0 :                 (setf result
     638           0 :                       (list (vc-hg--read-u8)     ; status
     639           0 :                             (vc-hg--read-u32-be) ; mode
     640           0 :                             (vc-hg--read-u32-be) ; size (of file)
     641           0 :                             (vc-hg--read-u32-be) ; mtime
     642           0 :                             ))
     643           0 :                 (goto-char (point-max)))
     644           0 :             (forward-char this-flen))))
     645           0 :       result)))
     646             : 
     647             : (define-error 'vc-hg-unsupported-syntax "unsupported hgignore syntax")
     648             : 
     649             : (defconst vc-hg--pcre-c-escapes
     650             :   '((?a . ?\a)
     651             :     (?b . ?\b)
     652             :     (?f . ?\f)
     653             :     (?n . ?\n)
     654             :     (?r . ?\r)
     655             :     (?t . ?\t)
     656             :     (?n . ?\n)
     657             :     (?r . ?\r)
     658             :     (?t . ?\t)
     659             :     (?v . ?\v)))
     660             : 
     661             : (defconst vc-hg--pcre-metacharacters
     662             :   '(?. ?^ ?$ ?* ?+ ?? ?{ ?\\ ?\[ ?\| ?\())
     663             : 
     664             : (defconst vc-hg--elisp-metacharacters
     665             :   '(?. ?* ?+ ?? ?\[ ?$ ?\\))
     666             : 
     667             : (defun vc-hg--escape-for-pcre (c)
     668           0 :   (if (memq c vc-hg--pcre-metacharacters)
     669           0 :       (string ?\\ c)
     670           0 :     c))
     671             : 
     672             : (defun vc-hg--parts-to-string (parts)
     673             :   "Build a string from list PARTS.  Each element is a character or string."
     674           0 :   (let ((parts2 nil))
     675           0 :     (while parts
     676           0 :       (let* ((partcell (prog1 parts (setf parts (cdr parts))))
     677           0 :              (part (car partcell)))
     678           0 :         (if (stringp part)
     679           0 :             (setf parts2 (nconc (append part nil) parts2))
     680           0 :           (setcdr partcell parts2)
     681           0 :           (setf parts2 partcell))))
     682           0 :     (apply #'string parts2)))
     683             : 
     684             : (defun vc-hg--pcre-to-elisp-re (pcre prefix)
     685             :   "Transform PCRE, a Mercurial file PCRE, into an elisp RE against PREFIX.
     686             : PREFIX is the directory name of the directory against which these
     687             : patterns are rooted.  We understand only a subset of PCRE syntax;
     688             : if we don't understand a construct, we signal
     689             : `vc-hg-unsupported-syntax'."
     690           0 :   (cl-assert (string-match "^/\\(.*/\\)?$" prefix))
     691           0 :   (let ((parts nil)
     692             :         (i 0)
     693             :         (anchored nil)
     694             :         (state 'normal)
     695           0 :         (pcrelen (length pcre)))
     696           0 :     (while (< i pcrelen)
     697           0 :       (let ((c (aref pcre i)))
     698           0 :         (cond ((eq state 'normal)
     699           0 :                (cond ((string-match
     700           0 :                        (rx (| "}\\?" (: "(?" (not (any ":")))))
     701           0 :                        pcre i)
     702           0 :                       (signal 'vc-hg-unsupported-syntax (list pcre)))
     703           0 :                      ((eq c ?\\)
     704           0 :                       (setf state 'backslash))
     705           0 :                      ((eq c ?\[)
     706           0 :                       (setf state 'charclass-enter)
     707           0 :                       (push c parts))
     708           0 :                      ((eq c ?^)
     709           0 :                       (if (eq i 0) (setf anchored t)
     710           0 :                         (signal 'vc-hg-unsupported-syntax (list pcre))))
     711           0 :                      ((eq c ?$)
     712             :                       ;; Patterns can also match directories exactly,
     713             :                       ;; ignoring everything under a matched directory
     714           0 :                       (push "\\(?:$\\|/\\)" parts))
     715           0 :                      ((memq c '(?| ?\( ?\)))
     716           0 :                       (push ?\\ parts)
     717           0 :                       (push c parts))
     718           0 :                      (t (push c parts))))
     719           0 :               ((eq state 'backslash)
     720           0 :                (cond ((memq c '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9
     721           0 :                                 ?A ?b ?B ?d ?D ?s ?S ?w ?W ?Z ?x))
     722           0 :                       (signal 'vc-hg-unsupported-syntax (list pcre)))
     723           0 :                      ((memq c vc-hg--elisp-metacharacters)
     724           0 :                       (push ?\\ parts)
     725           0 :                       (push c parts))
     726           0 :                      (t (push (or (cdr (assq c vc-hg--pcre-c-escapes)) c) parts)))
     727           0 :                (setf state 'normal))
     728           0 :               ((eq state 'charclass-enter)
     729           0 :                (push c parts)
     730           0 :                (setf state
     731           0 :                      (if (eq c ?\\)
     732             :                          'charclass
     733           0 :                        'charclass-backslash)))
     734           0 :               ((eq state 'charclass-backslash)
     735           0 :                (if (memq c '(?0 ?x))
     736           0 :                    (signal 'vc-hg-unsupported-syntax (list pcre)))
     737           0 :                (push (or (cdr (assq c vc-hg--pcre-c-escapes)) c) parts)
     738           0 :                (setf state 'charclass))
     739           0 :               ((eq state 'charclass)
     740           0 :                (push c parts)
     741           0 :                (cond ((eq c ?\\) (setf state 'charclass-backslash))
     742           0 :                      ((eq c ?\]) (setf state 'normal))))
     743           0 :               (t (error "invalid state")))
     744           0 :         (setf i (1+ i))))
     745           0 :     (unless (eq state 'normal)
     746           0 :       (signal 'vc-hg-unsupported-syntax (list pcre)))
     747           0 :     (concat
     748             :      "^"
     749           0 :      prefix
     750           0 :      (if anchored "" "\\(?:.*/\\)?")
     751           0 :      (vc-hg--parts-to-string parts))))
     752             : 
     753             : (defun vc-hg--glob-to-pcre (glob)
     754             :   "Transform a glob pattern into a Mercurial file pattern regex."
     755           0 :   (let ((parts nil) (i 0) (n (length glob)) (group 0) c)
     756           0 :     (cl-macrolet ((peek () '(and (< i n) (aref glob i))))
     757           0 :       (while (< i n)
     758           0 :         (setf c (aref glob i))
     759           0 :         (cl-incf i)
     760           0 :         (cond ((not (memq c '(?* ?? ?\[ ?\{ ?\} ?, ?\\)))
     761           0 :                (push (vc-hg--escape-for-pcre c) parts))
     762           0 :               ((eq c ?*)
     763           0 :                (cond ((eq (peek) ?*)
     764           0 :                       (cl-incf i)
     765           0 :                       (cond ((eq (peek) ?/)
     766           0 :                              (cl-incf i)
     767           0 :                              (push "(?:.*/)?" parts))
     768             :                             (t
     769           0 :                              (push ".*" parts))))
     770           0 :                      (t (push "[^/]*" parts))))
     771           0 :               ((eq c ??)
     772           0 :                (push ?. parts))
     773           0 :               ((eq c ?\[)
     774           0 :                (let ((j i))
     775           0 :                  (when (and (< j n) (memq (aref glob j) '(?! ?\])))
     776           0 :                    (cl-incf j))
     777           0 :                  (while (and (< j n) (not (eq (aref glob j) ?\])))
     778           0 :                    (cl-incf j))
     779           0 :                  (cond ((>= j n)
     780           0 :                         (push "\\[" parts))
     781             :                        (t
     782           0 :                         (let ((x (substring glob i j)))
     783           0 :                           (setf x (replace-regexp-in-string
     784           0 :                                    "\\\\" "\\\\" x t t))
     785           0 :                           (setf i (1+ j))
     786           0 :                           (cond ((eq (aref x 0) ?!)
     787           0 :                                  (setf (aref x 0) ?^))
     788           0 :                                 ((eq (aref x 0) ?^)
     789           0 :                                  (setf x (concat "\\" x))))
     790           0 :                           (push ?\[ parts)
     791           0 :                           (push x parts)
     792           0 :                           (push ?\] parts))))))
     793           0 :               ((eq c ?\{)
     794           0 :                (cl-incf group)
     795           0 :                (push "(?:" parts))
     796           0 :               ((eq c ?\})
     797           0 :                (push ?\) parts)
     798           0 :                (cl-decf group))
     799           0 :               ((and (eq c ?,) (> group 0))
     800           0 :                (push ?| parts))
     801           0 :               ((eq c ?\\)
     802           0 :                (if (eq i n)
     803           0 :                    (push "\\\\" parts)
     804           0 :                  (cl-incf i)
     805           0 :                  (push ?\\ parts)
     806           0 :                  (push c parts)))
     807             :               (t
     808           0 :                (push (vc-hg--escape-for-pcre c) parts)))))
     809           0 :     (concat (vc-hg--parts-to-string parts) "$")))
     810             : 
     811             : (defvar vc-hg--hgignore-patterns)
     812             : (defvar vc-hg--hgignore-filenames)
     813             : 
     814             : (defun vc-hg--hgignore-add-pcre (pcre prefix)
     815           0 :   (push (vc-hg--pcre-to-elisp-re pcre prefix) vc-hg--hgignore-patterns))
     816             : 
     817             : (defun vc-hg--hgignore-add-glob (glob prefix)
     818           0 :   (push (vc-hg--pcre-to-elisp-re (vc-hg--glob-to-pcre glob) prefix)
     819           0 :         vc-hg--hgignore-patterns))
     820             : 
     821             : (defun vc-hg--hgignore-add-path (path prefix)
     822           0 :   (let ((parts nil))
     823           0 :     (dotimes (i (length path))
     824           0 :       (push (vc-hg--escape-for-pcre (aref path i)) parts))
     825           0 :     (vc-hg--hgignore-add-pcre
     826           0 :      (concat "^" (vc-hg--parts-to-string parts) "$")
     827           0 :      prefix)))
     828             : 
     829             : (defun vc-hg--slurp-hgignore-1 (hgignore prefix)
     830           0 :   (let ((default-syntax 'vc-hg--hgignore-add-pcre))
     831           0 :     (with-temp-buffer
     832           0 :       (let ((attr (file-attributes hgignore)))
     833           0 :         (when attr (insert-file-contents hgignore))
     834           0 :         (push (list hgignore (nth 5 attr) (nth 7 attr))
     835           0 :               vc-hg--hgignore-filenames))
     836           0 :       (while (not (eobp))
     837             :         ;; This list of pattern-file commands isn't complete, but it
     838             :         ;; should cover the common cases.  Remember that we fall back
     839             :         ;; to regular hg commands if we see something we don't like.
     840           0 :         (save-restriction
     841           0 :           (narrow-to-region (point) (point-at-eol))
     842           0 :           (cond ((looking-at "[ \t]*\\(?:#.*\\)?$"))
     843           0 :                 ((looking-at "syntax:[ \t]*re[ \t]*$")
     844           0 :                  (setf default-syntax 'vc-hg--hgignore-add-pcre))
     845           0 :                 ((looking-at "syntax:[ \t]*glob[ \t]*$")
     846           0 :                  (setf default-syntax 'vc-hg--hgignore-add-glob))
     847           0 :                 ((looking-at "path:\\(.+?\\)[ \t]*$")
     848           0 :                  (vc-hg--hgignore-add-path (match-string 1) prefix))
     849           0 :                 ((looking-at "glob:\\(.+?\\)[ \t]*$")
     850           0 :                  (vc-hg--hgignore-add-glob (match-string 1) prefix))
     851           0 :                 ((looking-at "re:\\(.+?\\)[ \t]*$")
     852           0 :                  (vc-hg--hgignore-add-pcre (match-string 1) prefix))
     853           0 :                 ((looking-at "\\(sub\\)?include:\\(.+?\\)[ \t]*$")
     854           0 :                  (let* ((sub (equal (match-string 1) "sub"))
     855           0 :                         (arg (match-string 2))
     856             :                         (included-file
     857           0 :                          (if (string-match "^/" arg) arg
     858           0 :                            (concat (file-name-directory hgignore) arg))))
     859           0 :                    (vc-hg--slurp-hgignore-1
     860           0 :                     included-file
     861           0 :                     (if sub (file-name-directory included-file) prefix))))
     862           0 :                 ((looking-at "[a-zA-Z0-9_]*:")
     863           0 :                  (signal 'vc-hg-unsupported-syntax (list (match-string 0))))
     864           0 :                 ((looking-at ".*$")
     865           0 :                  (funcall default-syntax (match-string 0) prefix))))
     866           0 :         (forward-line 1)))))
     867             : 
     868             : (cl-defstruct (vc-hg--ignore-patterns
     869             :                 (:copier nil)
     870             :                 (:constructor vc-hg--ignore-patterns-make))
     871             :   repo
     872             :   ignore-patterns
     873             :   file-sources)
     874             : 
     875             : (defun vc-hg--slurp-hgignore (repo)
     876             :   "Read hg ignore patterns from REPO.
     877             : REPO must be the directory name of an hg repository."
     878           0 :   (cl-assert (string-match "^/\\(.*/\\)?$" repo))
     879           0 :   (let* ((hgignore (concat repo ".hgignore"))
     880             :          (vc-hg--hgignore-patterns nil)
     881             :          (vc-hg--hgignore-filenames nil))
     882           0 :     (vc-hg--slurp-hgignore-1 hgignore repo)
     883           0 :     (vc-hg--ignore-patterns-make
     884           0 :      :repo repo
     885           0 :      :ignore-patterns (nreverse vc-hg--hgignore-patterns)
     886           0 :      :file-sources (nreverse vc-hg--hgignore-filenames))))
     887             : 
     888             : (defun vc-hg--ignore-patterns-valid-p (hgip)
     889             :   "Return whether the cached ignore patterns in HGIP are still valid"
     890           0 :   (let ((valid t)
     891           0 :         (file-sources (vc-hg--ignore-patterns-file-sources hgip)))
     892           0 :     (while (and file-sources valid)
     893           0 :       (let* ((fs (pop file-sources))
     894           0 :              (saved-mtime (nth 1 fs))
     895           0 :              (saved-size (nth 2 fs))
     896           0 :              (attr (file-attributes (nth 0 fs)))
     897           0 :              (current-mtime (nth 5 attr))
     898           0 :              (current-size (nth 7 attr)))
     899           0 :         (unless (and (equal saved-mtime current-mtime)
     900           0 :                      (equal saved-size current-size))
     901           0 :           (setf valid nil))))
     902           0 :     valid))
     903             : 
     904             : (defun vc-hg--ignore-patterns-ignored-p (hgip filename)
     905             :   "Test whether the ignore pattern set HGIP says to ignore FILENAME.
     906             : FILENAME must be the file's true absolute name."
     907           0 :   (let ((patterns (vc-hg--ignore-patterns-ignore-patterns hgip))
     908             :         (inhibit-changing-match-data t)
     909             :         (ignored nil))
     910           0 :     (while (and patterns (not ignored))
     911           0 :       (setf ignored (string-match (pop patterns) filename)))
     912           0 :     ignored))
     913             : 
     914             : (defun vc-hg--time-to-fixnum (ts)
     915           0 :   (+ (* 65536 (car ts)) (cadr ts)))
     916             : 
     917             : (defvar vc-hg--cached-ignore-patterns nil
     918             :   "Cached pre-parsed hg ignore patterns.")
     919             : 
     920             : (defun vc-hg--file-ignored-p (repo repo-relative-filename)
     921           0 :   (let ((hgip vc-hg--cached-ignore-patterns))
     922           0 :     (unless (and hgip
     923           0 :                  (equal repo (vc-hg--ignore-patterns-repo hgip))
     924           0 :                  (vc-hg--ignore-patterns-valid-p hgip))
     925           0 :       (setf vc-hg--cached-ignore-patterns nil)
     926           0 :       (setf hgip (vc-hg--slurp-hgignore repo))
     927           0 :       (setf vc-hg--cached-ignore-patterns hgip))
     928           0 :     (vc-hg--ignore-patterns-ignored-p
     929           0 :      hgip
     930           0 :      (concat repo repo-relative-filename))))
     931             : 
     932             : (defun vc-hg--read-repo-requirements (repo)
     933           0 :   (cl-assert (string-match "^/\\(.*/\\)?$" repo))
     934           0 :   (let* ((requires-filename (concat repo ".hg/requires")))
     935           0 :     (and (file-exists-p requires-filename)
     936           0 :          (with-temp-buffer
     937           0 :            (set-buffer-multibyte nil)
     938           0 :            (insert-file-contents-literally requires-filename)
     939           0 :            (split-string (buffer-substring-no-properties
     940           0 :                           (point-min) (point-max)))))))
     941             : 
     942             : (defconst vc-hg-supported-requirements
     943             :   '("dotencode"
     944             :     "fncache"
     945             :     "generaldelta"
     946             :     "lz4revlog"
     947             :     "remotefilelog"
     948             :     "revlogv1"
     949             :     "store")
     950             :   "List of Mercurial repository requirements we understand; if a
     951             : repository requires features not present in this list, we avoid
     952             : attempting to parse Mercurial data structures.")
     953             : 
     954             : (defun vc-hg--requirements-understood-p (repo)
     955             :   "Check that we understand the format of the given repository.
     956             : REPO is the directory name of a Mercurial repository."
     957           0 :   (null (cl-set-difference (vc-hg--read-repo-requirements repo)
     958           0 :                            vc-hg-supported-requirements
     959           0 :                            :test #'equal)))
     960             : 
     961             : (defvar vc-hg--dirstate-scan-cache nil
     962             :   "Cache of the last result of `vc-hg--raw-dirstate-search'.
     963             : Avoids the need to repeatedly scan dirstate on repeated calls to
     964             : `vc-hg-state', as we see during registration queries.")
     965             : 
     966             : (defun vc-hg--cached-dirstate-search (dirstate dirstate-attr ascii-fname)
     967           0 :   (let* ((mtime (nth 5 dirstate-attr))
     968           0 :          (size (nth 7 dirstate-attr))
     969           0 :          (cache vc-hg--dirstate-scan-cache)
     970             :          )
     971           0 :     (if (and cache
     972           0 :              (equal dirstate (pop cache))
     973           0 :              (equal mtime (pop cache))
     974           0 :              (equal size (pop cache))
     975           0 :              (equal ascii-fname (pop cache)))
     976           0 :         (pop cache)
     977           0 :       (let ((result (vc-hg--raw-dirstate-search dirstate ascii-fname)))
     978           0 :         (setf vc-hg--dirstate-scan-cache
     979           0 :               (list dirstate mtime size ascii-fname result))
     980           0 :         result))))
     981             : 
     982             : (defun vc-hg-state-fast (filename)
     983             :   "Like `vc-hg-state', but parse internal data structures directly.
     984             : Returns one of the usual `vc-state' enumeration values or
     985             : `unsupported' if we need to take the slow path and run the
     986             : hg binary."
     987           0 :   (let* (truename
     988             :          repo
     989             :          dirstate
     990             :          dirstate-attr
     991             :          repo-relative-filename)
     992           0 :     (if (or
     993             :          ;; Explicit user disable
     994           0 :          (not vc-hg-parse-hg-data-structures)
     995             :          ;; It'll probably be faster to run hg remotely
     996           0 :          (file-remote-p filename)
     997           0 :          (progn
     998           0 :            (setf truename (file-truename filename))
     999           0 :            (file-remote-p truename))
    1000           0 :          (not (setf repo (vc-hg-root truename)))
    1001             :          ;; dirstate must exist
    1002           0 :          (not (progn
    1003           0 :                 (setf repo (expand-file-name repo))
    1004           0 :                 (cl-assert (string-match "^/\\(.*/\\)?$" repo))
    1005           0 :                 (setf dirstate (concat repo ".hg/dirstate"))
    1006           0 :                 (setf dirstate-attr (file-attributes dirstate))))
    1007             :          ;; Repository must be in an understood format
    1008           0 :          (not (vc-hg--requirements-understood-p repo))
    1009             :          ;; Dirstate too small to be valid
    1010           0 :          (< (nth 7 dirstate-attr) 40)
    1011             :          ;; We want to store 32-bit unsigned values in fixnums
    1012           0 :          (< most-positive-fixnum 4294967295)
    1013           0 :          (progn
    1014           0 :            (setf repo-relative-filename
    1015           0 :                  (file-relative-name truename repo))
    1016             :            ;; We only try dealing with ASCII filenames
    1017           0 :            (string-match-p "[^[:ascii:]]" repo-relative-filename)))
    1018             :         'unsupported
    1019           0 :       (let* ((dirstate-entry
    1020           0 :               (vc-hg--cached-dirstate-search
    1021           0 :                dirstate dirstate-attr repo-relative-filename))
    1022           0 :              (state (car dirstate-entry))
    1023           0 :              (stat (file-attributes
    1024           0 :                     (concat repo repo-relative-filename))))
    1025           0 :         (cond ((eq state ?r) 'removed)
    1026           0 :               ((and (not state) stat)
    1027           0 :                (condition-case nil
    1028           0 :                    (if (vc-hg--file-ignored-p repo repo-relative-filename)
    1029             :                        'ignored
    1030           0 :                      'unregistered)
    1031           0 :                  (vc-hg-unsupported-syntax 'unsupported)))
    1032           0 :               ((and state (not stat)) 'missing)
    1033           0 :               ((eq state ?n)
    1034           0 :                (let ((vc-hg-size (nth 2 dirstate-entry))
    1035           0 :                      (vc-hg-mtime (nth 3 dirstate-entry))
    1036           0 :                      (fs-size (nth 7 stat))
    1037           0 :                      (fs-mtime (vc-hg--time-to-fixnum (nth 5 stat))))
    1038           0 :                  (if (and (eql vc-hg-size fs-size) (eql vc-hg-mtime fs-mtime))
    1039             :                      'up-to-date
    1040           0 :                    'edited)))
    1041           0 :               ((eq state ?a) 'added)
    1042           0 :               (state 'unsupported))))))
    1043             : 
    1044             : ;;; Miscellaneous
    1045             : 
    1046             : (defun vc-hg-previous-revision (_file rev)
    1047             :   ;; We can't simply decrement by 1, because that revision might be
    1048             :   ;; e.g. on a different branch (bug#22032).
    1049           0 :   (with-temp-buffer
    1050           0 :     (and (eq 0
    1051           0 :              (vc-hg-command t nil nil "id" "-n" "-r" (concat rev "^")))
    1052             :          ;; Trim the trailing newline.
    1053           0 :          (buffer-substring (point-min) (1- (point-max))))))
    1054             : 
    1055             : (defun vc-hg-next-revision (_file rev)
    1056           0 :   (let ((newrev (1+ (string-to-number rev)))
    1057             :         (tip-revision
    1058           0 :          (with-temp-buffer
    1059           0 :            (vc-hg-command t 0 nil "tip" "--style=default")
    1060           0 :            (goto-char (point-min))
    1061           0 :            (re-search-forward "^changeset:[ \t]*\\([0-9]+\\):")
    1062           0 :            (string-to-number (match-string-no-properties 1)))))
    1063             :     ;; We don't want to exceed the maximum possible revision number, ie
    1064             :     ;; the tip revision.
    1065           0 :     (when (<= newrev tip-revision)
    1066           0 :       (number-to-string newrev))))
    1067             : 
    1068             : ;; Modeled after the similar function in vc-bzr.el
    1069             : (defun vc-hg-delete-file (file)
    1070             :   "Delete FILE and delete it in the hg repository."
    1071           0 :   (condition-case ()
    1072           0 :       (delete-file file)
    1073           0 :     (file-error nil))
    1074           0 :   (vc-hg-command nil 0 file "remove" "--after" "--force"))
    1075             : 
    1076             : ;; Modeled after the similar function in vc-bzr.el
    1077             : (defun vc-hg-rename-file (old new)
    1078             :   "Rename file from OLD to NEW using `hg mv'."
    1079           0 :   (vc-hg-command nil 0 new "mv" old))
    1080             : 
    1081             : (defun vc-hg-register (files &optional _comment)
    1082             :   "Register FILES under hg. COMMENT is ignored."
    1083           0 :   (vc-hg-command nil 0 files "add"))
    1084             : 
    1085             : (defun vc-hg-create-repo ()
    1086             :   "Create a new Mercurial repository."
    1087           0 :   (vc-hg-command nil 0 nil "init"))
    1088             : 
    1089             : (defalias 'vc-hg-responsible-p 'vc-hg-root)
    1090             : 
    1091             : (defun vc-hg-unregister (file)
    1092             :   "Unregister FILE from hg."
    1093           0 :   (vc-hg-command nil 0 file "forget"))
    1094             : 
    1095             : (declare-function log-edit-extract-headers "log-edit" (headers string))
    1096             : 
    1097             : (defun vc-hg-checkin (files comment &optional _rev)
    1098             :   "Hg-specific version of `vc-backend-checkin'.
    1099             : REV is ignored."
    1100           0 :   (apply 'vc-hg-command nil 0 files
    1101           0 :          (nconc (list "commit" "-m")
    1102           0 :                 (log-edit-extract-headers '(("Author" . "--user")
    1103             :                                             ("Date" . "--date"))
    1104           0 :                                           comment))))
    1105             : 
    1106             : (defun vc-hg-find-revision (file rev buffer)
    1107           0 :   (let ((coding-system-for-read 'binary)
    1108             :         (coding-system-for-write 'binary))
    1109           0 :     (if rev
    1110           0 :         (vc-hg-command buffer 0 file "cat" "-r" rev)
    1111           0 :       (vc-hg-command buffer 0 file "cat"))))
    1112             : 
    1113             : (defun vc-hg-find-ignore-file (file)
    1114             :   "Return the root directory of the repository of FILE."
    1115           0 :   (expand-file-name ".hgignore"
    1116           0 :                     (vc-hg-root file)))
    1117             : 
    1118             : ;; Modeled after the similar function in vc-bzr.el
    1119             : (defun vc-hg-checkout (file &optional rev)
    1120             :   "Retrieve a revision of FILE.
    1121             : EDITABLE is ignored.
    1122             : REV is the revision to check out into WORKFILE."
    1123           0 :   (let ((coding-system-for-read 'binary)
    1124             :         (coding-system-for-write 'binary))
    1125           0 :   (with-current-buffer (or (get-file-buffer file) (current-buffer))
    1126           0 :     (if rev
    1127           0 :         (vc-hg-command t 0 file "cat" "-r" rev)
    1128           0 :       (vc-hg-command t 0 file "cat")))))
    1129             : 
    1130             : (defun vc-hg-resolve-when-done ()
    1131             :   "Call \"hg resolve -m\" if the conflict markers have been removed."
    1132           0 :   (save-excursion
    1133           0 :     (goto-char (point-min))
    1134           0 :     (unless (re-search-forward "^<<<<<<< " nil t)
    1135           0 :       (vc-hg-command nil 0 buffer-file-name "resolve" "-m")
    1136             :       ;; Remove the hook so that it is not called multiple times.
    1137           0 :       (remove-hook 'after-save-hook 'vc-hg-resolve-when-done t))))
    1138             : 
    1139             : (defun vc-hg-find-file-hook ()
    1140           0 :   (when (and buffer-file-name
    1141           0 :              (file-exists-p (concat buffer-file-name ".orig"))
    1142             :              ;; Hg does not seem to have a "conflict" status, eg
    1143             :              ;; hg http://bz.selenic.com/show_bug.cgi?id=2724
    1144           0 :              (memq (vc-file-getprop buffer-file-name 'vc-state)
    1145           0 :                    '(edited conflict))
    1146             :              ;; Maybe go on to check that "hg resolve -l" says "U"?
    1147             :              ;; If "hg resolve -l" says there's a conflict but there are no
    1148             :              ;; conflict markers, it's not clear what we should do.
    1149           0 :              (save-excursion
    1150           0 :                (goto-char (point-min))
    1151           0 :                (re-search-forward "^<<<<<<< " nil t)))
    1152             :     ;; Hg may not recognize "conflict" as a state, but we can do better.
    1153           0 :     (vc-file-setprop buffer-file-name 'vc-state 'conflict)
    1154           0 :     (smerge-start-session)
    1155           0 :     (add-hook 'after-save-hook 'vc-hg-resolve-when-done nil t)
    1156           0 :     (vc-message-unresolved-conflicts buffer-file-name)))
    1157             : 
    1158             : 
    1159             : ;; Modeled after the similar function in vc-bzr.el
    1160             : (defun vc-hg-revert (file &optional contents-done)
    1161           0 :   (unless contents-done
    1162           0 :     (with-temp-buffer (vc-hg-command t 0 file "revert"))))
    1163             : 
    1164             : ;;; Hg specific functionality.
    1165             : 
    1166             : (defvar vc-hg-extra-menu-map
    1167             :   (let ((map (make-sparse-keymap)))
    1168             :     map))
    1169             : 
    1170           0 : (defun vc-hg-extra-menu () vc-hg-extra-menu-map)
    1171             : 
    1172           0 : (defun vc-hg-extra-status-menu () vc-hg-extra-menu-map)
    1173             : 
    1174             : (defvar log-view-vc-backend)
    1175             : 
    1176             : (cl-defstruct (vc-hg-extra-fileinfo
    1177             :             (:copier nil)
    1178             :             (:constructor vc-hg-create-extra-fileinfo (rename-state extra-name))
    1179             :             (:conc-name vc-hg-extra-fileinfo->))
    1180             :   rename-state        ;; rename or copy state
    1181             :   extra-name)         ;; original name for copies and rename targets, new name for
    1182             : 
    1183             : (declare-function vc-default-dir-printer "vc-dir" (backend fileentry))
    1184             : 
    1185             : (defun vc-hg-dir-printer (info)
    1186             :   "Pretty-printer for the vc-dir-fileinfo structure."
    1187           0 :   (let ((extra (vc-dir-fileinfo->extra info)))
    1188           0 :     (vc-default-dir-printer 'Hg info)
    1189           0 :     (when extra
    1190           0 :       (insert (propertize
    1191           0 :                (format "   (%s %s)"
    1192           0 :                        (pcase (vc-hg-extra-fileinfo->rename-state extra)
    1193             :                          (`copied "copied from")
    1194             :                          (`renamed-from "renamed from")
    1195           0 :                          (`renamed-to "renamed to"))
    1196           0 :                        (vc-hg-extra-fileinfo->extra-name extra))
    1197           0 :                'face 'font-lock-comment-face)))))
    1198             : 
    1199             : (defun vc-hg-after-dir-status (update-function)
    1200           0 :   (let ((file nil)
    1201             :         (translation '((?= . up-to-date)
    1202             :                        (?C . up-to-date)
    1203             :                        (?A . added)
    1204             :                        (?R . removed)
    1205             :                        (?M . edited)
    1206             :                        (?I . ignored)
    1207             :                        (?! . missing)
    1208             :                        (?  . copy-rename-line)
    1209             :                        (?? . unregistered)))
    1210             :         (translated nil)
    1211             :         (result nil)
    1212             :         (last-added nil)
    1213             :         (last-line-copy nil))
    1214           0 :       (goto-char (point-min))
    1215           0 :       (while (not (eobp))
    1216           0 :         (setq translated (cdr (assoc (char-after) translation)))
    1217           0 :         (setq file
    1218           0 :               (buffer-substring-no-properties (+ (point) 2)
    1219           0 :                                               (line-end-position)))
    1220           0 :         (cond ((not translated)
    1221           0 :                (setq last-line-copy nil))
    1222           0 :               ((eq translated 'up-to-date)
    1223           0 :                (setq last-line-copy nil))
    1224           0 :               ((eq translated 'copy-rename-line)
    1225             :                ;; For copied files the output looks like this:
    1226             :                ;; A COPIED_FILE_NAME
    1227             :                ;;   ORIGINAL_FILE_NAME
    1228           0 :                (setf (nth 2 last-added)
    1229           0 :                      (vc-hg-create-extra-fileinfo 'copied file))
    1230           0 :                (setq last-line-copy t))
    1231           0 :               ((and last-line-copy (eq translated 'removed))
    1232             :                ;; For renamed files the output looks like this:
    1233             :                ;; A NEW_FILE_NAME
    1234             :                ;;   ORIGINAL_FILE_NAME
    1235             :                ;; R ORIGINAL_FILE_NAME
    1236             :                ;; We need to adjust the previous entry to not think it is a copy.
    1237           0 :                (setf (vc-hg-extra-fileinfo->rename-state (nth 2 last-added))
    1238           0 :                      'renamed-from)
    1239           0 :                (push (list file translated
    1240           0 :                            (vc-hg-create-extra-fileinfo
    1241           0 :                             'renamed-to (nth 0 last-added))) result)
    1242           0 :                (setq last-line-copy nil))
    1243             :               (t
    1244           0 :                (setq last-added (list file translated nil))
    1245           0 :                (push last-added result)
    1246           0 :                (setq last-line-copy nil)))
    1247           0 :         (forward-line))
    1248           0 :       (funcall update-function result)))
    1249             : 
    1250             : ;; Follows vc-hg-command (or vc-do-async-command), which uses vc-do-command
    1251             : ;; from vc-dispatcher.
    1252             : (declare-function vc-exec-after "vc-dispatcher" (code))
    1253             : ;; Follows vc-exec-after.
    1254             : (declare-function vc-set-async-update "vc-dispatcher" (process-buffer))
    1255             : 
    1256             : (defun vc-hg-dir-status-files (_dir files update-function)
    1257             :   ;; XXX: We can't pass DIR directly to 'hg status' because that
    1258             :   ;; returns all ignored files if FILES is non-nil (bug#22481).
    1259             :   ;; If honoring DIR ever becomes important, try using '-I DIR/'.
    1260           0 :   (vc-hg-command (current-buffer) 'async files
    1261             :                  "status"
    1262           0 :                  (concat "-mardu" (if files "i"))
    1263           0 :                  "-C")
    1264           0 :   (vc-run-delayed
    1265           0 :     (vc-hg-after-dir-status update-function)))
    1266             : 
    1267             : (defun vc-hg-dir-extra-header (name &rest commands)
    1268           0 :   (concat (propertize name 'face 'font-lock-type-face)
    1269           0 :           (propertize
    1270           0 :            (with-temp-buffer
    1271           0 :              (apply 'vc-hg-command (current-buffer) 0 nil commands)
    1272           0 :              (buffer-substring-no-properties (point-min) (1- (point-max))))
    1273           0 :            'face 'font-lock-variable-name-face)))
    1274             : 
    1275             : (defun vc-hg-dir-extra-headers (dir)
    1276             :   "Generate extra status headers for a Mercurial tree."
    1277           0 :   (let ((default-directory dir))
    1278           0 :     (concat
    1279           0 :      (vc-hg-dir-extra-header "Root       : " "root") "\n"
    1280           0 :      (vc-hg-dir-extra-header "Branch     : " "id" "-b") "\n"
    1281           0 :      (vc-hg-dir-extra-header "Tags       : " "id" "-t") ; "\n"
    1282             :      ;; these change after each commit
    1283             :      ;; (vc-hg-dir-extra-header "Local num  : " "id" "-n") "\n"
    1284             :      ;; (vc-hg-dir-extra-header "Global id  : " "id" "-i")
    1285           0 :      )))
    1286             : 
    1287             : (defun vc-hg-log-incoming (buffer remote-location)
    1288           0 :   (vc-hg-command buffer 1 nil "incoming" "-n" (unless (string= remote-location "")
    1289           0 :                                                 remote-location)))
    1290             : 
    1291             : (defun vc-hg-log-outgoing (buffer remote-location)
    1292           0 :   (vc-hg-command buffer 1 nil "outgoing" "-n" (unless (string= remote-location "")
    1293           0 :                                                 remote-location)))
    1294             : 
    1295             : (defvar vc-hg-error-regexp-alist nil
    1296             :   ;; 'hg pull' does not list modified files, so, for now, the only
    1297             :   ;; benefit of `vc-compilation-mode' is that one can get rid of
    1298             :   ;; *vc-hg* buffer with 'q' or 'z'.
    1299             :   ;; TODO: call 'hg incoming' before pull/merge to get the list of
    1300             :   ;;       modified files
    1301             :   "Value of `compilation-error-regexp-alist' in *vc-hg* buffers.")
    1302             : 
    1303             : (autoload 'vc-do-async-command "vc-dispatcher")
    1304             : (autoload 'log-view-get-marked "log-view")
    1305             : (defvar compilation-directory)
    1306             : (defvar compilation-arguments)  ; defined in compile.el
    1307             : 
    1308             : (defun vc-hg--pushpull (command prompt &optional obsolete)
    1309             :   "Run COMMAND (a string; either push or pull) on the current Hg branch.
    1310             : If PROMPT is non-nil, prompt for the Hg command to run.
    1311             : If OBSOLETE is non-nil, behave like the old versions of the Hg push/pull
    1312             : commands, which only operated on marked files."
    1313           0 :   (let (marked-list)
    1314             :     ;; The `vc-hg-pull' and `vc-hg-push' commands existed before the
    1315             :     ;; `pull'/`push' VC actions were implemented.
    1316             :     ;; The following is for backwards compatibility.
    1317           0 :     (if (and obsolete (setq marked-list (log-view-get-marked)))
    1318           0 :         (apply #'vc-hg-command
    1319             :                nil 0 nil
    1320           0 :                command
    1321           0 :                (apply 'nconc
    1322           0 :                       (mapcar (lambda (arg) (list "-r" arg)) marked-list)))
    1323           0 :       (let* ((root (vc-hg-root default-directory))
    1324           0 :              (buffer (format "*vc-hg : %s*" (expand-file-name root)))
    1325           0 :              (hg-program vc-hg-program)
    1326             :              ;; Fixme: before updating the working copy to the latest
    1327             :              ;; state, should check if it's visiting an old revision.
    1328           0 :              (args (if (equal command "pull") '("-u"))))
    1329             :         ;; If necessary, prompt for the exact command.
    1330             :         ;; TODO if pushing, prompt if no default push location - cf bzr.
    1331           0 :         (when prompt
    1332           0 :           (setq args (split-string
    1333           0 :                       (read-shell-command
    1334           0 :                        (format "Hg %s command: " command)
    1335           0 :                        (format "%s %s%s" hg-program command
    1336           0 :                                (if (not args) ""
    1337           0 :                                  (concat " " (mapconcat 'identity args " "))))
    1338           0 :                        'vc-hg-history)
    1339           0 :                       " " t))
    1340           0 :           (setq hg-program (car  args)
    1341           0 :                 command    (cadr args)
    1342           0 :                 args       (cddr args)))
    1343           0 :         (apply 'vc-do-async-command buffer root hg-program command args)
    1344           0 :         (with-current-buffer buffer
    1345           0 :           (vc-run-delayed
    1346           0 :             (vc-compilation-mode 'hg)
    1347           0 :             (setq-local compile-command
    1348           0 :                         (concat hg-program " " command " "
    1349           0 :                                 (if args (mapconcat 'identity args " ") "")))
    1350           0 :             (setq-local compilation-directory root)
    1351             :             ;; Either set `compilation-buffer-name-function' locally to nil
    1352             :             ;; or use `compilation-arguments' to set `name-function'.
    1353             :             ;; See `compilation-buffer-name'.
    1354           0 :             (setq-local compilation-arguments
    1355           0 :                         (list compile-command nil
    1356           0 :                               (lambda (_name-of-mode) buffer)
    1357           0 :                               nil))))
    1358           0 :         (vc-set-async-update buffer)))))
    1359             : 
    1360             : (defun vc-hg-pull (prompt)
    1361             :   "Issue a Mercurial pull command.
    1362             : If called interactively with a set of marked Log View buffers,
    1363             : call \"hg pull -r REVS\" to pull in the specified revisions REVS.
    1364             : 
    1365             : With a prefix argument or if PROMPT is non-nil, prompt for a
    1366             : specific Mercurial pull command.  The default is \"hg pull -u\",
    1367             : which fetches changesets from the default remote repository and
    1368             : then attempts to update the working directory."
    1369             :   (interactive "P")
    1370           0 :   (vc-hg--pushpull "pull" prompt (called-interactively-p 'interactive)))
    1371             : 
    1372             : (defun vc-hg-push (prompt)
    1373             :   "Push changes from the current Mercurial branch.
    1374             : Normally, this runs \"hg push\".  If PROMPT is non-nil, prompt
    1375             : for the Hg command to run.
    1376             : 
    1377             : If called interactively with a set of marked Log View buffers,
    1378             : call \"hg push -r REVS\" to push the specified revisions REVS."
    1379             :   (interactive "P")
    1380           0 :   (vc-hg--pushpull "push" prompt (called-interactively-p 'interactive)))
    1381             : 
    1382             : (defun vc-hg-merge-branch ()
    1383             :   "Merge incoming changes into the current working directory.
    1384             : This runs the command \"hg merge\"."
    1385           0 :   (let* ((root (vc-hg-root default-directory))
    1386           0 :          (buffer (format "*vc-hg : %s*" (expand-file-name root))))
    1387           0 :     (apply 'vc-do-async-command buffer root vc-hg-program '("merge"))
    1388           0 :     (with-current-buffer buffer (vc-run-delayed (vc-compilation-mode 'hg)))
    1389           0 :     (vc-set-async-update buffer)))
    1390             : 
    1391             : ;;; Internal functions
    1392             : 
    1393             : (defun vc-hg-command (buffer okstatus file-or-list &rest flags)
    1394             :   "A wrapper around `vc-do-command' for use in vc-hg.el.
    1395             : This function differs from vc-do-command in that it invokes
    1396             : `vc-hg-program', and passes `vc-hg-global-switches' to it before FLAGS."
    1397           0 :   (apply 'vc-do-command (or buffer "*vc*") okstatus vc-hg-program file-or-list
    1398           0 :          (if (stringp vc-hg-global-switches)
    1399           0 :              (cons vc-hg-global-switches flags)
    1400           0 :            (append vc-hg-global-switches
    1401           0 :                    flags))))
    1402             : 
    1403             : (defun vc-hg-root (file)
    1404          17 :   (vc-find-root file ".hg"))
    1405             : 
    1406             : (provide 'vc-hg)
    1407             : 
    1408             : ;;; vc-hg.el ends here

Generated by: LCOV version 1.12