X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/97d44922da3c22b3973f95892bfa2ee4afc0ceac..1829a1fc85b040912dc194806c64670096ddcf43:/lisp/vc/vc-hg.el diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index c841dfcdf5..2d8bab7059 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -1,6 +1,6 @@ ;;; vc-hg.el --- VC backend for the mercurial version control system -*- lexical-binding: t -*- -;; Copyright (C) 2006-2015 Free Software Foundation, Inc. +;; Copyright (C) 2006-2016 Free Software Foundation, Inc. ;; Author: Ivan Kanis ;; Maintainer: emacs-devel@gnu.org @@ -131,7 +131,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." :version "23.1" :group 'vc-hg) -(defcustom vc-hg-annotate-switches nil +(defcustom vc-hg-annotate-switches '("-u" "--follow") "String or list of strings specifying switches for hg annotate under VC. If nil, use the value of `vc-annotate-switches'. If t, use no switches." @@ -259,6 +259,14 @@ highlighting the Log View buffer." (defvar vc-hg-log-graph nil "If non-nil, use `--graph' in the short log output.") +(defvar vc-hg-log-format (concat "changeset: {rev}:{node|short}\n" + "{tags % 'tag: {tag}\n'}" + "{if(parents, 'parents: {parents}\n')}" + "user: {author}\n" + "Date: {date|date}\n" + "summary: {desc|tabindent}\n\n") + "Mercurial log template for `vc-hg-print-log' long format.") + (defun vc-hg-print-log (files buffer &optional shortlog start-revision limit) "Print commit log associated with FILES into specified BUFFER. If SHORTLOG is non-nil, use a short format based on `vc-hg-root-log-format'. @@ -272,13 +280,15 @@ If LIMIT is non-nil, show no more than this many entries." (let ((inhibit-read-only t)) (with-current-buffer buffer - (apply 'vc-hg-command buffer 0 files "log" + (apply 'vc-hg-command buffer 'async files "log" (nconc (when start-revision (list (format "-r%s:0" start-revision))) (when limit (list "-l" (format "%s" limit))) - (when shortlog `(,@(if vc-hg-log-graph '("--graph")) - "--template" - ,(car vc-hg-root-log-format))) + (if shortlog + `(,@(if vc-hg-log-graph '("--graph")) + "--template" + ,(car vc-hg-root-log-format)) + `("--template" ,vc-hg-log-format)) vc-hg-log-switches))))) (defvar log-view-message-re) @@ -295,6 +305,7 @@ If LIMIT is non-nil, show no more than this many entries." (if (eq vc-log-view-type 'short) (cadr vc-hg-root-log-format) "^changeset:[ \t]*\\([0-9]+\\):\\(.+\\)")) + (set (make-local-variable 'tab-width) 2) ;; Allow expanding short log entries (when (eq vc-log-view-type 'short) (setq truncate-lines t) @@ -324,7 +335,7 @@ If LIMIT is non-nil, show no more than this many entries." (autoload 'vc-switches "vc") -(defun vc-hg-diff (files &optional oldvers newvers buffer async) +(defun vc-hg-diff (files &optional oldvers newvers buffer _async) "Get a difference report using hg between two revisions of FILES." (let* ((firstfile (car files)) (working (and firstfile (vc-working-revision firstfile)))) @@ -334,8 +345,8 @@ If LIMIT is non-nil, show no more than this many entries." (setq oldvers working)) (apply #'vc-hg-command (or buffer "*vc-diff*") - (if async 'async nil) - files "diff" + nil ; bug#21969 + files "diff" (append (vc-switches 'hg 'diff) (when oldvers @@ -345,7 +356,7 @@ If LIMIT is non-nil, show no more than this many entries." (defun vc-hg-expanded-log-entry (revision) (with-temp-buffer - (vc-hg-command t nil nil "log" "-r" revision) + (vc-hg-command t nil nil "log" "-r" revision "--template" vc-hg-log-format) (goto-char (point-min)) (unless (eobp) ;; Indent the expanded log entry. @@ -369,36 +380,44 @@ If LIMIT is non-nil, show no more than this many entries." (defun vc-hg-annotate-command (file buffer &optional revision) "Execute \"hg annotate\" on FILE, inserting the contents in BUFFER. Optional arg REVISION is a revision to annotate from." - (apply #'vc-hg-command buffer 0 file "annotate" "-d" "-n" "--follow" + (apply #'vc-hg-command buffer 0 file "annotate" "-dq" "-n" (append (vc-switches 'hg 'annotate) (if revision (list (concat "-r" revision)))))) -(declare-function vc-annotate-convert-time "vc-annotate" (time)) +(declare-function vc-annotate-convert-time "vc-annotate" (&optional time)) -;; The format for one line output by "hg annotate -d -n" looks like this: -;;215 Wed Jun 20 21:22:58 2007 -0700: CONTENTS -;; i.e: VERSION_NUMBER DATE: CONTENTS -;; If the user has set the "--follow" option, the output looks like: -;;215 Wed Jun 20 21:22:58 2007 -0700 foo.c: CONTENTS -;; i.e. VERSION_NUMBER DATE FILENAME: CONTENTS +;; One line printed by "hg annotate -dq -n -u --follow" looks like this: +;; b56girard 114590 2012-03-13 CLOBBER: Lorem ipsum dolor sit +;; i.e. AUTHOR REVISION DATE FILENAME: CONTENTS +;; The user can omit options "-u" and/or "--follow". Then it'll look like: +;; 114590 2012-03-13 CLOBBER: +;; or +;; b56girard 114590 2012-03-13: (defconst vc-hg-annotate-re - "^[ \t]*\\([0-9]+\\) \\(.\\{30\\}\\)\\(?:\\(: \\)\\|\\(?: +\\([^:\n]+\\(?::\\(?:[^: \n][^:\n]*\\)?\\)*\\): \\)\\)") + (concat + "^\\(?: *[^ ]+ +\\)?\\([0-9]+\\) " ;User and revision. + "\\([0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9]\\)" ;Date. + "\\(?: +\\([^:]+\\)\\)?:")) ;Filename. (defun vc-hg-annotate-time () (when (looking-at vc-hg-annotate-re) (goto-char (match-end 0)) (vc-annotate-convert-time - (date-to-time (match-string-no-properties 2))))) + (let ((str (match-string-no-properties 2))) + (encode-time 0 0 0 + (string-to-number (substring str 6 8)) + (string-to-number (substring str 4 6)) + (string-to-number (substring str 0 4))))))) (defun vc-hg-annotate-extract-revision-at-line () (save-excursion (beginning-of-line) (when (looking-at vc-hg-annotate-re) (if (match-beginning 3) - (match-string-no-properties 1) - (cons (match-string-no-properties 1) - (expand-file-name (match-string-no-properties 4) - (vc-hg-root default-directory))))))) + (cons (match-string-no-properties 1) + (expand-file-name (match-string-no-properties 3) + (vc-hg-root default-directory))) + (match-string-no-properties 1))))) ;;; Tag system @@ -419,9 +438,13 @@ Optional arg REVISION is a revision to annotate from." ;;; Miscellaneous (defun vc-hg-previous-revision (_file rev) - (let ((newrev (1- (string-to-number rev)))) - (when (>= newrev 0) - (number-to-string newrev)))) + ;; We can't simply decrement by 1, because that revision might be + ;; e.g. on a different branch (bug#22032). + (with-temp-buffer + (and (eq 0 + (vc-hg-command t nil nil "id" "-n" "-r" (concat rev "^"))) + ;; Trim the trailing newline. + (buffer-substring (point-min) (1- (point-max)))))) (defun vc-hg-next-revision (_file rev) (let ((newrev (1+ (string-to-number rev))) @@ -465,7 +488,7 @@ Optional arg REVISION is a revision to annotate from." (declare-function log-edit-extract-headers "log-edit" (headers string)) -(defun vc-hg-checkin (files comment) +(defun vc-hg-checkin (files comment &optional _rev) "Hg-specific version of `vc-backend-checkin'. REV is ignored." (apply 'vc-hg-command nil 0 files @@ -524,7 +547,7 @@ REV is the revision to check out into WORKFILE." (vc-file-setprop buffer-file-name 'vc-state 'conflict) (smerge-start-session) (add-hook 'after-save-hook 'vc-hg-resolve-when-done nil t) - (message "There are unresolved conflicts in this file"))) + (vc-message-unresolved-conflicts buffer-file-name))) ;; Modeled after the similar function in vc-bzr.el @@ -624,10 +647,14 @@ REV is the revision to check out into WORKFILE." ;; Follows vc-exec-after. (declare-function vc-set-async-update "vc-dispatcher" (process-buffer)) -(defun vc-hg-dir-status-files (dir files update-function) - (apply 'vc-hg-command (current-buffer) 'async dir "status" - (concat "-mardu" (if files "i")) - "-C" files) +(defun vc-hg-dir-status-files (_dir files update-function) + ;; XXX: We can't pass DIR directly to 'hg status' because that + ;; returns all ignored files if FILES is non-nil (bug#22481). + ;; If honoring DIR ever becomes important, try using '-I DIR/'. + (vc-hg-command (current-buffer) 'async files + "status" + (concat "-mardu" (if files "i")) + "-C") (vc-run-delayed (vc-hg-after-dir-status update-function))) @@ -659,20 +686,6 @@ REV is the revision to check out into WORKFILE." (vc-hg-command buffer 1 nil "outgoing" "-n" (unless (string= remote-location "") remote-location))) -(declare-function log-view-get-marked "log-view" ()) - -;; XXX maybe also add key bindings for these functions. -(defun vc-hg-push () - (interactive) - (let ((marked-list (log-view-get-marked))) - (if marked-list - (apply #'vc-hg-command - nil 0 nil - "push" - (apply 'nconc - (mapcar (lambda (arg) (list "-r" arg)) marked-list))) - (error "No log entries selected for push")))) - (defvar vc-hg-error-regexp-alist nil ;; 'hg pull' does not list modified files, so, for now, the only ;; benefit of `vc-compilation-mode' is that one can get rid of @@ -682,51 +695,70 @@ REV is the revision to check out into WORKFILE." "Value of `compilation-error-regexp-alist' in *vc-hg* buffers.") (autoload 'vc-do-async-command "vc-dispatcher") +(autoload 'log-view-get-marked "log-view") -(defun vc-hg-pull (prompt) - "Issue a Mercurial pull command. -If called interactively with a set of marked Log View buffers, -call \"hg pull -r REVS\" to pull in the specified revisions REVS. - -With a prefix argument or if PROMPT is non-nil, prompt for a -specific Mercurial pull command. The default is \"hg pull -u\", -which fetches changesets from the default remote repository and -then attempts to update the working directory." - (interactive "P") +(defun vc-hg--pushpull (command prompt &optional obsolete) + "Run COMMAND (a string; either push or pull) on the current Hg branch. +If PROMPT is non-nil, prompt for the Hg command to run. +If OBSOLETE is non-nil, behave like the old versions of the Hg push/pull +commands, which only operated on marked files." (let (marked-list) - ;; The `vc-hg-pull' command existed before the `pull' VC action - ;; was implemented. Keep it for backward compatibility. - (if (and (called-interactively-p 'interactive) - (setq marked-list (log-view-get-marked))) + ;; The `vc-hg-pull' and `vc-hg-push' commands existed before the + ;; `pull'/`push' VC actions were implemented. + ;; The following is for backwards compatibility. + (if (and obsolete (setq marked-list (log-view-get-marked))) (apply #'vc-hg-command nil 0 nil - "pull" + command (apply 'nconc - (mapcar (lambda (arg) (list "-r" arg)) - marked-list))) + (mapcar (lambda (arg) (list "-r" arg)) marked-list))) (let* ((root (vc-hg-root default-directory)) (buffer (format "*vc-hg : %s*" (expand-file-name root))) - (command "pull") (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"))) + (args (if (equal command "pull") '("-u")))) ;; If necessary, prompt for the exact command. + ;; TODO if pushing, prompt if no default push location - cf bzr. (when prompt (setq args (split-string - (read-shell-command "Run Hg (like this): " - (format "%s pull -u" hg-program) - 'vc-hg-history) + (read-shell-command + (format "Hg %s command: " command) + (format "%s %s%s" hg-program command + (if (not args) "" + (concat " " (mapconcat 'identity args " ")))) + 'vc-hg-history) " " t)) (setq hg-program (car args) command (cadr args) args (cddr args))) - (apply 'vc-do-async-command buffer root hg-program - command args) + (apply 'vc-do-async-command buffer root hg-program command args) (with-current-buffer buffer (vc-run-delayed (vc-compilation-mode 'hg))) (vc-set-async-update buffer))))) +(defun vc-hg-pull (prompt) + "Issue a Mercurial pull command. +If called interactively with a set of marked Log View buffers, +call \"hg pull -r REVS\" to pull in the specified revisions REVS. + +With a prefix argument or if PROMPT is non-nil, prompt for a +specific Mercurial pull command. The default is \"hg pull -u\", +which fetches changesets from the default remote repository and +then attempts to update the working directory." + (interactive "P") + (vc-hg--pushpull "pull" prompt (called-interactively-p 'interactive))) + +(defun vc-hg-push (prompt) + "Push changes from the current Mercurial branch. +Normally, this runs \"hg push\". If PROMPT is non-nil, prompt +for the Hg command to run. + +If called interactively with a set of marked Log View buffers, +call \"hg push -r REVS\" to push the specified revisions REVS." + (interactive "P") + (vc-hg--pushpull "push" prompt (called-interactively-p 'interactive))) + (defun vc-hg-merge-branch () "Merge incoming changes into the current working directory. This runs the command \"hg merge\"."