# HG changeset patch # User mpm@selenic.com # Date 1124832079 25200 # Node ID f46e809bbe873a3d9230c84273a6958f78615f2e # Parent 42956a6cb25755c7044259d35b02bd787664a4c3# Parent 1bc619b12025312a1d2707f7b3d988609d92874d Merge with TAH diff --git a/contrib/mercurial.el b/contrib/mercurial.el --- a/contrib/mercurial.el +++ b/contrib/mercurial.el @@ -4,8 +4,6 @@ ;; Author: Bryan O'Sullivan -;; $Id$ - ;; mercurial.el is free software; you can redistribute it and/or ;; modify it under the terms of version 2 of the GNU General Public ;; License as published by the Free Software Foundation. @@ -22,7 +20,7 @@ ;;; Commentary: -;; This mode builds upon Emacs's VC mode to provide flexible +;; mercurial.el builds upon Emacs's VC mode to provide flexible ;; integration with the Mercurial distributed SCM tool. ;; To get going as quickly as possible, load mercurial.el into Emacs and @@ -34,9 +32,9 @@ ;; job for the commercial Perforce SCM product. In fact, substantial ;; chunks of code are adapted from p4.el. -;; This code has been developed under XEmacs 21.5, and may will not -;; work as well under GNU Emacs (albeit tested under 21.2). Patches -;; to enhance the portability of this code, fix bugs, and add features +;; This code has been developed under XEmacs 21.5, and may not work as +;; well under GNU Emacs (albeit tested under 21.4). Patches to +;; enhance the portability of this code, fix bugs, and add features ;; are most welcome. You can clone a Mercurial repository for this ;; package from http://www.serpentine.com/hg/hg-emacs @@ -83,11 +81,32 @@ :type 'sexp :group 'mercurial) +(defcustom hg-commit-mode-hook nil + "Hook run when a buffer is created to prepare a commit." + :type 'sexp + :group 'mercurial) + +(defcustom hg-pre-commit-hook nil + "Hook run before a commit is performed. +If you want to prevent the commit from proceeding, raise an error." + :type 'sexp + :group 'mercurial) + (defcustom hg-global-prefix "\C-ch" "The global prefix for Mercurial keymap bindings." :type 'sexp :group 'mercurial) +(defcustom hg-commit-allow-empty-message nil + "Whether to allow changes to be committed with empty descriptions." + :type 'boolean + :group 'mercurial) + +(defcustom hg-commit-allow-empty-file-list nil + "Whether to allow changes to be committed without any modified files." + :type 'boolean + :group 'mercurial) + (defcustom hg-rev-completion-limit 100 "The maximum number of revisions that hg-read-rev will offer to complete. This affects memory usage and performance when prompting for revisions @@ -100,6 +119,12 @@ in a repository with a lot of history." :type 'integer :group 'mercurial) +(defcustom hg-update-modeline t + "Whether to update the modeline with the status of a file after every save. +Set this to nil on platforms with poor process management, such as Windows." + :type 'boolean + :group 'mercurial) + ;;; Other variables. @@ -115,6 +140,14 @@ in a repository with a lot of history." (make-variable-buffer-local 'hg-status) (put 'hg-status 'permanent-local t) +(defvar hg-prev-buffer nil) +(make-variable-buffer-local 'hg-prev-buffer) +(put 'hg-prev-buffer 'permanent-local t) + +(defvar hg-root nil) +(make-variable-buffer-local 'hg-root) +(put 'hg-root 'permanent-local t) + (defvar hg-output-buffer-name "*Hg*" "The name to use for Mercurial output buffers.") @@ -122,8 +155,20 @@ in a repository with a lot of history." (defvar hg-rev-history nil) +;;; Random constants. + +(defconst hg-commit-message-start + "--- Enter your commit message. Type `C-c C-c' to commit. ---\n") + +(defconst hg-commit-message-end + "--- Files in bold will be committed. Click to toggle selection. ---\n") + + ;;; hg-mode keymap. +(defvar hg-mode-map (make-sparse-keymap)) +(define-key hg-mode-map "\C-xv" 'hg-prefix-map) + (defvar hg-prefix-map (let ((map (copy-keymap vc-prefix-map))) (if (functionp 'set-keymap-name) @@ -135,14 +180,11 @@ in a repository with a lot of history." (define-key hg-prefix-map "c" 'hg-undo) (define-key hg-prefix-map "g" 'hg-annotate) (define-key hg-prefix-map "l" 'hg-log) -(define-key hg-prefix-map "n" 'hg-commit-file) +(define-key hg-prefix-map "n" 'hg-commit-start) ;; (define-key hg-prefix-map "r" 'hg-update) -(define-key hg-prefix-map "u" 'hg-revert-file) +(define-key hg-prefix-map "u" 'hg-revert-buffer) (define-key hg-prefix-map "~" 'hg-version-other-window) -(defvar hg-mode-map (make-sparse-keymap)) -(define-key hg-mode-map "\C-xv" 'hg-prefix-map) - (add-minor-mode 'hg-mode 'hg-mode hg-mode-map) @@ -156,17 +198,17 @@ in a repository with a lot of history." (define-key hg-global-map "," 'hg-incoming) (define-key hg-global-map "." 'hg-outgoing) (define-key hg-global-map "<" 'hg-pull) -(define-key hg-global-map "=" 'hg-diff) +(define-key hg-global-map "=" 'hg-diff-repo) (define-key hg-global-map ">" 'hg-push) (define-key hg-global-map "?" 'hg-help-overview) (define-key hg-global-map "A" 'hg-addremove) (define-key hg-global-map "U" 'hg-revert) (define-key hg-global-map "a" 'hg-add) -(define-key hg-global-map "c" 'hg-commit) +(define-key hg-global-map "c" 'hg-commit-start) (define-key hg-global-map "f" 'hg-forget) (define-key hg-global-map "h" 'hg-help-overview) (define-key hg-global-map "i" 'hg-init) -(define-key hg-global-map "l" 'hg-log) +(define-key hg-global-map "l" 'hg-log-repo) (define-key hg-global-map "r" 'hg-root) (define-key hg-global-map "s" 'hg-status) (define-key hg-global-map "u" 'hg-update) @@ -187,14 +229,28 @@ in a repository with a lot of history." 'hg-buffer-mouse-clicked) +;;; Commit mode keymaps. + +(defvar hg-commit-mode-map (make-sparse-keymap)) +(define-key hg-commit-mode-map "\C-c\C-c" 'hg-commit-finish) +(define-key hg-commit-mode-map "\C-c\C-k" 'hg-commit-kill) + +(defvar hg-commit-mode-file-map (make-sparse-keymap)) +(define-key hg-commit-mode-file-map + (if hg-running-xemacs [button2] [mouse-2]) + 'hg-commit-mouse-clicked) +(define-key hg-commit-mode-file-map " " 'hg-commit-toggle-file) +(define-key hg-commit-mode-file-map "\r" 'hg-commit-toggle-file) + + ;;; Convenience functions. -(defun hg-binary () +(defsubst hg-binary () (if hg-binary hg-binary (error "No `hg' executable found!"))) -(defun hg-replace-in-string (str regexp newtext &optional literal) +(defsubst hg-replace-in-string (str regexp newtext &optional literal) "Replace all matches in STR for REGEXP with NEWTEXT string. Return the new string. Optional LITERAL non-nil means do a literal replacement. @@ -205,7 +261,12 @@ XEmacs and GNU Emacs." (replace-in-string str regexp newtext literal) (replace-regexp-in-string regexp newtext str nil literal))) -(defun hg-chomp (str) +(defsubst hg-strip (str) + "Strip leading and trailing white space from a string." + (hg-replace-in-string (hg-replace-in-string str "[ \t\r\n]+$" "") + "^[ \t\r\n]+" "")) + +(defsubst hg-chomp (str) "Strip trailing newlines from a string." (hg-replace-in-string str "[\r\n]+$" "")) @@ -251,63 +312,91 @@ If the command does not exit with a zero (hg-diff hg-view-file-name rev rev prev-buf)) ((message "I don't know how to do that yet"))))) +(defsubst hg-event-point (event) + "Return the character position of the mouse event EVENT." + (if hg-running-xemacs + (event-point event) + (posn-point (event-start event)))) + +(defsubst hg-event-window (event) + "Return the window over which mouse event EVENT occurred." + (if hg-running-xemacs + (event-window event) + (posn-window (event-start event)))) + (defun hg-buffer-mouse-clicked (event) "Translate the mouse clicks in a HG log buffer to character events. These are then handed off to `hg-buffer-commands'. Handle frickin' frackin' gratuitous event-related incompatibilities." (interactive "e") - (if hg-running-xemacs - (progn - (select-window (event-window event)) - (hg-buffer-commands (event-point event))) - (select-window (posn-window (event-end event))) - (hg-buffer-commands (posn-point (event-start event))))) + (select-window (hg-event-window event)) + (hg-buffer-commands (hg-event-point event))) (unless (fboundp 'view-minor-mode) (defun view-minor-mode (prev-buffer exit-func) (view-mode))) -(defun hg-abbrev-file-name (file) +(defsubst hg-abbrev-file-name (file) + "Portable wrapper around abbreviate-file-name." (if hg-running-xemacs (abbreviate-file-name file t) (abbreviate-file-name file))) (defun hg-read-file-name (&optional prompt default) "Read a file or directory name, or a pattern, to use with a command." - (let ((path (or default (buffer-file-name)))) - (if (or (not path) current-prefix-arg) - (expand-file-name - (read-file-name (format "File, directory or pattern%s: " - (or prompt "")) - (and path (file-name-directory path)) - nil nil - (and path (file-name-nondirectory path)) - 'hg-file-history)) - path))) + (save-excursion + (while hg-prev-buffer + (set-buffer hg-prev-buffer)) + (let ((path (or default (buffer-file-name)))) + (if (or (not path) current-prefix-arg) + (expand-file-name + (read-file-name (format "File, directory or pattern%s: " + (or prompt "")) + (and path (file-name-directory path)) + nil nil + (and path (file-name-nondirectory path)) + 'hg-file-history)) + path)))) (defun hg-read-rev (&optional prompt default) "Read a revision or tag, offering completions." - (let ((rev (or default "tip"))) - (if (or (not rev) current-prefix-arg) - (let ((revs (split-string (hg-chomp - (hg-run0 "-q" "log" "-r" - (format "-%d" - hg-rev-completion-limit) - "-r" "tip")) - "[\n:]"))) - (dolist (line (split-string (hg-chomp (hg-run0 "tags")) "\n")) - (setq revs (cons (car (split-string line "\\s-")) revs))) - (completing-read (format "Revision%s (%s): " - (or prompt "") - (or default "tip")) - (map 'list 'cons revs revs) - nil - nil - nil - 'hg-rev-history - (or default "tip"))) - rev))) + (save-excursion + (while hg-prev-buffer + (set-buffer hg-prev-buffer)) + (let ((rev (or default "tip"))) + (if (or (not rev) current-prefix-arg) + (let ((revs (split-string (hg-chomp + (hg-run0 "-q" "log" "-r" + (format "-%d" + hg-rev-completion-limit) + "-r" "tip")) + "[\n:]"))) + (dolist (line (split-string (hg-chomp (hg-run0 "tags")) "\n")) + (setq revs (cons (car (split-string line "\\s-")) revs))) + (completing-read (format "Revision%s (%s): " + (or prompt "") + (or default "tip")) + (map 'list 'cons revs revs) + nil + nil + nil + 'hg-rev-history + (or default "tip"))) + rev)))) + +(defmacro hg-do-across-repo (path &rest body) + (let ((root-name (gensym "root-")) + (buf-name (gensym "buf-"))) + `(let ((,root-name (hg-root ,path))) + (save-excursion + (dolist (,buf-name (buffer-list)) + (set-buffer ,buf-name) + (when (and hg-status (equal (hg-root buffer-file-name) ,root-name)) + ,@body)))))) + +(put 'hg-do-across-repo 'lisp-indent-function 1) + ;;; View mode bits. @@ -341,7 +430,8 @@ current frame." (let ((state (assoc (substring output 0 (min (length output) 2)) '(("M " . modified) ("A " . added) - ("R " . removed))))) + ("R " . removed) + ("? " . nil))))) (if state (cdr state) 'normal))))) @@ -377,14 +467,59 @@ being viewed." (message "%s" msg))) (t (pop-to-buffer view-buf-name) + (setq hg-prev-buffer ,prev-buf) (hg-view-mode ,prev-buf ,@v-m-rest)))))) (put 'hg-view-output 'lisp-indent-function 1) +;;; Context save and restore across revert. + +(defun hg-position-context (pos) + "Return information to help find the given position again." + (let* ((end (min (point-max) (+ pos 98)))) + (list pos + (buffer-substring (max (point-min) (- pos 2)) end) + (- end pos)))) + +(defun hg-buffer-context () + "Return information to help restore a user's editing context. +This is useful across reverts and merges, where a context is likely +to have moved a little, but not really changed." + (let ((point-context (hg-position-context (point))) + (mark-context (let ((mark (mark-marker))) + (and mark (hg-position-context mark))))) + (list point-context mark-context))) + +(defun hg-find-context (ctx) + "Attempt to find a context in the given buffer. +Always returns a valid, hopefully sane, position." + (let ((pos (nth 0 ctx)) + (str (nth 1 ctx)) + (fixup (nth 2 ctx))) + (save-excursion + (goto-char (max (point-min) (- pos 15000))) + (if (and (not (equal str "")) + (search-forward str nil t)) + (- (point) fixup) + (max pos (point-min)))))) + +(defun hg-restore-context (ctx) + "Attempt to restore the user's editing context." + (let ((point-context (nth 0 ctx)) + (mark-context (nth 1 ctx))) + (goto-char (hg-find-context point-context)) + (when mark-context + (set-mark (hg-find-context mark-context))))) + + ;;; Hooks. -(defun hg-mode-line () - (when (hg-root) +(defun hg-mode-line (&optional force) + "Update the modeline with the current status of a file. +An update occurs if optional argument FORCE is non-nil, +hg-update-modeline is non-nil, or we have not yet checked the state of +the file." + (when (and (hg-root) (or force hg-update-modeline (not hg-mode))) (let ((status (hg-file-status buffer-file-name))) (setq hg-status status hg-mode (and status (concat " Hg:" @@ -396,41 +531,16 @@ being viewed." (modified . "m"))))))) status))) -(defun hg-find-file-hook () - (when (hg-mode-line) - (run-hooks 'hg-mode-hook))) - -(add-hook 'find-file-hooks 'hg-find-file-hook) - -(defun hg-after-save-hook () - (let ((old-status hg-status)) - (hg-mode-line) - (if (and (not old-status) hg-status) - (run-hooks 'hg-mode-hook)))) - -(add-hook 'after-save-hook 'hg-after-save-hook) - - -;;; User interface functions. +(defun hg-mode () + "Minor mode for Mercurial distributed SCM integration. -(defun hg-help-overview () - "This is an overview of the Mercurial SCM mode for Emacs. - -You can find the source code, license (GPL v2), and credits for this -code by typing `M-x find-library mercurial RET'. +The Mercurial mode user interface is based on that of VC mode, so if +you're already familiar with VC, the same keybindings and functions +will generally work. -The Mercurial mode user interface is based on that of the older VC -mode, so if you're already familiar with VC, the same keybindings and -functions will generally work. - -Below is a list of common SCM tasks, with the key bindings needed to -perform them, and the command names. This list is not exhaustive. - -In the list below, `G/L' indicates whether a key binding is global (G) -or local (L). Global keybindings work on any file inside a Mercurial -repository. Local keybindings only apply to files under the control -of Mercurial. Many commands take a prefix argument. - +Below is a list of many common SCM tasks. In the list, `G/L' +indicates whether a key binding is global (G) to a repository or local +(L) to a file. Many commands take a prefix argument. SCM Task G/L Key Binding Command Name -------- --- ----------- ------------ @@ -438,14 +548,14 @@ Help overview (what you are reading) G Tell Mercurial to manage a file G C-c h a hg-add Commit changes to current file only L C-x v n hg-commit -Undo changes to file since commit L C-x v u hg-revert-file +Undo changes to file since commit L C-x v u hg-revert-buffer Diff file vs last checkin L C-x v = hg-diff View file change history L C-x v l hg-log View annotated file L C-x v a hg-annotate -Diff repo vs last checkin G C-c h = hg-diff +Diff repo vs last checkin G C-c h = hg-diff-repo View status of files in repo G C-c h s hg-status Commit all changes G C-c h c hg-commit @@ -457,11 +567,41 @@ Pull changes G Update working directory after pull G C-c h u hg-update See changes that can be pushed G C-c h . hg-outgoing Push changes G C-c h > hg-push" + (run-hooks 'hg-mode-hook)) + +(defun hg-find-file-hook () + (when (hg-mode-line) + (hg-mode))) + +(add-hook 'find-file-hooks 'hg-find-file-hook) + +(defun hg-after-save-hook () + (let ((old-status hg-status)) + (hg-mode-line) + (if (and (not old-status) hg-status) + (hg-mode)))) + +(add-hook 'after-save-hook 'hg-after-save-hook) + + +;;; User interface functions. + +(defun hg-help-overview () + "This is an overview of the Mercurial SCM mode for Emacs. + +You can find the source code, license (GPL v2), and credits for this +code by typing `M-x find-library mercurial RET'." (interactive) (hg-view-output ("Mercurial Help Overview") - (insert (documentation 'hg-help-overview)))) + (insert (documentation 'hg-help-overview)) + (let ((pos (point))) + (insert (documentation 'hg-mode)) + (goto-char pos) + (kill-line)))) (defun hg-add (path) + "Add PATH to the Mercurial repository on the next commit. +With a prefix argument, prompt for the path to add." (interactive (list (hg-read-file-name " to add"))) (let ((buf (current-buffer)) (update (equal buffer-file-name path))) @@ -479,16 +619,179 @@ Push changes G (interactive) (error "not implemented")) -(defun hg-commit () +(defun hg-commit-toggle-file (pos) + "Toggle whether or not the file at POS will be committed." + (interactive "d") + (save-excursion + (goto-char pos) + (let ((face (get-text-property pos 'face)) + (inhibit-read-only t) + bol) + (beginning-of-line) + (setq bol (+ (point) 4)) + (end-of-line) + (if (eq face 'bold) + (progn + (remove-text-properties bol (point) '(face nil)) + (message "%s will not be committed" + (buffer-substring bol (point)))) + (add-text-properties bol (point) '(face bold)) + (message "%s will be committed" + (buffer-substring bol (point))))))) + +(defun hg-commit-mouse-clicked (event) + "Toggle whether or not the file at POS will be committed." + (interactive "@e") + (hg-commit-toggle-file (hg-event-point event))) + +(defun hg-commit-kill () + "Kill the commit currently being prepared." + (interactive) + (when (or (not (buffer-modified-p)) (y-or-n-p "Really kill this commit? ")) + (let ((buf hg-prev-buffer)) + (kill-buffer nil) + (switch-to-buffer buf)))) + +(defun hg-commit-finish () + "Finish preparing a commit, and perform the actual commit. +The hook hg-pre-commit-hook is run before anything else is done. If +the commit message is empty and hg-commit-allow-empty-message is nil, +an error is raised. If the list of files to commit is empty and +hg-commit-allow-empty-file-list is nil, an error is raised." (interactive) - (error "not implemented")) + (let ((root hg-root)) + (save-excursion + (run-hooks 'hg-pre-commit-hook) + (goto-char (point-min)) + (search-forward hg-commit-message-start) + (let (message files) + (let ((start (point))) + (goto-char (point-max)) + (search-backward hg-commit-message-end) + (setq message (hg-strip (buffer-substring start (point))))) + (when (and (= (length message) 0) + (not hg-commit-allow-empty-message)) + (error "Cannot proceed - commit message is empty")) + (forward-line 1) + (beginning-of-line) + (while (< (point) (point-max)) + (let ((pos (+ (point) 4))) + (end-of-line) + (when (eq (get-text-property pos 'face) 'bold) + (end-of-line) + (setq files (cons (buffer-substring pos (point)) files)))) + (forward-line 1)) + (when (and (= (length files) 0) + (not hg-commit-allow-empty-file-list)) + (error "Cannot proceed - no files to commit")) + (setq message (concat message "\n")) + (apply 'hg-run0 "--cwd" hg-root "commit" "-m" message files)) + (let ((buf hg-prev-buffer)) + (kill-buffer nil) + (switch-to-buffer buf)) + (hg-do-across-repo root + (hg-mode-line))))) + +(defun hg-commit-mode () + "Mode for describing a commit of changes to a Mercurial repository. +This involves two actions: describing the changes with a commit +message, and choosing the files to commit. + +To describe the commit, simply type some text in the designated area. + +By default, all modified, added and removed files are selected for +committing. Files that will be committed are displayed in bold face\; +those that will not are displayed in normal face. + +To toggle whether a file will be committed, move the cursor over a +particular file and hit space or return. Alternatively, middle click +on the file. + +Key bindings +------------ +\\[hg-commit-finish] proceed with commit +\\[hg-commit-kill] kill commit + +\\[hg-diff-repo] view diff of pending changes" + (interactive) + (use-local-map hg-commit-mode-map) + (set-syntax-table text-mode-syntax-table) + (setq local-abbrev-table text-mode-abbrev-table + major-mode 'hg-commit-mode + mode-name "Hg-Commit") + (set-buffer-modified-p nil) + (setq buffer-undo-list nil) + (run-hooks 'text-mode-hook 'hg-commit-mode-hook)) + +(defun hg-commit-start () + "Prepare a commit of changes to the repository containing the current file." + (interactive) + (while hg-prev-buffer + (set-buffer hg-prev-buffer)) + (let ((root (hg-root)) + (prev-buffer (current-buffer)) + modified-files) + (unless root + (error "Cannot commit outside a repository!")) + (hg-do-across-repo + (vc-buffer-sync)) + (setq modified-files (hg-chomp (hg-run0 "--cwd" root "status" "-arm"))) + (when (and (= (length modified-files) 0) + (not hg-commit-allow-empty-file-list)) + (error "No pending changes to commit")) + (let* ((buf-name (format "*Mercurial: Commit %s*" root))) + (pop-to-buffer (get-buffer-create buf-name)) + (when (= (point-min) (point-max)) + (set (make-local-variable 'hg-root) root) + (setq hg-prev-buffer prev-buffer) + (insert "\n") + (let ((bol (point))) + (insert hg-commit-message-end) + (add-text-properties bol (point) '(face bold-italic))) + (let ((file-area (point))) + (insert modified-files) + (goto-char file-area) + (while (< (point) (point-max)) + (let ((bol (point))) + (forward-char 1) + (insert " ") + (end-of-line) + (add-text-properties (+ bol 4) (point) + '(face bold mouse-face highlight))) + (forward-line 1)) + (goto-char file-area) + (add-text-properties (point) (point-max) + `(keymap ,hg-commit-mode-file-map)) + (goto-char (point-min)) + (insert hg-commit-message-start) + (add-text-properties (point-min) (point) '(face bold-italic)) + (insert "\n\n") + (forward-line -1) + (save-excursion + (goto-char (point-max)) + (search-backward hg-commit-message-end) + (add-text-properties (match-beginning 0) (point-max) + '(read-only t)) + (goto-char (point-min)) + (search-forward hg-commit-message-start) + (add-text-properties (match-beginning 0) (match-end 0) + '(read-only t))) + (hg-commit-mode)))))) (defun hg-diff (path &optional rev1 rev2) + "Show the differences between REV1 and REV2 of PATH. +When called interactively, the default behaviour is to treat REV1 as +the tip revision, REV2 as the current edited version of the file, and +PATH as the file edited in the current buffer. +With a prefix argument, prompt for all of these." (interactive (list (hg-read-file-name " to diff") (hg-read-rev " to start with") (let ((rev2 (hg-read-rev " to end with" 'working-dir))) (and (not (eq rev2 'working-dir)) rev2)))) - (let ((a-path (hg-abbrev-file-name path))) + (unless rev1 + (setq rev1 "-1")) + (let ((a-path (hg-abbrev-file-name path)) + diff) (hg-view-output ((if (equal rev1 rev2) (format "Mercurial: Rev %s of %s" rev1 a-path) (format "Mercurial: Rev %s to %s of %s" @@ -497,9 +800,20 @@ Push changes G (call-process (hg-binary) nil t nil "diff" "-r" rev1 "-r" rev2 path) (call-process (hg-binary) nil t nil "diff" "-r" rev1 path)) (diff-mode) - (font-lock-fontify-buffer)))) + (setq diff (not (= (point-min) (point-max)))) + (font-lock-fontify-buffer)) + diff)) + +(defun hg-diff-repo () + "Show the differences between the working copy and the tip revision." + (interactive) + (hg-diff (hg-root))) (defun hg-forget (path) + "Lose track of PATH, which has been added, but not yet committed. +This will prevent the file from being incorporated into the Mercurial +repository on the next commit. +With a prefix argument, prompt for the path to forget." (interactive (list (hg-read-file-name " to forget"))) (let ((buf (current-buffer)) (update (equal buffer-file-name path))) @@ -518,20 +832,34 @@ Push changes G (error "not implemented")) (defun hg-log (path &optional rev1 rev2) + "Display the revision history of PATH, between REV1 and REV2. +REV1 defaults to the initial revision, while REV2 defaults to the tip. +With a prefix argument, prompt for each parameter. +Variable hg-log-limit controls the number of log entries displayed." (interactive (list (hg-read-file-name " to log") (hg-read-rev " to start with" "-1") (hg-read-rev " to end with" (format "-%d" hg-log-limit)))) - (message "log %s %s" rev1 rev2) - (sit-for 1) (let ((a-path (hg-abbrev-file-name path))) (hg-view-output ((if (equal rev1 rev2) (format "Mercurial: Rev %s of %s" rev1 a-path) (format "Mercurial: Rev %s to %s of %s" rev1 (or rev2 "Current") a-path))) - (call-process (hg-binary) nil t nil "log" "-r" rev1 "-r" rev2 path) + (if (> (length path) (length (hg-root path))) + (call-process (hg-binary) nil t nil "log" "-r" rev1 "-r" rev2 path) + (call-process (hg-binary) nil t nil "log" "-r" rev1 "-r" rev2)) (diff-mode) (font-lock-fontify-buffer)))) +(defun hg-log-repo (path &optional rev1 rev2) + "Display the revision history of the repository containing PATH. +History is displayed between REV1, which defaults to the tip, and +REV2, which defaults to the initial revision. +Variable hg-log-limit controls the number of log entries displayed." + (interactive (list (hg-read-file-name " to log") + (hg-read-rev " to start with" "tip") + (hg-read-rev " to end with" (format "-%d" hg-log-limit)))) + (hg-log (hg-root path) rev1 rev2)) + (defun hg-outgoing () (interactive) (error "not implemented")) @@ -544,33 +872,71 @@ Push changes G (interactive) (error "not implemented")) -(defun hg-revert () - (interactive) - (error "not implemented")) +(defun hg-revert-buffer-internal () + (let ((ctx (hg-buffer-context))) + (message "Reverting %s..." buffer-file-name) + (hg-run0 "revert" buffer-file-name) + (revert-buffer t t t) + (hg-restore-context ctx) + (hg-mode-line) + (message "Reverting %s...done" buffer-file-name))) -(defun hg-revert-file () +(defun hg-revert-buffer () + "Revert current buffer's file back to the latest committed version. +If the file has not changed, nothing happens. Otherwise, this +displays a diff and asks for confirmation before reverting." (interactive) - (error "not implemented")) + (let ((vc-suppress-confirm nil) + (obuf (current-buffer)) + diff) + (vc-buffer-sync) + (unwind-protect + (setq diff (hg-diff buffer-file-name)) + (when diff + (unless (yes-or-no-p "Discard changes? ") + (error "Revert cancelled"))) + (when diff + (let ((buf (current-buffer))) + (delete-window (selected-window)) + (kill-buffer buf)))) + (set-buffer obuf) + (when diff + (hg-revert-buffer-internal)))) (defun hg-root (&optional path) + "Return the root of the repository that contains the given path. +If the path is outside a repository, return nil. +When called interactively, the root is printed. A prefix argument +prompts for a path to check." (interactive (list (hg-read-file-name))) - (let ((root (do ((prev nil dir) - (dir (file-name-directory (or path (buffer-file-name))) - (file-name-directory (directory-file-name dir)))) - ((equal prev dir)) - (when (file-directory-p (concat dir ".hg")) - (return dir))))) - (when (interactive-p) - (if root - (message "The root of this repository is `%s'." root) - (message "The path `%s' is not in a Mercurial repository." - (abbreviate-file-name path t)))) - root)) + (if (or path (not hg-root)) + (let ((root (do ((prev nil dir) + (dir (file-name-directory (or path buffer-file-name "")) + (file-name-directory (directory-file-name dir)))) + ((equal prev dir)) + (when (file-directory-p (concat dir ".hg")) + (return dir))))) + (when (interactive-p) + (if root + (message "The root of this repository is `%s'." root) + (message "The path `%s' is not in a Mercurial repository." + (abbreviate-file-name path t)))) + root) + hg-root)) (defun hg-status (path) + "Print revision control status of a file or directory. +With prefix argument, prompt for the path to give status for. +Names are displayed relative to the repository root." (interactive (list (hg-read-file-name " for status" (hg-root)))) (let ((root (hg-root))) - (hg-view-output (hg-output-buffer-name) + (hg-view-output ((format "Mercurial: Status of %s in %s" + (let ((name (substring (expand-file-name path) + (length root)))) + (if (> (length name) 0) + name + "*")) + (hg-abbrev-file-name root))) (apply 'call-process (hg-binary) nil t nil (list "--cwd" root "status" path))))) @@ -587,6 +953,5 @@ Push changes G ;;; Local Variables: -;;; mode: emacs-lisp ;;; prompt-to-byte-compile: nil ;;; end: diff --git a/contrib/patchbomb b/contrib/patchbomb --- a/contrib/patchbomb +++ b/contrib/patchbomb @@ -168,10 +168,11 @@ def patchbomb(ui, repo, *revs, **opts): len(patches), opts['subject'] or prompt('Subject:', rest = ' [PATCH 0 of %d] ' % len(patches))) - to = (opts['to'] or ui.config('patchbomb', 'to') or - [s.strip() for s in prompt('To').split(',')]) + to = opts['to'] or ui.config('patchbomb', 'to') or prompt('To') + to = [t.strip() for t in to.split(',')] cc = (opts['cc'] or ui.config('patchbomb', 'cc') or - [s.strip() for s in prompt('Cc', default = '').split(',')]) + prompt('Cc', default = '')) + cc = (cc and [c.strip() for c in cc.split(',')]) or [] ui.write('Finish with ^D or a dot on a line by itself.\n\n') diff --git a/mercurial/hg.py b/mercurial/hg.py --- a/mercurial/hg.py +++ b/mercurial/hg.py @@ -700,7 +700,7 @@ class localrepository: h = fl.heads() h.reverse() for r in h: - for l in fl.revision(r).splitlines(): + for l in fl.read(r).splitlines(): if l: n, k = l.split(" ", 1) addtag(self, k, n) @@ -824,6 +824,7 @@ class localrepository: m1 = self.manifest.read(c1[0]) mf1 = self.manifest.readflags(c1[0]) m2 = self.manifest.read(c2[0]) + changed = [] if orig_parent == p1: update_dirstate = 1 @@ -864,6 +865,7 @@ class localrepository: continue mm[f] = r.add(t, {}, tr, linkrev, fp1, fp2) + changed.append(f) if update_dirstate: self.dirstate.update([f], "n") except IOError: @@ -878,7 +880,7 @@ class localrepository: mnode = self.manifest.add(mm, mfm, tr, linkrev, c1[0], c2[0]) user = user or self.ui.username() - n = self.changelog.add(mnode, files, text, tr, p1, p2, user, date) + n = self.changelog.add(mnode, changed, text, tr, p1, p2, user, date) tr.close() if update_dirstate: self.dirstate.setparents(n, nullid) @@ -887,6 +889,8 @@ class localrepository: match = util.always, force=False): commit = [] remove = [] + changed = [] + if files: for f in files: s = self.dirstate.state(f) @@ -962,6 +966,9 @@ class localrepository: continue new[f] = r.add(t, meta, tr, linkrev, fp1, fp2) + # remember what we've added so that we can later calculate + # the files to pull from a set of changesets + changed.append(f) # update manifest m1.update(new) @@ -976,16 +983,21 @@ class localrepository: new.sort() if not text: - edittext = "\n" + "HG: manifest hash %s\n" % hex(mn) - edittext += "".join(["HG: changed %s\n" % f for f in new]) + edittext = "" + if p2 != nullid: + edittext += "HG: branch merge\n" + edittext += "\n" + "HG: manifest hash %s\n" % hex(mn) + edittext += "".join(["HG: changed %s\n" % f for f in changed]) edittext += "".join(["HG: removed %s\n" % f for f in remove]) + if not changed and not remove: + edittext += "HG: no files changed\n" edittext = self.ui.edit(edittext) if not edittext.rstrip(): return None text = edittext user = user or self.ui.username() - n = self.changelog.add(mn, new, text, tr, p1, p2, user, date) + n = self.changelog.add(mn, changed, text, tr, p1, p2, user, date) tr.close() self.dirstate.setparents(n) @@ -1010,7 +1022,7 @@ class localrepository: def fcmp(fn, mf): t1 = self.wfile(fn).read() - t2 = self.file(fn).revision(mf[fn]) + t2 = self.file(fn).read(mf.get(fn, nullid)) return cmp(t1, t2) def mfmatches(node): @@ -1647,7 +1659,7 @@ class localrepository: # is the wfile new since m1, and match m2? if f not in m1: t1 = self.wfile(f).read() - t2 = self.file(f).revision(m2[f]) + t2 = self.file(f).read(m2[f]) if cmp(t1, t2) == 0: n = m2[f] del t1, t2 @@ -1737,7 +1749,7 @@ class localrepository: if linear_path or force: # we don't need to do any magic, just jump to the new rev - mode = 'n' + branch_merge = False p1, p2 = p2, nullid else: if not allow: @@ -1753,7 +1765,7 @@ class localrepository: self.ui.status("(use update -m to merge across branches" + " or -C to lose changes)\n") return 1 - mode = 'm' + branch_merge = True if moddirstate: self.dirstate.setparents(p1, p2) @@ -1772,30 +1784,32 @@ class localrepository: self.wfile(f, "w").write(t) util.set_exec(self.wjoin(f), mf2[f]) if moddirstate: - self.dirstate.update([f], 'n') + if branch_merge: + self.dirstate.update([f], 'n', st_mtime=-1) + else: + self.dirstate.update([f], 'n') # merge the tricky bits files = merge.keys() files.sort() for f in files: self.ui.status("merging %s\n" % f) - m, o, flag = merge[f] - self.merge3(f, m, o) + my, other, flag = merge[f] + self.merge3(f, my, other) util.set_exec(self.wjoin(f), flag) if moddirstate: - if mode == 'm': - # only update dirstate on branch merge, otherwise we - # could mark files with changes as unchanged - self.dirstate.update([f], mode) - elif p2 == nullid: - # update dirstate from parent1's manifest - m1n = self.changelog.read(p1)[0] - m1 = self.manifest.read(m1n) - f_len = len(self.file(f).read(m1[f])) - self.dirstate.update([f], mode, st_size=f_len, st_mtime=0) + if branch_merge: + # We've done a branch merge, mark this file as merged + # so that we properly record the merger later + self.dirstate.update([f], 'm') else: - self.ui.warn("Second parent without branch merge!?\n" - "Dirstate for file %s may be wrong.\n" % f) + # We've update-merged a locally modified file, so + # we set the dirstate to emulate a normal checkout + # of that file some time in the past. Thus our + # merge will appear as a normal local file + # modification. + f_len = len(self.file(f).read(other)) + self.dirstate.update([f], 'n', st_size=f_len, st_mtime=-1) remove.sort() for f in remove: @@ -1808,10 +1822,10 @@ class localrepository: try: os.removedirs(os.path.dirname(self.wjoin(f))) except: pass if moddirstate: - if mode == 'n': + if branch_merge: + self.dirstate.update(remove, 'r') + else: self.dirstate.forget(remove) - else: - self.dirstate.update(remove, 'r') def merge3(self, fn, my, other): """perform a 3-way merge in the working directory""" @@ -1820,7 +1834,7 @@ class localrepository: pre = "%s~%s." % (os.path.basename(fn), prefix) (fd, name) = tempfile.mkstemp("", pre) f = os.fdopen(fd, "wb") - f.write(fl.revision(node)) + f.write(fl.read(node)) f.close() return name diff --git a/tests/test-filebranch b/tests/test-filebranch --- a/tests/test-filebranch +++ b/tests/test-filebranch @@ -41,7 +41,7 @@ hg debugstate | cut -b 1-16,35- echo merging hg pull ../a -env HGMERGE=../merge hg update -vm --debug +env HGMERGE=../merge hg update -vm echo 2m > foo echo 2b > baz @@ -55,6 +55,9 @@ hg ci -m "merge" -d "0 0" echo "main: we should have a merge here" hg debugindex .hg/00changelog.i +echo "log should show foo and quux changed" +hg log -v -r tip + echo "foo: we should have a merge here" hg debugindex .hg/data/foo.i @@ -67,6 +70,9 @@ hg debugindex .hg/data/baz.i echo "quux: we shouldn't have a merge here" hg debugindex .hg/data/quux.i +echo "manifest entries should match tips of all files" +hg manifest + echo "everything should be clean now" hg status diff --git a/tests/test-filebranch.out b/tests/test-filebranch.out --- a/tests/test-filebranch.out +++ b/tests/test-filebranch.out @@ -16,14 +16,9 @@ added 1 changesets with 2 changes to 2 f (run 'hg update' to get a working copy) merging for foo resolving manifests - force None allow 1 moddirstate True linear False - ancestor a0486579db29 local ef1b4dbe2193 remote 336d8406d617 - remote bar is newer, get - foo versions differ, resolve getting bar merging foo resolving foo -file foo: other 33d1fb69067a ancestor b8e02f643373 we shouldn't have anything but foo in merge state here m 644 3 foo main: we should have a merge here @@ -31,7 +26,19 @@ main: we should have a merge here 0 0 73 0 0 cdca01651b96 000000000000 000000000000 1 73 68 1 1 f6718a9cb7f3 cdca01651b96 000000000000 2 141 68 2 2 bdd988058d16 cdca01651b96 000000000000 - 3 209 66 3 3 9da9fbd62226 f6718a9cb7f3 bdd988058d16 + 3 209 66 3 3 d8a521142a3c f6718a9cb7f3 bdd988058d16 +log should show foo and quux changed +changeset: 3:d8a521142a3c02186ee6c7254738a7e6427ed4c8 +tag: tip +parent: 1:f6718a9cb7f31f1a92d27bd6544c71617d6d4e4f +parent: 2:bdd988058d16e2d7392958eace7b64817e44a54e +user: test +date: Thu Jan 1 00:00:00 1970 +0000 +files: foo quux +description: +merge + + foo: we should have a merge here rev offset length base linkrev nodeid p1 p2 0 0 3 0 0 b8e02f643373 000000000000 000000000000 @@ -50,6 +57,11 @@ quux: we shouldn't have a merge here rev offset length base linkrev nodeid p1 p2 0 0 3 0 0 b8e02f643373 000000000000 000000000000 1 3 5 1 3 6128c0f33108 b8e02f643373 000000000000 +manifest entries should match tips of all files +33d1fb69067a0139622a3fa3b7ba1cdb1367972e 644 bar +2ffeddde1b65b4827f6746174a145474129fa2ce 644 baz +aa27919ee4303cfd575e1fb932dd64d75aa08be4 644 foo +6128c0f33108e8cfbb4e0824d13ae48b466d7280 644 quux everything should be clean now checking changesets checking manifests diff --git a/tests/test-merge6.out b/tests/test-merge6.out --- a/tests/test-merge6.out +++ b/tests/test-merge6.out @@ -6,7 +6,7 @@ adding file changes added 1 changesets with 1 changes to 1 files (run 'hg update' to get a working copy) bar should remain deleted. -f405ac83a5611071d6b54dd5eb26943b1fdc4460 644 foo +f9b0e817f6a48de3564c6b2957687c5e7297c5a0 644 foo pulling from ../A2 searching for changes adding changesets diff --git a/tests/test-rawcommit1.out b/tests/test-rawcommit1.out --- a/tests/test-rawcommit1.out +++ b/tests/test-rawcommit1.out @@ -11,7 +11,7 @@ summary: 2 05f9e54f4c9b86b09099803d8b49a50edcb4eaab 644 a 76d5e637cbec1bcc04a5a3fa4bcc7d13f6847c00 644 c -changeset: 3:c8225a106186 +changeset: 3:142428fbbcc5 tag: tip user: test date: Thu Jan 1 00:00:00 1970 +0000 @@ -19,7 +19,7 @@ summary: 3 d6e3c4976c13feb1728cd3ac851abaf7256a5c23 644 a 76d5e637cbec1bcc04a5a3fa4bcc7d13f6847c00 644 c -changeset: 4:8dfeee82a94b +changeset: 4:4d450f9aa680 tag: tip user: test date: Thu Jan 1 00:00:00 1970 +0000 @@ -28,16 +28,16 @@ summary: 4 05f9e54f4c9b86b09099803d8b49a50edcb4eaab 644 a 54837d97f2932a8194e69745a280a2c11e61ff9c 644 b 3570202ceac2b52517df64ebd0a062cb0d8fe33a 644 c -changeset: 4:8dfeee82a94b +changeset: 4:4d450f9aa680 user: test date: Thu Jan 1 00:00:00 1970 +0000 summary: 4 d6e3c4976c13feb1728cd3ac851abaf7256a5c23 644 a 76d5e637cbec1bcc04a5a3fa4bcc7d13f6847c00 644 c -changeset: 6:c0e932ecae5e +changeset: 6:b4b8b9afa8cc tag: tip -parent: 4:8dfeee82a94b +parent: 4:4d450f9aa680 parent: 5:a7925a42d0df user: test date: Thu Jan 1 00:00:00 1970 +0000 @@ -45,7 +45,7 @@ summary: 6 d6e3c4976c13feb1728cd3ac851abaf7256a5c23 644 a 76d5e637cbec1bcc04a5a3fa4bcc7d13f6847c00 644 c -changeset: 7:3a157da4365d +changeset: 7:f84d0b1b024e tag: tip user: test date: Thu Jan 1 00:00:00 1970 +0000 diff --git a/tests/test-tags.out b/tests/test-tags.out --- a/tests/test-tags.out +++ b/tests/test-tags.out @@ -10,4 +10,5 @@ acb14030fe0a+ first acb14030fe0a21b60322c440ad2d20cf7685a376+ first M a c8edf04160c7 tip -c8edf04160c7+b9154636be93 tip +c8edf04160c7+b9154636be93+ tip +M .hgtags