-;;; 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-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
;; Author: Ivan Kanis
+;; Maintainer: FSF
;; Keywords: vc tools
;; Package: vc
;;; 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.
(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"
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
(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
((eq state ?R) 'removed)
((eq state ?!) 'missing)
((eq state ??) 'unregistered)
- ((eq state ?C) 'up-to-date) ;; Older mercurials use this
+ ((eq state ?C) 'up-to-date) ;; Older mercurial versions use this.
(t 'up-to-date)))))))
(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
;; 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)
(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
"Rename file from OLD to NEW using `hg mv'."
(vc-hg-command nil 0 new "mv" old))
-(defun vc-hg-register (files &optional rev comment)
+(defun vc-hg-register (files &optional _rev _comment)
"Register FILES under hg.
REV is ignored.
COMMENT is ignored."
(declare-function log-edit-extract-headers "log-edit" (headers string))
-(defun vc-hg-checkin (files rev comment)
+(defun vc-hg-checkin (files _rev comment)
"Hg-specific version of `vc-backend-checkin'.
REV is ignored."
(apply 'vc-hg-command nil 0 files
(vc-hg-command buffer 0 file "cat"))))
;; Modeled after the similar function in vc-bzr.el
-(defun vc-hg-checkout (file &optional editable rev)
+(defun vc-hg-checkout (file &optional _editable rev)
"Retrieve a revision of FILE.
EDITABLE is ignored.
REV is the revision to check out into WORKFILE."
(defvar log-view-vc-backend)
-(defstruct (vc-hg-extra-fileinfo
+(cl-defstruct (vc-hg-extra-fileinfo
(:copier nil)
(:constructor vc-hg-create-extra-fileinfo (rename-state extra-name))
(:conc-name vc-hg-extra-fileinfo->))
(when extra
(insert (propertize
(format " (%s %s)"
- (case (vc-hg-extra-fileinfo->rename-state extra)
- ('copied "copied from")
- ('renamed-from "renamed from")
- ('renamed-to "renamed to"))
+ (pcase (vc-hg-extra-fileinfo->rename-state extra)
+ (`copied "copied from")
+ (`renamed-from "renamed from")
+ (`renamed-to "renamed to"))
(vc-hg-extra-fileinfo->extra-name extra))
'face 'font-lock-comment-face)))))
(defun vc-hg-after-dir-status (update-function)
- (let ((status-char nil)
- (file nil)
+ (let ((file nil)
(translation '((?= . up-to-date)
(?C . up-to-date)
(?A . added)
(vc-exec-after
`(vc-hg-after-dir-status (quote ,update-function))))
-(defun vc-hg-dir-status-files (dir files default-state update-function)
+(defun vc-hg-dir-status-files (dir files _default-state update-function)
(apply 'vc-hg-command (current-buffer) 'async dir "status" "-C" files)
(vc-exec-after
`(vc-hg-after-dir-status (quote ,update-function))))
(let* ((root (vc-hg-root default-directory))
(buffer (format "*vc-hg : %s*" (expand-file-name root)))
(command "pull")
- (hg-program "hg")
+ (hg-program vc-hg-program)
;; Fixme: before updating the working copy to the latest
;; state, should check if it's visiting an old revision.
(args '("-u")))
;; If necessary, prompt for the exact command.
(when prompt
(setq args (split-string
- (read-shell-command "Run Hg (like this): " "hg pull -u"
+ (read-shell-command "Run Hg (like this): "
+ (format "%s pull -u" hg-program)
'vc-hg-history)
" " t))
(setq hg-program (car args)
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 "hg" '("merge"))
+ (apply 'vc-do-async-command buffer root vc-hg-program '("merge"))
(vc-set-async-update buffer)))
;;; Internal functions
HCoop / bpt / emacs.git / blobdiff