1.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2+++ b/.emacs.d/lib/mercurial.el Wed Jun 05 23:31:48 2024 +0000
1.3@@ -0,0 +1,1293 @@
1.4+;;; mercurial.el --- Emacs support for the Mercurial distributed SCM
1.5+
1.6+;; Copyright (C) 2005, 2006 Bryan O'Sullivan
1.7+
1.8+;; Author: Bryan O'Sullivan <bos@serpentine.com>
1.9+
1.10+;; mercurial.el is free software; you can redistribute it and/or
1.11+;; modify it under the terms of the GNU General Public License version
1.12+;; 2 or any later version.
1.13+
1.14+;; mercurial.el is distributed in the hope that it will be useful, but
1.15+;; WITHOUT ANY WARRANTY; without even the implied warranty of
1.16+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
1.17+;; General Public License for more details.
1.18+
1.19+;; You should have received a copy of the GNU General Public License
1.20+;; along with mercurial.el, GNU Emacs, or XEmacs; see the file COPYING
1.21+;; (`C-h C-l'). If not, see <http://www.gnu.org/licenses/>.
1.22+
1.23+;;; Commentary:
1.24+
1.25+;; mercurial.el builds upon Emacs's VC mode to provide flexible
1.26+;; integration with the Mercurial distributed SCM tool.
1.27+
1.28+;; To get going as quickly as possible, load mercurial.el into Emacs and
1.29+;; type `C-c h h'; this runs hg-help-overview, which prints a helpful
1.30+;; usage overview.
1.31+
1.32+;; Much of the inspiration for mercurial.el comes from Rajesh
1.33+;; Vaidheeswarran's excellent p4.el, which does an admirably thorough
1.34+;; job for the commercial Perforce SCM product. In fact, substantial
1.35+;; chunks of code are adapted from p4.el.
1.36+
1.37+;; This code has been developed under XEmacs 21.5, and may not work as
1.38+;; well under GNU Emacs (albeit tested under 21.4). Patches to
1.39+;; enhance the portability of this code, fix bugs, and add features
1.40+;; are most welcome.
1.41+
1.42+;; As of version 22.3, GNU Emacs's VC mode has direct support for
1.43+;; Mercurial, so this package may not prove as useful there.
1.44+
1.45+;; Please send problem reports and suggestions to bos@serpentine.com.
1.46+
1.47+
1.48+;;; Code:
1.49+
1.50+(eval-when-compile (require 'cl))
1.51+(require 'diff-mode)
1.52+(require 'easymenu)
1.53+(require 'executable)
1.54+(require 'vc)
1.55+
1.56+(defmacro hg-feature-cond (&rest clauses)
1.57+ "Test CLAUSES for feature at compile time.
1.58+Each clause is (FEATURE BODY...)."
1.59+ (dolist (x clauses)
1.60+ (let ((feature (car x))
1.61+ (body (cdr x)))
1.62+ (when (or (eq feature t)
1.63+ (featurep feature))
1.64+ (return (cons 'progn body))))))
1.65+
1.66+
1.67+;;; XEmacs has view-less, while GNU Emacs has view. Joy.
1.68+
1.69+(hg-feature-cond
1.70+ (xemacs (require 'view-less))
1.71+ (t (require 'view)))
1.72+
1.73+
1.74+;;; Variables accessible through the custom system.
1.75+
1.76+(defgroup mercurial nil
1.77+ "Mercurial distributed SCM."
1.78+ :group 'tools)
1.79+
1.80+(defcustom hg-binary
1.81+ (or (executable-find "hg")
1.82+ (dolist (path '("~/bin/hg" "/usr/bin/hg" "/usr/local/bin/hg"))
1.83+ (when (file-executable-p path)
1.84+ (return path))))
1.85+ "The path to Mercurial's hg executable."
1.86+ :type '(file :must-match t)
1.87+ :group 'mercurial)
1.88+
1.89+(defcustom hg-mode-hook nil
1.90+ "Hook run when a buffer enters hg-mode."
1.91+ :type 'sexp
1.92+ :group 'mercurial)
1.93+
1.94+(defcustom hg-commit-mode-hook nil
1.95+ "Hook run when a buffer is created to prepare a commit."
1.96+ :type 'sexp
1.97+ :group 'mercurial)
1.98+
1.99+(defcustom hg-pre-commit-hook nil
1.100+ "Hook run before a commit is performed.
1.101+If you want to prevent the commit from proceeding, raise an error."
1.102+ :type 'sexp
1.103+ :group 'mercurial)
1.104+
1.105+(defcustom hg-log-mode-hook nil
1.106+ "Hook run after a buffer is filled with log information."
1.107+ :type 'sexp
1.108+ :group 'mercurial)
1.109+
1.110+(defcustom hg-global-prefix "\C-ch"
1.111+ "The global prefix for Mercurial keymap bindings."
1.112+ :type 'sexp
1.113+ :group 'mercurial)
1.114+
1.115+(defcustom hg-commit-allow-empty-message nil
1.116+ "Whether to allow changes to be committed with empty descriptions."
1.117+ :type 'boolean
1.118+ :group 'mercurial)
1.119+
1.120+(defcustom hg-commit-allow-empty-file-list nil
1.121+ "Whether to allow changes to be committed without any modified files."
1.122+ :type 'boolean
1.123+ :group 'mercurial)
1.124+
1.125+(defcustom hg-rev-completion-limit 100
1.126+ "The maximum number of revisions that hg-read-rev will offer to complete.
1.127+This affects memory usage and performance when prompting for revisions
1.128+in a repository with a lot of history."
1.129+ :type 'integer
1.130+ :group 'mercurial)
1.131+
1.132+(defcustom hg-log-limit 50
1.133+ "The maximum number of revisions that hg-log will display."
1.134+ :type 'integer
1.135+ :group 'mercurial)
1.136+
1.137+(defcustom hg-update-modeline t
1.138+ "Whether to update the modeline with the status of a file after every save.
1.139+Set this to nil on platforms with poor process management, such as Windows."
1.140+ :type 'boolean
1.141+ :group 'mercurial)
1.142+
1.143+(defcustom hg-incoming-repository "default"
1.144+ "The repository from which changes are pulled from by default.
1.145+This should be a symbolic repository name, since it is used for all
1.146+repository-related commands."
1.147+ :type 'string
1.148+ :group 'mercurial)
1.149+
1.150+(defcustom hg-outgoing-repository ""
1.151+ "The repository to which changes are pushed to by default.
1.152+This should be a symbolic repository name, since it is used for all
1.153+repository-related commands."
1.154+ :type 'string
1.155+ :group 'mercurial)
1.156+
1.157+
1.158+;;; Other variables.
1.159+
1.160+(defvar hg-mode nil
1.161+ "Is this file managed by Mercurial?")
1.162+(make-variable-buffer-local 'hg-mode)
1.163+(put 'hg-mode 'permanent-local t)
1.164+
1.165+(defvar hg-status nil)
1.166+(make-variable-buffer-local 'hg-status)
1.167+(put 'hg-status 'permanent-local t)
1.168+
1.169+(defvar hg-prev-buffer nil)
1.170+(make-variable-buffer-local 'hg-prev-buffer)
1.171+(put 'hg-prev-buffer 'permanent-local t)
1.172+
1.173+(defvar hg-root nil)
1.174+(make-variable-buffer-local 'hg-root)
1.175+(put 'hg-root 'permanent-local t)
1.176+
1.177+(defvar hg-view-mode nil)
1.178+(make-variable-buffer-local 'hg-view-mode)
1.179+(put 'hg-view-mode 'permanent-local t)
1.180+
1.181+(defvar hg-view-file-name nil)
1.182+(make-variable-buffer-local 'hg-view-file-name)
1.183+(put 'hg-view-file-name 'permanent-local t)
1.184+
1.185+(defvar hg-output-buffer-name "*Hg*"
1.186+ "The name to use for Mercurial output buffers.")
1.187+
1.188+(defvar hg-file-history nil)
1.189+(defvar hg-repo-history nil)
1.190+(defvar hg-rev-history nil)
1.191+(defvar hg-repo-completion-table nil) ; shut up warnings
1.192+
1.193+
1.194+;;; Random constants.
1.195+
1.196+(defconst hg-commit-message-start
1.197+ "--- Enter your commit message. Type `C-c C-c' to commit. ---\n")
1.198+
1.199+(defconst hg-commit-message-end
1.200+ "--- Files in bold will be committed. Click to toggle selection. ---\n")
1.201+
1.202+(defconst hg-state-alist
1.203+ '((?M . modified)
1.204+ (?A . added)
1.205+ (?R . removed)
1.206+ (?! . deleted)
1.207+ (?C . normal)
1.208+ (?I . ignored)
1.209+ (?? . nil)))
1.210+
1.211+;;; hg-mode keymap.
1.212+
1.213+(defvar hg-prefix-map
1.214+ (let ((map (make-sparse-keymap)))
1.215+ (hg-feature-cond (xemacs (set-keymap-name map 'hg-prefix-map))) ; XEmacs
1.216+ (set-keymap-parent map vc-prefix-map)
1.217+ (define-key map "=" 'hg-diff)
1.218+ (define-key map "c" 'hg-undo)
1.219+ (define-key map "g" 'hg-annotate)
1.220+ (define-key map "i" 'hg-add)
1.221+ (define-key map "l" 'hg-log)
1.222+ (define-key map "n" 'hg-commit-start)
1.223+ ;; (define-key map "r" 'hg-update)
1.224+ (define-key map "u" 'hg-revert-buffer)
1.225+ (define-key map "~" 'hg-version-other-window)
1.226+ map)
1.227+ "This keymap overrides some default vc-mode bindings.")
1.228+
1.229+(defvar hg-mode-map
1.230+ (let ((map (make-sparse-keymap)))
1.231+ (define-key map "\C-xv" hg-prefix-map)
1.232+ map))
1.233+
1.234+(add-minor-mode 'hg-mode 'hg-mode hg-mode-map)
1.235+
1.236+
1.237+;;; Global keymap.
1.238+
1.239+(defvar hg-global-map
1.240+ (let ((map (make-sparse-keymap)))
1.241+ (define-key map "," 'hg-incoming)
1.242+ (define-key map "." 'hg-outgoing)
1.243+ (define-key map "<" 'hg-pull)
1.244+ (define-key map "=" 'hg-diff-repo)
1.245+ (define-key map ">" 'hg-push)
1.246+ (define-key map "?" 'hg-help-overview)
1.247+ (define-key map "A" 'hg-addremove)
1.248+ (define-key map "U" 'hg-revert)
1.249+ (define-key map "a" 'hg-add)
1.250+ (define-key map "c" 'hg-commit-start)
1.251+ (define-key map "f" 'hg-forget)
1.252+ (define-key map "h" 'hg-help-overview)
1.253+ (define-key map "i" 'hg-init)
1.254+ (define-key map "l" 'hg-log-repo)
1.255+ (define-key map "r" 'hg-root)
1.256+ (define-key map "s" 'hg-status)
1.257+ (define-key map "u" 'hg-update)
1.258+ map))
1.259+
1.260+(global-set-key hg-global-prefix hg-global-map)
1.261+
1.262+;;; View mode keymap.
1.263+
1.264+(defvar hg-view-mode-map
1.265+ (let ((map (make-sparse-keymap)))
1.266+ (hg-feature-cond (xemacs (set-keymap-name map 'hg-view-mode-map))) ; XEmacs
1.267+ (define-key map (hg-feature-cond (xemacs [button2])
1.268+ (t [mouse-2]))
1.269+ 'hg-buffer-mouse-clicked)
1.270+ map))
1.271+
1.272+(add-minor-mode 'hg-view-mode "" hg-view-mode-map)
1.273+
1.274+
1.275+;;; Commit mode keymaps.
1.276+
1.277+(defvar hg-commit-mode-map
1.278+ (let ((map (make-sparse-keymap)))
1.279+ (define-key map "\C-c\C-c" 'hg-commit-finish)
1.280+ (define-key map "\C-c\C-k" 'hg-commit-kill)
1.281+ (define-key map "\C-xv=" 'hg-diff-repo)
1.282+ map))
1.283+
1.284+(defvar hg-commit-mode-file-map
1.285+ (let ((map (make-sparse-keymap)))
1.286+ (define-key map (hg-feature-cond (xemacs [button2])
1.287+ (t [mouse-2]))
1.288+ 'hg-commit-mouse-clicked)
1.289+ (define-key map " " 'hg-commit-toggle-file)
1.290+ (define-key map "\r" 'hg-commit-toggle-file)
1.291+ map))
1.292+
1.293+
1.294+;;; Convenience functions.
1.295+
1.296+(defsubst hg-binary ()
1.297+ (if hg-binary
1.298+ hg-binary
1.299+ (error "No `hg' executable found!")))
1.300+
1.301+(defsubst hg-replace-in-string (str regexp newtext &optional literal)
1.302+ "Replace all matches in STR for REGEXP with NEWTEXT string.
1.303+Return the new string. Optional LITERAL non-nil means do a literal
1.304+replacement.
1.305+
1.306+This function bridges yet another pointless impedance gap between
1.307+XEmacs and GNU Emacs."
1.308+ (hg-feature-cond
1.309+ (xemacs (replace-in-string str regexp newtext literal))
1.310+ (t (replace-regexp-in-string regexp newtext str nil literal))))
1.311+
1.312+(defsubst hg-strip (str)
1.313+ "Strip leading and trailing blank lines from a string."
1.314+ (hg-replace-in-string (hg-replace-in-string str "[\r\n][ \t\r\n]*\\'" "")
1.315+ "\\`[ \t\r\n]*[\r\n]" ""))
1.316+
1.317+(defsubst hg-chomp (str)
1.318+ "Strip trailing newlines from a string."
1.319+ (hg-replace-in-string str "[\r\n]+\\'" ""))
1.320+
1.321+(defun hg-run-command (command &rest args)
1.322+ "Run the shell command COMMAND, returning (EXIT-CODE . COMMAND-OUTPUT).
1.323+The list ARGS contains a list of arguments to pass to the command."
1.324+ (let* (exit-code
1.325+ (output
1.326+ (with-output-to-string
1.327+ (with-current-buffer
1.328+ standard-output
1.329+ (setq exit-code
1.330+ (apply 'call-process command nil t nil args))))))
1.331+ (cons exit-code output)))
1.332+
1.333+(defun hg-run (command &rest args)
1.334+ "Run the Mercurial command COMMAND, returning (EXIT-CODE . COMMAND-OUTPUT)."
1.335+ (apply 'hg-run-command (hg-binary) command args))
1.336+
1.337+(defun hg-run0 (command &rest args)
1.338+ "Run the Mercurial command COMMAND, returning its output.
1.339+If the command does not exit with a zero status code, raise an error."
1.340+ (let ((res (apply 'hg-run-command (hg-binary) command args)))
1.341+ (if (not (eq (car res) 0))
1.342+ (error "Mercurial command failed %s - exit code %s"
1.343+ (cons command args)
1.344+ (car res))
1.345+ (cdr res))))
1.346+
1.347+(defmacro hg-do-across-repo (path &rest body)
1.348+ (let ((root-name (make-symbol "root-"))
1.349+ (buf-name (make-symbol "buf-")))
1.350+ `(let ((,root-name (hg-root ,path)))
1.351+ (save-excursion
1.352+ (dolist (,buf-name (buffer-list))
1.353+ (set-buffer ,buf-name)
1.354+ (when (and hg-status (equal (hg-root buffer-file-name) ,root-name))
1.355+ ,@body))))))
1.356+
1.357+(put 'hg-do-across-repo 'lisp-indent-function 1)
1.358+
1.359+(defun hg-sync-buffers (path)
1.360+ "Sync buffers visiting PATH with their on-disk copies.
1.361+If PATH is not being visited, but is under the repository root, sync
1.362+all buffers visiting files in the repository."
1.363+ (let ((buf (find-buffer-visiting path)))
1.364+ (if buf
1.365+ (with-current-buffer buf
1.366+ (vc-buffer-sync))
1.367+ (hg-do-across-repo path
1.368+ (vc-buffer-sync)))))
1.369+
1.370+(defun hg-buffer-commands (pnt)
1.371+ "Use the properties of a character to do something sensible."
1.372+ (interactive "d")
1.373+ (let ((rev (get-char-property pnt 'rev))
1.374+ (file (get-char-property pnt 'file)))
1.375+ (cond
1.376+ (file
1.377+ (find-file-other-window file))
1.378+ (rev
1.379+ (hg-diff hg-view-file-name rev rev))
1.380+ ((message "I don't know how to do that yet")))))
1.381+
1.382+(defsubst hg-event-point (event)
1.383+ "Return the character position of the mouse event EVENT."
1.384+ (hg-feature-cond (xemacs (event-point event))
1.385+ (t (posn-point (event-start event)))))
1.386+
1.387+(defsubst hg-event-window (event)
1.388+ "Return the window over which mouse event EVENT occurred."
1.389+ (hg-feature-cond (xemacs (event-window event))
1.390+ (t (posn-window (event-start event)))))
1.391+
1.392+(defun hg-buffer-mouse-clicked (event)
1.393+ "Translate the mouse clicks in a HG log buffer to character events.
1.394+These are then handed off to `hg-buffer-commands'.
1.395+
1.396+Handle frickin' frackin' gratuitous event-related incompatibilities."
1.397+ (interactive "e")
1.398+ (select-window (hg-event-window event))
1.399+ (hg-buffer-commands (hg-event-point event)))
1.400+
1.401+(defsubst hg-abbrev-file-name (file)
1.402+ "Portable wrapper around abbreviate-file-name."
1.403+ (hg-feature-cond (xemacs (abbreviate-file-name file t))
1.404+ (t (abbreviate-file-name file))))
1.405+
1.406+(defun hg-read-file-name (&optional prompt default)
1.407+ "Read a file or directory name, or a pattern, to use with a command."
1.408+ (save-excursion
1.409+ (while hg-prev-buffer
1.410+ (set-buffer hg-prev-buffer))
1.411+ (let ((path (or default
1.412+ (buffer-file-name)
1.413+ (expand-file-name default-directory))))
1.414+ (if (or (not path) current-prefix-arg)
1.415+ (expand-file-name
1.416+ (eval (list* 'read-file-name
1.417+ (format "File, directory or pattern%s: "
1.418+ (or prompt ""))
1.419+ (and path (file-name-directory path))
1.420+ nil nil
1.421+ (and path (file-name-nondirectory path))
1.422+ (hg-feature-cond
1.423+ (xemacs (cons (quote 'hg-file-history) nil))
1.424+ (t nil)))))
1.425+ path))))
1.426+
1.427+(defun hg-read-number (&optional prompt default)
1.428+ "Read a integer value."
1.429+ (save-excursion
1.430+ (if (or (not default) current-prefix-arg)
1.431+ (string-to-number
1.432+ (eval (list* 'read-string
1.433+ (or prompt "")
1.434+ (if default (cons (format "%d" default) nil) nil))))
1.435+ default)))
1.436+
1.437+(defun hg-read-config ()
1.438+ "Return an alist of (key . value) pairs of Mercurial config data.
1.439+Each key is of the form (section . name)."
1.440+ (let (items)
1.441+ (dolist (line (split-string (hg-chomp (hg-run0 "debugconfig")) "\n") items)
1.442+ (string-match "^\\([^=]*\\)=\\(.*\\)" line)
1.443+ (let* ((left (substring line (match-beginning 1) (match-end 1)))
1.444+ (right (substring line (match-beginning 2) (match-end 2)))
1.445+ (key (split-string left "\\."))
1.446+ (value (hg-replace-in-string right "\\\\n" "\n" t)))
1.447+ (setq items (cons (cons (cons (car key) (cadr key)) value) items))))))
1.448+
1.449+(defun hg-config-section (section config)
1.450+ "Return an alist of (name . value) pairs for SECTION of CONFIG."
1.451+ (let (items)
1.452+ (dolist (item config items)
1.453+ (when (equal (caar item) section)
1.454+ (setq items (cons (cons (cdar item) (cdr item)) items))))))
1.455+
1.456+(defun hg-string-starts-with (sub str)
1.457+ "Indicate whether string STR starts with the substring or character SUB."
1.458+ (if (not (stringp sub))
1.459+ (and (> (length str) 0) (equal (elt str 0) sub))
1.460+ (let ((sub-len (length sub)))
1.461+ (and (<= sub-len (length str))
1.462+ (string= sub (substring str 0 sub-len))))))
1.463+
1.464+(defun hg-complete-repo (string predicate all)
1.465+ "Attempt to complete a repository name.
1.466+We complete on either symbolic names from Mercurial's config or real
1.467+directory names from the file system. We do not penalize URLs."
1.468+ (or (if all
1.469+ (all-completions string hg-repo-completion-table predicate)
1.470+ (try-completion string hg-repo-completion-table predicate))
1.471+ (let* ((str (expand-file-name string))
1.472+ (dir (file-name-directory str))
1.473+ (file (file-name-nondirectory str)))
1.474+ (if all
1.475+ (let (completions)
1.476+ (dolist (name (delete "./" (file-name-all-completions file dir))
1.477+ completions)
1.478+ (let ((path (concat dir name)))
1.479+ (when (file-directory-p path)
1.480+ (setq completions (cons name completions))))))
1.481+ (let ((comp (file-name-completion file dir)))
1.482+ (if comp
1.483+ (hg-abbrev-file-name (concat dir comp))))))))
1.484+
1.485+(defun hg-read-repo-name (&optional prompt initial-contents default)
1.486+ "Read the location of a repository."
1.487+ (save-excursion
1.488+ (while hg-prev-buffer
1.489+ (set-buffer hg-prev-buffer))
1.490+ (let (hg-repo-completion-table)
1.491+ (if current-prefix-arg
1.492+ (progn
1.493+ (dolist (path (hg-config-section "paths" (hg-read-config)))
1.494+ (setq hg-repo-completion-table
1.495+ (cons (cons (car path) t) hg-repo-completion-table))
1.496+ (unless (hg-string-starts-with (hg-feature-cond
1.497+ (xemacs directory-sep-char)
1.498+ (t ?/))
1.499+ (cdr path))
1.500+ (setq hg-repo-completion-table
1.501+ (cons (cons (cdr path) t) hg-repo-completion-table))))
1.502+ (completing-read (format "Repository%s: " (or prompt ""))
1.503+ 'hg-complete-repo
1.504+ nil
1.505+ nil
1.506+ initial-contents
1.507+ 'hg-repo-history
1.508+ default))
1.509+ default))))
1.510+
1.511+(defun hg-read-rev (&optional prompt default)
1.512+ "Read a revision or tag, offering completions."
1.513+ (save-excursion
1.514+ (while hg-prev-buffer
1.515+ (set-buffer hg-prev-buffer))
1.516+ (let ((rev (or default "tip")))
1.517+ (if current-prefix-arg
1.518+ (let ((revs (split-string
1.519+ (hg-chomp
1.520+ (hg-run0 "-q" "log" "-l"
1.521+ (format "%d" hg-rev-completion-limit)))
1.522+ "[\n:]")))
1.523+ (dolist (line (split-string (hg-chomp (hg-run0 "tags")) "\n"))
1.524+ (setq revs (cons (car (split-string line "\\s-")) revs)))
1.525+ (completing-read (format "Revision%s (%s): "
1.526+ (or prompt "")
1.527+ (or default "tip"))
1.528+ (mapcar (lambda (x) (cons x x)) revs)
1.529+ nil
1.530+ nil
1.531+ nil
1.532+ 'hg-rev-history
1.533+ (or default "tip")))
1.534+ rev))))
1.535+
1.536+(defun hg-parents-for-mode-line (root)
1.537+ "Format the parents of the working directory for the mode line."
1.538+ (let ((parents (split-string (hg-chomp
1.539+ (hg-run0 "--cwd" root "parents" "--template"
1.540+ "{rev}\n")) "\n")))
1.541+ (mapconcat 'identity parents "+")))
1.542+
1.543+(defun hg-buffers-visiting-repo (&optional path)
1.544+ "Return a list of buffers visiting the repository containing PATH."
1.545+ (let ((root-name (hg-root (or path (buffer-file-name))))
1.546+ bufs)
1.547+ (save-excursion
1.548+ (dolist (buf (buffer-list) bufs)
1.549+ (set-buffer buf)
1.550+ (let ((name (buffer-file-name)))
1.551+ (when (and hg-status name (equal (hg-root name) root-name))
1.552+ (setq bufs (cons buf bufs))))))))
1.553+
1.554+(defun hg-update-mode-lines (path)
1.555+ "Update the mode lines of all buffers visiting the same repository as PATH."
1.556+ (let* ((root (hg-root path))
1.557+ (parents (hg-parents-for-mode-line root)))
1.558+ (save-excursion
1.559+ (dolist (info (hg-path-status
1.560+ root
1.561+ (mapcar
1.562+ (function
1.563+ (lambda (buf)
1.564+ (substring (buffer-file-name buf) (length root))))
1.565+ (hg-buffers-visiting-repo root))))
1.566+ (let* ((name (car info))
1.567+ (status (cdr info))
1.568+ (buf (find-buffer-visiting (concat root name))))
1.569+ (when buf
1.570+ (set-buffer buf)
1.571+ (hg-mode-line-internal status parents)))))))
1.572+
1.573+
1.574+;;; View mode bits.
1.575+
1.576+(defun hg-exit-view-mode (buf)
1.577+ "Exit from hg-view-mode.
1.578+We delete the current window if entering hg-view-mode split the
1.579+current frame."
1.580+ (when (and (eq buf (current-buffer))
1.581+ (> (length (window-list)) 1))
1.582+ (delete-window))
1.583+ (when (buffer-live-p buf)
1.584+ (kill-buffer buf)))
1.585+
1.586+(defun hg-view-mode (prev-buffer &optional file-name)
1.587+ (goto-char (point-min))
1.588+ (set-buffer-modified-p nil)
1.589+ (toggle-read-only t)
1.590+ (hg-feature-cond (xemacs (view-minor-mode prev-buffer 'hg-exit-view-mode))
1.591+ (t (view-mode-enter nil 'hg-exit-view-mode)))
1.592+ (setq hg-view-mode t)
1.593+ (setq truncate-lines t)
1.594+ (when file-name
1.595+ (setq hg-view-file-name
1.596+ (hg-abbrev-file-name file-name))))
1.597+
1.598+(defun hg-file-status (file)
1.599+ "Return status of FILE, or nil if FILE does not exist or is unmanaged."
1.600+ (let* ((s (hg-run "status" file))
1.601+ (exit (car s))
1.602+ (output (cdr s)))
1.603+ (if (= exit 0)
1.604+ (let ((state (and (>= (length output) 2)
1.605+ (= (aref output 1) ? )
1.606+ (assq (aref output 0) hg-state-alist))))
1.607+ (if state
1.608+ (cdr state)
1.609+ 'normal)))))
1.610+
1.611+(defun hg-path-status (root paths)
1.612+ "Return status of PATHS in repo ROOT as an alist.
1.613+Each entry is a pair (FILE-NAME . STATUS)."
1.614+ (let ((s (apply 'hg-run "--cwd" root "status" "-marduc" paths))
1.615+ result)
1.616+ (dolist (entry (split-string (hg-chomp (cdr s)) "\n") (nreverse result))
1.617+ (let (state name)
1.618+ (cond ((= (aref entry 1) ? )
1.619+ (setq state (assq (aref entry 0) hg-state-alist)
1.620+ name (substring entry 2)))
1.621+ ((string-match "\\(.*\\): " entry)
1.622+ (setq name (match-string 1 entry))))
1.623+ (setq result (cons (cons name state) result))))))
1.624+
1.625+(defmacro hg-view-output (args &rest body)
1.626+ "Execute BODY in a clean buffer, then quickly display that buffer.
1.627+If the buffer contains one line, its contents are displayed in the
1.628+minibuffer. Otherwise, the buffer is displayed in view-mode.
1.629+ARGS is of the form (BUFFER-NAME &optional FILE), where BUFFER-NAME is
1.630+the name of the buffer to create, and FILE is the name of the file
1.631+being viewed."
1.632+ (let ((prev-buf (make-symbol "prev-buf-"))
1.633+ (v-b-name (car args))
1.634+ (v-m-rest (cdr args)))
1.635+ `(let ((view-buf-name ,v-b-name)
1.636+ (,prev-buf (current-buffer)))
1.637+ (get-buffer-create view-buf-name)
1.638+ (kill-buffer view-buf-name)
1.639+ (get-buffer-create view-buf-name)
1.640+ (set-buffer view-buf-name)
1.641+ (save-excursion
1.642+ ,@body)
1.643+ (case (count-lines (point-min) (point-max))
1.644+ ((0)
1.645+ (kill-buffer view-buf-name)
1.646+ (message "(No output)"))
1.647+ ((1)
1.648+ (let ((msg (hg-chomp (buffer-substring (point-min) (point-max)))))
1.649+ (kill-buffer view-buf-name)
1.650+ (message "%s" msg)))
1.651+ (t
1.652+ (pop-to-buffer view-buf-name)
1.653+ (setq hg-prev-buffer ,prev-buf)
1.654+ (hg-view-mode ,prev-buf ,@v-m-rest))))))
1.655+
1.656+(put 'hg-view-output 'lisp-indent-function 1)
1.657+
1.658+;;; Context save and restore across revert and other operations.
1.659+
1.660+(defun hg-position-context (pos)
1.661+ "Return information to help find the given position again."
1.662+ (let* ((end (min (point-max) (+ pos 98))))
1.663+ (list pos
1.664+ (buffer-substring (max (point-min) (- pos 2)) end)
1.665+ (- end pos))))
1.666+
1.667+(defun hg-buffer-context ()
1.668+ "Return information to help restore a user's editing context.
1.669+This is useful across reverts and merges, where a context is likely
1.670+to have moved a little, but not really changed."
1.671+ (let ((point-context (hg-position-context (point)))
1.672+ (mark-context (let ((mark (mark-marker)))
1.673+ (and mark
1.674+ ;; make sure active mark
1.675+ (marker-buffer mark)
1.676+ (marker-position mark)
1.677+ (hg-position-context mark)))))
1.678+ (list point-context mark-context)))
1.679+
1.680+(defun hg-find-context (ctx)
1.681+ "Attempt to find a context in the given buffer.
1.682+Always returns a valid, hopefully sane, position."
1.683+ (let ((pos (nth 0 ctx))
1.684+ (str (nth 1 ctx))
1.685+ (fixup (nth 2 ctx)))
1.686+ (save-excursion
1.687+ (goto-char (max (point-min) (- pos 15000)))
1.688+ (if (and (not (equal str ""))
1.689+ (search-forward str nil t))
1.690+ (- (point) fixup)
1.691+ (max pos (point-min))))))
1.692+
1.693+(defun hg-restore-context (ctx)
1.694+ "Attempt to restore the user's editing context."
1.695+ (let ((point-context (nth 0 ctx))
1.696+ (mark-context (nth 1 ctx)))
1.697+ (goto-char (hg-find-context point-context))
1.698+ (when mark-context
1.699+ (set-mark (hg-find-context mark-context)))))
1.700+
1.701+
1.702+;;; Hooks.
1.703+
1.704+(defun hg-mode-line-internal (status parents)
1.705+ (setq hg-status status
1.706+ hg-mode (and status (concat " Hg:"
1.707+ parents
1.708+ (cdr (assq status
1.709+ '((normal . "")
1.710+ (removed . "r")
1.711+ (added . "a")
1.712+ (deleted . "!")
1.713+ (modified . "m"))))))))
1.714+
1.715+(defun hg-mode-line (&optional force)
1.716+ "Update the modeline with the current status of a file.
1.717+An update occurs if optional argument FORCE is non-nil,
1.718+hg-update-modeline is non-nil, or we have not yet checked the state of
1.719+the file."
1.720+ (let ((root (hg-root)))
1.721+ (when (and root (or force hg-update-modeline (not hg-mode)))
1.722+ (let ((status (hg-file-status buffer-file-name))
1.723+ (parents (hg-parents-for-mode-line root)))
1.724+ (hg-mode-line-internal status parents)
1.725+ status))))
1.726+
1.727+(defun hg-mode (&optional toggle)
1.728+ "Minor mode for Mercurial distributed SCM integration.
1.729+
1.730+The Mercurial mode user interface is based on that of VC mode, so if
1.731+you're already familiar with VC, the same keybindings and functions
1.732+will generally work.
1.733+
1.734+Below is a list of many common SCM tasks. In the list, `G/L\'
1.735+indicates whether a key binding is global (G) to a repository or
1.736+local (L) to a file. Many commands take a prefix argument.
1.737+
1.738+SCM Task G/L Key Binding Command Name
1.739+-------- --- ----------- ------------
1.740+Help overview (what you are reading) G C-c h h hg-help-overview
1.741+
1.742+Tell Mercurial to manage a file G C-c h a hg-add
1.743+Commit changes to current file only L C-x v n hg-commit-start
1.744+Undo changes to file since commit L C-x v u hg-revert-buffer
1.745+
1.746+Diff file vs last checkin L C-x v = hg-diff
1.747+
1.748+View file change history L C-x v l hg-log
1.749+View annotated file L C-x v a hg-annotate
1.750+
1.751+Diff repo vs last checkin G C-c h = hg-diff-repo
1.752+View status of files in repo G C-c h s hg-status
1.753+Commit all changes G C-c h c hg-commit-start
1.754+
1.755+Undo all changes since last commit G C-c h U hg-revert
1.756+View repo change history G C-c h l hg-log-repo
1.757+
1.758+See changes that can be pulled G C-c h , hg-incoming
1.759+Pull changes G C-c h < hg-pull
1.760+Update working directory after pull G C-c h u hg-update
1.761+See changes that can be pushed G C-c h . hg-outgoing
1.762+Push changes G C-c h > hg-push"
1.763+ (unless vc-make-backup-files
1.764+ (set (make-local-variable 'backup-inhibited) t))
1.765+ (run-hooks 'hg-mode-hook))
1.766+
1.767+(defun hg-find-file-hook ()
1.768+ (ignore-errors
1.769+ (when (hg-mode-line)
1.770+ (hg-mode))))
1.771+
1.772+(add-hook 'find-file-hooks 'hg-find-file-hook)
1.773+
1.774+(defun hg-after-save-hook ()
1.775+ (ignore-errors
1.776+ (let ((old-status hg-status))
1.777+ (hg-mode-line)
1.778+ (if (and (not old-status) hg-status)
1.779+ (hg-mode)))))
1.780+
1.781+(add-hook 'after-save-hook 'hg-after-save-hook)
1.782+
1.783+
1.784+;;; User interface functions.
1.785+
1.786+(defun hg-help-overview ()
1.787+ "This is an overview of the Mercurial SCM mode for Emacs.
1.788+
1.789+You can find the source code, license (GPLv2+), and credits for this
1.790+code by typing `M-x find-library mercurial RET'."
1.791+ (interactive)
1.792+ (hg-view-output ("Mercurial Help Overview")
1.793+ (insert (documentation 'hg-help-overview))
1.794+ (let ((pos (point)))
1.795+ (insert (documentation 'hg-mode))
1.796+ (goto-char pos)
1.797+ (end-of-line 1)
1.798+ (delete-region pos (point)))
1.799+ (let ((hg-root-dir (hg-root)))
1.800+ (if (not hg-root-dir)
1.801+ (error "error: %s: directory is not part of a Mercurial repository."
1.802+ default-directory)
1.803+ (cd hg-root-dir)))))
1.804+
1.805+(defun hg-fix-paths ()
1.806+ "Fix paths reported by some Mercurial commands."
1.807+ (save-excursion
1.808+ (goto-char (point-min))
1.809+ (while (re-search-forward " \\.\\.." nil t)
1.810+ (replace-match " " nil nil))))
1.811+
1.812+(defun hg-add (path)
1.813+ "Add PATH to the Mercurial repository on the next commit.
1.814+With a prefix argument, prompt for the path to add."
1.815+ (interactive (list (hg-read-file-name " to add")))
1.816+ (let ((buf (current-buffer))
1.817+ (update (equal buffer-file-name path)))
1.818+ (hg-view-output (hg-output-buffer-name)
1.819+ (apply 'call-process (hg-binary) nil t nil (list "add" path))
1.820+ (hg-fix-paths)
1.821+ (goto-char (point-min))
1.822+ (cd (hg-root path)))
1.823+ (when update
1.824+ (unless vc-make-backup-files
1.825+ (set (make-local-variable 'backup-inhibited) t))
1.826+ (with-current-buffer buf
1.827+ (hg-mode-line)))))
1.828+
1.829+(defun hg-addremove ()
1.830+ (interactive)
1.831+ (error "not implemented"))
1.832+
1.833+(defun hg-annotate ()
1.834+ (interactive)
1.835+ (error "not implemented"))
1.836+
1.837+(defun hg-commit-toggle-file (pos)
1.838+ "Toggle whether or not the file at POS will be committed."
1.839+ (interactive "d")
1.840+ (save-excursion
1.841+ (goto-char pos)
1.842+ (let (face
1.843+ (inhibit-read-only t)
1.844+ bol)
1.845+ (beginning-of-line)
1.846+ (setq bol (+ (point) 4))
1.847+ (setq face (get-text-property bol 'face))
1.848+ (end-of-line)
1.849+ (if (eq face 'bold)
1.850+ (progn
1.851+ (remove-text-properties bol (point) '(face nil))
1.852+ (message "%s will not be committed"
1.853+ (buffer-substring bol (point))))
1.854+ (add-text-properties bol (point) '(face bold))
1.855+ (message "%s will be committed"
1.856+ (buffer-substring bol (point)))))))
1.857+
1.858+(defun hg-commit-mouse-clicked (event)
1.859+ "Toggle whether or not the file at POS will be committed."
1.860+ (interactive "@e")
1.861+ (hg-commit-toggle-file (hg-event-point event)))
1.862+
1.863+(defun hg-commit-kill ()
1.864+ "Kill the commit currently being prepared."
1.865+ (interactive)
1.866+ (when (or (not (buffer-modified-p)) (y-or-n-p "Really kill this commit? "))
1.867+ (let ((buf hg-prev-buffer))
1.868+ (kill-buffer nil)
1.869+ (switch-to-buffer buf))))
1.870+
1.871+(defun hg-commit-finish ()
1.872+ "Finish preparing a commit, and perform the actual commit.
1.873+The hook hg-pre-commit-hook is run before anything else is done. If
1.874+the commit message is empty and hg-commit-allow-empty-message is nil,
1.875+an error is raised. If the list of files to commit is empty and
1.876+hg-commit-allow-empty-file-list is nil, an error is raised."
1.877+ (interactive)
1.878+ (let ((root hg-root))
1.879+ (save-excursion
1.880+ (run-hooks 'hg-pre-commit-hook)
1.881+ (goto-char (point-min))
1.882+ (search-forward hg-commit-message-start)
1.883+ (let (message files)
1.884+ (let ((start (point)))
1.885+ (goto-char (point-max))
1.886+ (search-backward hg-commit-message-end)
1.887+ (setq message (hg-strip (buffer-substring start (point)))))
1.888+ (when (and (= (length message) 0)
1.889+ (not hg-commit-allow-empty-message))
1.890+ (error "Cannot proceed - commit message is empty"))
1.891+ (forward-line 1)
1.892+ (beginning-of-line)
1.893+ (while (< (point) (point-max))
1.894+ (let ((pos (+ (point) 4)))
1.895+ (end-of-line)
1.896+ (when (eq (get-text-property pos 'face) 'bold)
1.897+ (end-of-line)
1.898+ (setq files (cons (buffer-substring pos (point)) files))))
1.899+ (forward-line 1))
1.900+ (when (and (= (length files) 0)
1.901+ (not hg-commit-allow-empty-file-list))
1.902+ (error "Cannot proceed - no files to commit"))
1.903+ (setq message (concat message "\n"))
1.904+ (apply 'hg-run0 "--cwd" hg-root "commit" "-m" message files))
1.905+ (let ((buf hg-prev-buffer))
1.906+ (kill-buffer nil)
1.907+ (switch-to-buffer buf))
1.908+ (hg-update-mode-lines root))))
1.909+
1.910+(defun hg-commit-mode ()
1.911+ "Mode for describing a commit of changes to a Mercurial repository.
1.912+This involves two actions: describing the changes with a commit
1.913+message, and choosing the files to commit.
1.914+
1.915+To describe the commit, simply type some text in the designated area.
1.916+
1.917+By default, all modified, added and removed files are selected for
1.918+committing. Files that will be committed are displayed in bold face\;
1.919+those that will not are displayed in normal face.
1.920+
1.921+To toggle whether a file will be committed, move the cursor over a
1.922+particular file and hit space or return. Alternatively, middle click
1.923+on the file.
1.924+
1.925+Key bindings
1.926+------------
1.927+\\[hg-commit-finish] proceed with commit
1.928+\\[hg-commit-kill] kill commit
1.929+
1.930+\\[hg-diff-repo] view diff of pending changes"
1.931+ (interactive)
1.932+ (use-local-map hg-commit-mode-map)
1.933+ (set-syntax-table text-mode-syntax-table)
1.934+ (setq local-abbrev-table text-mode-abbrev-table
1.935+ major-mode 'hg-commit-mode
1.936+ mode-name "Hg-Commit")
1.937+ (set-buffer-modified-p nil)
1.938+ (setq buffer-undo-list nil)
1.939+ (run-hooks 'text-mode-hook 'hg-commit-mode-hook))
1.940+
1.941+(defun hg-commit-start ()
1.942+ "Prepare a commit of changes to the repository containing the current file."
1.943+ (interactive)
1.944+ (while hg-prev-buffer
1.945+ (set-buffer hg-prev-buffer))
1.946+ (let ((root (hg-root))
1.947+ (prev-buffer (current-buffer))
1.948+ modified-files)
1.949+ (unless root
1.950+ (error "Cannot commit outside a repository!"))
1.951+ (hg-sync-buffers root)
1.952+ (setq modified-files (hg-chomp (hg-run0 "--cwd" root "status" "-arm")))
1.953+ (when (and (= (length modified-files) 0)
1.954+ (not hg-commit-allow-empty-file-list))
1.955+ (error "No pending changes to commit"))
1.956+ (let* ((buf-name (format "*Mercurial: Commit %s*" root)))
1.957+ (pop-to-buffer (get-buffer-create buf-name))
1.958+ (when (= (point-min) (point-max))
1.959+ (set (make-local-variable 'hg-root) root)
1.960+ (setq hg-prev-buffer prev-buffer)
1.961+ (insert "\n")
1.962+ (let ((bol (point)))
1.963+ (insert hg-commit-message-end)
1.964+ (add-text-properties bol (point) '(face bold-italic)))
1.965+ (let ((file-area (point)))
1.966+ (insert modified-files)
1.967+ (goto-char file-area)
1.968+ (while (< (point) (point-max))
1.969+ (let ((bol (point)))
1.970+ (forward-char 1)
1.971+ (insert " ")
1.972+ (end-of-line)
1.973+ (add-text-properties (+ bol 4) (point)
1.974+ '(face bold mouse-face highlight)))
1.975+ (forward-line 1))
1.976+ (goto-char file-area)
1.977+ (add-text-properties (point) (point-max)
1.978+ `(keymap ,hg-commit-mode-file-map))
1.979+ (goto-char (point-min))
1.980+ (insert hg-commit-message-start)
1.981+ (add-text-properties (point-min) (point) '(face bold-italic))
1.982+ (insert "\n\n")
1.983+ (forward-line -1)
1.984+ (save-excursion
1.985+ (goto-char (point-max))
1.986+ (search-backward hg-commit-message-end)
1.987+ (add-text-properties (match-beginning 0) (point-max)
1.988+ '(read-only t))
1.989+ (goto-char (point-min))
1.990+ (search-forward hg-commit-message-start)
1.991+ (add-text-properties (match-beginning 0) (match-end 0)
1.992+ '(read-only t)))
1.993+ (hg-commit-mode)
1.994+ (cd root))))))
1.995+
1.996+(defun hg-diff (path &optional rev1 rev2)
1.997+ "Show the differences between REV1 and REV2 of PATH.
1.998+When called interactively, the default behaviour is to treat REV1 as
1.999+the \"parent\" revision, REV2 as the current edited version of the file, and
1.1000+PATH as the file edited in the current buffer.
1.1001+With a prefix argument, prompt for all of these."
1.1002+ (interactive (list (hg-read-file-name " to diff")
1.1003+ (let ((rev1 (hg-read-rev " to start with" 'parent)))
1.1004+ (and (not (eq rev1 'parent)) rev1))
1.1005+ (let ((rev2 (hg-read-rev " to end with" 'working-dir)))
1.1006+ (and (not (eq rev2 'working-dir)) rev2))))
1.1007+ (hg-sync-buffers path)
1.1008+ (let ((a-path (hg-abbrev-file-name path))
1.1009+ ;; none revision is specified explicitly
1.1010+ (none (and (not rev1) (not rev2)))
1.1011+ ;; only one revision is specified explicitly
1.1012+ (one (or (and (or (equal rev1 rev2) (not rev2)) rev1)
1.1013+ (and (not rev1) rev2)))
1.1014+ diff)
1.1015+ (hg-view-output ((cond
1.1016+ (none
1.1017+ (format "Mercurial: Diff against parent of %s" a-path))
1.1018+ (one
1.1019+ (format "Mercurial: Diff of rev %s of %s" one a-path))
1.1020+ (t
1.1021+ (format "Mercurial: Diff from rev %s to %s of %s"
1.1022+ rev1 rev2 a-path))))
1.1023+ (cond
1.1024+ (none
1.1025+ (call-process (hg-binary) nil t nil "diff" path))
1.1026+ (one
1.1027+ (call-process (hg-binary) nil t nil "diff" "-r" one path))
1.1028+ (t
1.1029+ (call-process (hg-binary) nil t nil "diff" "-r" rev1 "-r" rev2 path)))
1.1030+ (diff-mode)
1.1031+ (setq diff (not (= (point-min) (point-max))))
1.1032+ (font-lock-fontify-buffer)
1.1033+ (cd (hg-root path)))
1.1034+ diff))
1.1035+
1.1036+(defun hg-diff-repo (path &optional rev1 rev2)
1.1037+ "Show the differences between REV1 and REV2 of repository containing PATH.
1.1038+When called interactively, the default behaviour is to treat REV1 as
1.1039+the \"parent\" revision, REV2 as the current edited version of the file, and
1.1040+PATH as the `hg-root' of the current buffer.
1.1041+With a prefix argument, prompt for all of these."
1.1042+ (interactive (list (hg-read-file-name " to diff")
1.1043+ (let ((rev1 (hg-read-rev " to start with" 'parent)))
1.1044+ (and (not (eq rev1 'parent)) rev1))
1.1045+ (let ((rev2 (hg-read-rev " to end with" 'working-dir)))
1.1046+ (and (not (eq rev2 'working-dir)) rev2))))
1.1047+ (hg-diff (hg-root path) rev1 rev2))
1.1048+
1.1049+(defun hg-forget (path)
1.1050+ "Lose track of PATH, which has been added, but not yet committed.
1.1051+This will prevent the file from being incorporated into the Mercurial
1.1052+repository on the next commit.
1.1053+With a prefix argument, prompt for the path to forget."
1.1054+ (interactive (list (hg-read-file-name " to forget")))
1.1055+ (let ((buf (current-buffer))
1.1056+ (update (equal buffer-file-name path)))
1.1057+ (hg-view-output (hg-output-buffer-name)
1.1058+ (apply 'call-process (hg-binary) nil t nil (list "forget" path))
1.1059+ ;; "hg forget" shows pathes relative NOT TO ROOT BUT TO REPOSITORY
1.1060+ (hg-fix-paths)
1.1061+ (goto-char (point-min))
1.1062+ (cd (hg-root path)))
1.1063+ (when update
1.1064+ (with-current-buffer buf
1.1065+ (when (local-variable-p 'backup-inhibited)
1.1066+ (kill-local-variable 'backup-inhibited))
1.1067+ (hg-mode-line)))))
1.1068+
1.1069+(defun hg-incoming (&optional repo)
1.1070+ "Display changesets present in REPO that are not present locally."
1.1071+ (interactive (list (hg-read-repo-name " where changes would come from")))
1.1072+ (hg-view-output ((format "Mercurial: Incoming from %s to %s"
1.1073+ (hg-abbrev-file-name (hg-root))
1.1074+ (hg-abbrev-file-name
1.1075+ (or repo hg-incoming-repository))))
1.1076+ (call-process (hg-binary) nil t nil "incoming"
1.1077+ (or repo hg-incoming-repository))
1.1078+ (hg-log-mode)
1.1079+ (cd (hg-root))))
1.1080+
1.1081+(defun hg-init ()
1.1082+ (interactive)
1.1083+ (error "not implemented"))
1.1084+
1.1085+(defun hg-log-mode ()
1.1086+ "Mode for viewing a Mercurial change log."
1.1087+ (goto-char (point-min))
1.1088+ (when (looking-at "^searching for changes.*$")
1.1089+ (delete-region (match-beginning 0) (match-end 0)))
1.1090+ (run-hooks 'hg-log-mode-hook))
1.1091+
1.1092+(defun hg-log (path &optional rev1 rev2 log-limit)
1.1093+ "Display the revision history of PATH.
1.1094+History is displayed between REV1 and REV2.
1.1095+Number of displayed changesets is limited to LOG-LIMIT.
1.1096+REV1 defaults to the tip, while REV2 defaults to 0.
1.1097+LOG-LIMIT defaults to `hg-log-limit'.
1.1098+With a prefix argument, prompt for each parameter."
1.1099+ (interactive (list (hg-read-file-name " to log")
1.1100+ (hg-read-rev " to start with"
1.1101+ "tip")
1.1102+ (hg-read-rev " to end with"
1.1103+ "0")
1.1104+ (hg-read-number "Output limited to: "
1.1105+ hg-log-limit)))
1.1106+ (let ((a-path (hg-abbrev-file-name path))
1.1107+ (r1 (or rev1 "tip"))
1.1108+ (r2 (or rev2 "0"))
1.1109+ (limit (format "%d" (or log-limit hg-log-limit))))
1.1110+ (hg-view-output ((if (equal r1 r2)
1.1111+ (format "Mercurial: Log of rev %s of %s" rev1 a-path)
1.1112+ (format
1.1113+ "Mercurial: at most %s log(s) from rev %s to %s of %s"
1.1114+ limit r1 r2 a-path)))
1.1115+ (eval (list* 'call-process (hg-binary) nil t nil
1.1116+ "log"
1.1117+ "-r" (format "%s:%s" r1 r2)
1.1118+ "-l" limit
1.1119+ (if (> (length path) (length (hg-root path)))
1.1120+ (cons path nil)
1.1121+ nil)))
1.1122+ (hg-log-mode)
1.1123+ (cd (hg-root path)))))
1.1124+
1.1125+(defun hg-log-repo (path &optional rev1 rev2 log-limit)
1.1126+ "Display the revision history of the repository containing PATH.
1.1127+History is displayed between REV1 and REV2.
1.1128+Number of displayed changesets is limited to LOG-LIMIT,
1.1129+REV1 defaults to the tip, while REV2 defaults to 0.
1.1130+LOG-LIMIT defaults to `hg-log-limit'.
1.1131+With a prefix argument, prompt for each parameter."
1.1132+ (interactive (list (hg-read-file-name " to log")
1.1133+ (hg-read-rev " to start with"
1.1134+ "tip")
1.1135+ (hg-read-rev " to end with"
1.1136+ "0")
1.1137+ (hg-read-number "Output limited to: "
1.1138+ hg-log-limit)))
1.1139+ (hg-log (hg-root path) rev1 rev2 log-limit))
1.1140+
1.1141+(defun hg-outgoing (&optional repo)
1.1142+ "Display changesets present locally that are not present in REPO."
1.1143+ (interactive (list (hg-read-repo-name " where changes would go to" nil
1.1144+ hg-outgoing-repository)))
1.1145+ (hg-view-output ((format "Mercurial: Outgoing from %s to %s"
1.1146+ (hg-abbrev-file-name (hg-root))
1.1147+ (hg-abbrev-file-name
1.1148+ (or repo hg-outgoing-repository))))
1.1149+ (call-process (hg-binary) nil t nil "outgoing"
1.1150+ (or repo hg-outgoing-repository))
1.1151+ (hg-log-mode)
1.1152+ (cd (hg-root))))
1.1153+
1.1154+(defun hg-pull (&optional repo)
1.1155+ "Pull changes from repository REPO.
1.1156+This does not update the working directory."
1.1157+ (interactive (list (hg-read-repo-name " to pull from")))
1.1158+ (hg-view-output ((format "Mercurial: Pull to %s from %s"
1.1159+ (hg-abbrev-file-name (hg-root))
1.1160+ (hg-abbrev-file-name
1.1161+ (or repo hg-incoming-repository))))
1.1162+ (call-process (hg-binary) nil t nil "pull"
1.1163+ (or repo hg-incoming-repository))
1.1164+ (cd (hg-root))))
1.1165+
1.1166+(defun hg-push (&optional repo)
1.1167+ "Push changes to repository REPO."
1.1168+ (interactive (list (hg-read-repo-name " to push to")))
1.1169+ (hg-view-output ((format "Mercurial: Push from %s to %s"
1.1170+ (hg-abbrev-file-name (hg-root))
1.1171+ (hg-abbrev-file-name
1.1172+ (or repo hg-outgoing-repository))))
1.1173+ (call-process (hg-binary) nil t nil "push"
1.1174+ (or repo hg-outgoing-repository))
1.1175+ (cd (hg-root))))
1.1176+
1.1177+(defun hg-revert-buffer-internal ()
1.1178+ (let ((ctx (hg-buffer-context)))
1.1179+ (message "Reverting %s..." buffer-file-name)
1.1180+ (hg-run0 "revert" buffer-file-name)
1.1181+ (revert-buffer t t t)
1.1182+ (hg-restore-context ctx)
1.1183+ (hg-mode-line)
1.1184+ (message "Reverting %s...done" buffer-file-name)))
1.1185+
1.1186+(defun hg-revert-buffer ()
1.1187+ "Revert current buffer's file back to the latest committed version.
1.1188+If the file has not changed, nothing happens. Otherwise, this
1.1189+displays a diff and asks for confirmation before reverting."
1.1190+ (interactive)
1.1191+ (let ((vc-suppress-confirm nil)
1.1192+ (obuf (current-buffer))
1.1193+ diff)
1.1194+ (vc-buffer-sync)
1.1195+ (unwind-protect
1.1196+ (setq diff (hg-diff buffer-file-name))
1.1197+ (when diff
1.1198+ (unless (yes-or-no-p "Discard changes? ")
1.1199+ (error "Revert cancelled")))
1.1200+ (when diff
1.1201+ (let ((buf (current-buffer)))
1.1202+ (delete-window (selected-window))
1.1203+ (kill-buffer buf))))
1.1204+ (set-buffer obuf)
1.1205+ (when diff
1.1206+ (hg-revert-buffer-internal))))
1.1207+
1.1208+(defun hg-root (&optional path)
1.1209+ "Return the root of the repository that contains the given path.
1.1210+If the path is outside a repository, return nil.
1.1211+When called interactively, the root is printed. A prefix argument
1.1212+prompts for a path to check."
1.1213+ (interactive (list (hg-read-file-name)))
1.1214+ (if (or path (not hg-root))
1.1215+ (let ((root (do ((prev nil dir)
1.1216+ (dir (file-name-directory
1.1217+ (or
1.1218+ path
1.1219+ buffer-file-name
1.1220+ (expand-file-name default-directory)))
1.1221+ (file-name-directory (directory-file-name dir))))
1.1222+ ((equal prev dir))
1.1223+ (when (file-directory-p (concat dir ".hg"))
1.1224+ (return dir)))))
1.1225+ (when (interactive-p)
1.1226+ (if root
1.1227+ (message "The root of this repository is `%s'." root)
1.1228+ (message "The path `%s' is not in a Mercurial repository."
1.1229+ (hg-abbrev-file-name path))))
1.1230+ root)
1.1231+ hg-root))
1.1232+
1.1233+(defun hg-cwd (&optional path)
1.1234+ "Return the current directory of PATH within the repository."
1.1235+ (do ((stack nil (cons (file-name-nondirectory
1.1236+ (directory-file-name dir))
1.1237+ stack))
1.1238+ (prev nil dir)
1.1239+ (dir (file-name-directory (or path buffer-file-name
1.1240+ (expand-file-name default-directory)))
1.1241+ (file-name-directory (directory-file-name dir))))
1.1242+ ((equal prev dir))
1.1243+ (when (file-directory-p (concat dir ".hg"))
1.1244+ (let ((cwd (mapconcat 'identity stack "/")))
1.1245+ (unless (equal cwd "")
1.1246+ (return (file-name-as-directory cwd)))))))
1.1247+
1.1248+(defun hg-status (path)
1.1249+ "Print revision control status of a file or directory.
1.1250+With prefix argument, prompt for the path to give status for.
1.1251+Names are displayed relative to the repository root."
1.1252+ (interactive (list (hg-read-file-name " for status" (hg-root))))
1.1253+ (let ((root (hg-root)))
1.1254+ (hg-view-output ((format "Mercurial: Status of %s in %s"
1.1255+ (let ((name (substring (expand-file-name path)
1.1256+ (length root))))
1.1257+ (if (> (length name) 0)
1.1258+ name
1.1259+ "*"))
1.1260+ (hg-abbrev-file-name root)))
1.1261+ (apply 'call-process (hg-binary) nil t nil
1.1262+ (list "--cwd" root "status" path))
1.1263+ (cd (hg-root path)))))
1.1264+
1.1265+(defun hg-undo ()
1.1266+ (interactive)
1.1267+ (error "not implemented"))
1.1268+
1.1269+(defun hg-update ()
1.1270+ (interactive)
1.1271+ (error "not implemented"))
1.1272+
1.1273+(defun hg-version-other-window (rev)
1.1274+ "Visit version REV of the current file in another window.
1.1275+If the current file is named `F', the version is named `F.~REV~'.
1.1276+If `F.~REV~' already exists, use it instead of checking it out again."
1.1277+ (interactive "sVersion to visit (default is workfile version): ")
1.1278+ (let* ((file buffer-file-name)
1.1279+ (version (if (string-equal rev "")
1.1280+ "tip"
1.1281+ rev))
1.1282+ (automatic-backup (vc-version-backup-file-name file version))
1.1283+ (manual-backup (vc-version-backup-file-name file version 'manual)))
1.1284+ (unless (file-exists-p manual-backup)
1.1285+ (if (file-exists-p automatic-backup)
1.1286+ (rename-file automatic-backup manual-backup nil)
1.1287+ (hg-run0 "-q" "cat" "-r" version "-o" manual-backup file)))
1.1288+ (find-file-other-window manual-backup)))
1.1289+
1.1290+
1.1291+(provide 'mercurial)
1.1292+
1.1293+
1.1294+;;; Local Variables:
1.1295+;;; prompt-to-byte-compile: nil
1.1296+;;; end:
2.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
2.2+++ b/.emacs.d/lib/mq.el Wed Jun 05 23:31:48 2024 +0000
2.3@@ -0,0 +1,417 @@
2.4+;;; mq.el --- Emacs support for Mercurial Queues
2.5+
2.6+;; Copyright (C) 2006 Bryan O'Sullivan
2.7+
2.8+;; Author: Bryan O'Sullivan <bos@serpentine.com>
2.9+
2.10+;; mq.el is free software; you can redistribute it and/or modify it
2.11+;; under the terms of the GNU General Public License version 2 or any
2.12+;; later version.
2.13+
2.14+;; mq.el is distributed in the hope that it will be useful, but
2.15+;; WITHOUT ANY WARRANTY; without even the implied warranty of
2.16+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
2.17+;; General Public License for more details.
2.18+
2.19+;; You should have received a copy of the GNU General Public License
2.20+;; along with mq.el, GNU Emacs, or XEmacs; see the file COPYING (`C-h
2.21+;; C-l'). If not, see <http://www.gnu.org/licenses/>.
2.22+
2.23+(eval-when-compile (require 'cl))
2.24+(require 'mercurial)
2.25+
2.26+
2.27+(defcustom mq-mode-hook nil
2.28+ "Hook run when a buffer enters mq-mode."
2.29+ :type 'sexp
2.30+ :group 'mercurial)
2.31+
2.32+(defcustom mq-global-prefix "\C-cq"
2.33+ "The global prefix for Mercurial Queues keymap bindings."
2.34+ :type 'sexp
2.35+ :group 'mercurial)
2.36+
2.37+(defcustom mq-edit-mode-hook nil
2.38+ "Hook run after a buffer is populated to edit a patch description."
2.39+ :type 'sexp
2.40+ :group 'mercurial)
2.41+
2.42+(defcustom mq-edit-finish-hook nil
2.43+ "Hook run before a patch description is finished up with."
2.44+ :type 'sexp
2.45+ :group 'mercurial)
2.46+
2.47+(defcustom mq-signoff-address nil
2.48+ "Address with which to sign off on a patch."
2.49+ :type 'string
2.50+ :group 'mercurial)
2.51+
2.52+
2.53+;;; Internal variables.
2.54+
2.55+(defvar mq-mode nil
2.56+ "Is this file managed by MQ?")
2.57+(make-variable-buffer-local 'mq-mode)
2.58+(put 'mq-mode 'permanent-local t)
2.59+
2.60+(defvar mq-patch-history nil)
2.61+
2.62+(defvar mq-top-patch '(nil))
2.63+
2.64+(defvar mq-prev-buffer nil)
2.65+(make-variable-buffer-local 'mq-prev-buffer)
2.66+(put 'mq-prev-buffer 'permanent-local t)
2.67+
2.68+(defvar mq-top nil)
2.69+(make-variable-buffer-local 'mq-top)
2.70+(put 'mq-top 'permanent-local t)
2.71+
2.72+;;; Global keymap.
2.73+
2.74+(defvar mq-global-map
2.75+ (let ((map (make-sparse-keymap)))
2.76+ (define-key map "." 'mq-push)
2.77+ (define-key map ">" 'mq-push-all)
2.78+ (define-key map "," 'mq-pop)
2.79+ (define-key map "<" 'mq-pop-all)
2.80+ (define-key map "=" 'mq-diff)
2.81+ (define-key map "r" 'mq-refresh)
2.82+ (define-key map "e" 'mq-refresh-edit)
2.83+ (define-key map "i" 'mq-new)
2.84+ (define-key map "n" 'mq-next)
2.85+ (define-key map "o" 'mq-signoff)
2.86+ (define-key map "p" 'mq-previous)
2.87+ (define-key map "s" 'mq-edit-series)
2.88+ (define-key map "t" 'mq-top)
2.89+ map))
2.90+
2.91+(global-set-key mq-global-prefix mq-global-map)
2.92+
2.93+(add-minor-mode 'mq-mode 'mq-mode)
2.94+
2.95+
2.96+;;; Refresh edit mode keymap.
2.97+
2.98+(defvar mq-edit-mode-map
2.99+ (let ((map (make-sparse-keymap)))
2.100+ (define-key map "\C-c\C-c" 'mq-edit-finish)
2.101+ (define-key map "\C-c\C-k" 'mq-edit-kill)
2.102+ (define-key map "\C-c\C-s" 'mq-signoff)
2.103+ map))
2.104+
2.105+
2.106+;;; Helper functions.
2.107+
2.108+(defun mq-read-patch-name (&optional source prompt force)
2.109+ "Read a patch name to use with a command.
2.110+May return nil, meaning \"use the default\"."
2.111+ (let ((patches (split-string
2.112+ (hg-chomp (hg-run0 (or source "qseries"))) "\n")))
2.113+ (when force
2.114+ (completing-read (format "Patch%s: " (or prompt ""))
2.115+ (mapcar (lambda (x) (cons x x)) patches)
2.116+ nil
2.117+ nil
2.118+ nil
2.119+ 'mq-patch-history))))
2.120+
2.121+(defun mq-refresh-buffers (root)
2.122+ (save-excursion
2.123+ (dolist (buf (hg-buffers-visiting-repo root))
2.124+ (when (not (verify-visited-file-modtime buf))
2.125+ (set-buffer buf)
2.126+ (let ((ctx (hg-buffer-context)))
2.127+ (message "Refreshing %s..." (buffer-name))
2.128+ (revert-buffer t t t)
2.129+ (hg-restore-context ctx)
2.130+ (message "Refreshing %s...done" (buffer-name))))))
2.131+ (hg-update-mode-lines root)
2.132+ (mq-update-mode-lines root))
2.133+
2.134+(defun mq-last-line ()
2.135+ (goto-char (point-max))
2.136+ (beginning-of-line)
2.137+ (when (looking-at "^$")
2.138+ (forward-line -1))
2.139+ (let ((bol (point)))
2.140+ (end-of-line)
2.141+ (let ((line (buffer-substring bol (point))))
2.142+ (when (> (length line) 0)
2.143+ line))))
2.144+
2.145+(defun mq-push (&optional patch)
2.146+ "Push patches until PATCH is reached.
2.147+If PATCH is nil, push at most one patch."
2.148+ (interactive (list (mq-read-patch-name "qunapplied" " to push"
2.149+ current-prefix-arg)))
2.150+ (let ((root (hg-root))
2.151+ (prev-buf (current-buffer))
2.152+ last-line ok)
2.153+ (unless root
2.154+ (error "Cannot push outside a repository!"))
2.155+ (hg-sync-buffers root)
2.156+ (let ((buf-name (format "MQ: Push %s" (or patch "next patch"))))
2.157+ (kill-buffer (get-buffer-create buf-name))
2.158+ (split-window-vertically)
2.159+ (other-window 1)
2.160+ (switch-to-buffer (get-buffer-create buf-name))
2.161+ (cd root)
2.162+ (message "Pushing...")
2.163+ (setq ok (= 0 (apply 'call-process (hg-binary) nil t t "qpush"
2.164+ (if patch (list patch))))
2.165+ last-line (mq-last-line))
2.166+ (let ((lines (count-lines (point-min) (point-max))))
2.167+ (if (or (<= lines 1)
2.168+ (and (equal lines 2) (string-match "Now at:" last-line)))
2.169+ (progn
2.170+ (kill-buffer (current-buffer))
2.171+ (delete-window))
2.172+ (hg-view-mode prev-buf))))
2.173+ (mq-refresh-buffers root)
2.174+ (sit-for 0)
2.175+ (when last-line
2.176+ (if ok
2.177+ (message "Pushing... %s" last-line)
2.178+ (error "Pushing... %s" last-line)))))
2.179+
2.180+(defun mq-push-all ()
2.181+ "Push patches until all are applied."
2.182+ (interactive)
2.183+ (mq-push "-a"))
2.184+
2.185+(defun mq-pop (&optional patch)
2.186+ "Pop patches until PATCH is reached.
2.187+If PATCH is nil, pop at most one patch."
2.188+ (interactive (list (mq-read-patch-name "qapplied" " to pop to"
2.189+ current-prefix-arg)))
2.190+ (let ((root (hg-root))
2.191+ last-line ok)
2.192+ (unless root
2.193+ (error "Cannot pop outside a repository!"))
2.194+ (hg-sync-buffers root)
2.195+ (set-buffer (generate-new-buffer "qpop"))
2.196+ (cd root)
2.197+ (message "Popping...")
2.198+ (setq ok (= 0 (apply 'call-process (hg-binary) nil t t "qpop"
2.199+ (if patch (list patch))))
2.200+ last-line (mq-last-line))
2.201+ (kill-buffer (current-buffer))
2.202+ (mq-refresh-buffers root)
2.203+ (sit-for 0)
2.204+ (when last-line
2.205+ (if ok
2.206+ (message "Popping... %s" last-line)
2.207+ (error "Popping... %s" last-line)))))
2.208+
2.209+(defun mq-pop-all ()
2.210+ "Push patches until none are applied."
2.211+ (interactive)
2.212+ (mq-pop "-a"))
2.213+
2.214+(defun mq-refresh-internal (root &rest args)
2.215+ (hg-sync-buffers root)
2.216+ (let ((patch (mq-patch-info "qtop")))
2.217+ (message "Refreshing %s..." patch)
2.218+ (let ((ret (apply 'hg-run "qrefresh" args)))
2.219+ (if (equal (car ret) 0)
2.220+ (message "Refreshing %s... done." patch)
2.221+ (error "Refreshing %s... %s" patch (hg-chomp (cdr ret)))))))
2.222+
2.223+(defun mq-refresh (&optional git)
2.224+ "Refresh the topmost applied patch.
2.225+With a prefix argument, generate a git-compatible patch."
2.226+ (interactive "P")
2.227+ (let ((root (hg-root)))
2.228+ (unless root
2.229+ (error "Cannot refresh outside of a repository!"))
2.230+ (apply 'mq-refresh-internal root (if git '("--git")))))
2.231+
2.232+(defun mq-patch-info (cmd &optional msg)
2.233+ (let* ((ret (hg-run cmd))
2.234+ (info (hg-chomp (cdr ret))))
2.235+ (if (equal (car ret) 0)
2.236+ (if msg
2.237+ (message "%s patch: %s" msg info)
2.238+ info)
2.239+ (error "%s" info))))
2.240+
2.241+(defun mq-top ()
2.242+ "Print the name of the topmost applied patch."
2.243+ (interactive)
2.244+ (mq-patch-info "qtop" "Top"))
2.245+
2.246+(defun mq-next ()
2.247+ "Print the name of the next patch to be pushed."
2.248+ (interactive)
2.249+ (mq-patch-info "qnext" "Next"))
2.250+
2.251+(defun mq-previous ()
2.252+ "Print the name of the first patch below the topmost applied patch.
2.253+This would become the active patch if popped to."
2.254+ (interactive)
2.255+ (mq-patch-info "qprev" "Previous"))
2.256+
2.257+(defun mq-edit-finish ()
2.258+ "Finish editing the description of this patch, and refresh the patch."
2.259+ (interactive)
2.260+ (unless (equal (mq-patch-info "qtop") mq-top)
2.261+ (error "Topmost patch has changed!"))
2.262+ (hg-sync-buffers hg-root)
2.263+ (run-hooks 'mq-edit-finish-hook)
2.264+ (mq-refresh-internal hg-root "-m" (buffer-substring (point-min) (point-max)))
2.265+ (let ((buf mq-prev-buffer))
2.266+ (kill-buffer nil)
2.267+ (switch-to-buffer buf)))
2.268+
2.269+(defun mq-edit-kill ()
2.270+ "Kill the edit currently being prepared."
2.271+ (interactive)
2.272+ (when (or (not (buffer-modified-p)) (y-or-n-p "Really kill this edit? "))
2.273+ (let ((buf mq-prev-buffer))
2.274+ (kill-buffer nil)
2.275+ (switch-to-buffer buf))))
2.276+
2.277+(defun mq-get-top (root)
2.278+ (let ((entry (assoc root mq-top-patch)))
2.279+ (if entry
2.280+ (cdr entry))))
2.281+
2.282+(defun mq-set-top (root patch)
2.283+ (let ((entry (assoc root mq-top-patch)))
2.284+ (if entry
2.285+ (if patch
2.286+ (setcdr entry patch)
2.287+ (setq mq-top-patch (delq entry mq-top-patch)))
2.288+ (setq mq-top-patch (cons (cons root patch) mq-top-patch)))))
2.289+
2.290+(defun mq-update-mode-lines (root)
2.291+ (let ((cwd default-directory))
2.292+ (cd root)
2.293+ (condition-case nil
2.294+ (mq-set-top root (mq-patch-info "qtop"))
2.295+ (error (mq-set-top root nil)))
2.296+ (cd cwd))
2.297+ (let ((patch (mq-get-top root)))
2.298+ (save-excursion
2.299+ (dolist (buf (hg-buffers-visiting-repo root))
2.300+ (set-buffer buf)
2.301+ (if mq-mode
2.302+ (setq mq-mode (or (and patch (concat " MQ:" patch)) " MQ")))))))
2.303+
2.304+(defun mq-mode (&optional arg)
2.305+ "Minor mode for Mercurial repositories with an MQ patch queue"
2.306+ (interactive "i")
2.307+ (cond ((hg-root)
2.308+ (setq mq-mode (if (null arg) (not mq-mode)
2.309+ arg))
2.310+ (mq-update-mode-lines (hg-root))))
2.311+ (run-hooks 'mq-mode-hook))
2.312+
2.313+(defun mq-edit-mode ()
2.314+ "Mode for editing the description of a patch.
2.315+
2.316+Key bindings
2.317+------------
2.318+\\[mq-edit-finish] use this description
2.319+\\[mq-edit-kill] abandon this description"
2.320+ (interactive)
2.321+ (use-local-map mq-edit-mode-map)
2.322+ (set-syntax-table text-mode-syntax-table)
2.323+ (setq local-abbrev-table text-mode-abbrev-table
2.324+ major-mode 'mq-edit-mode
2.325+ mode-name "MQ-Edit")
2.326+ (set-buffer-modified-p nil)
2.327+ (setq buffer-undo-list nil)
2.328+ (run-hooks 'text-mode-hook 'mq-edit-mode-hook))
2.329+
2.330+(defun mq-refresh-edit ()
2.331+ "Refresh the topmost applied patch, editing the patch description."
2.332+ (interactive)
2.333+ (while mq-prev-buffer
2.334+ (set-buffer mq-prev-buffer))
2.335+ (let ((root (hg-root))
2.336+ (prev-buffer (current-buffer))
2.337+ (patch (mq-patch-info "qtop")))
2.338+ (hg-sync-buffers root)
2.339+ (let ((buf-name (format "*MQ: Edit description of %s*" patch)))
2.340+ (switch-to-buffer (get-buffer-create buf-name))
2.341+ (when (= (point-min) (point-max))
2.342+ (set (make-local-variable 'hg-root) root)
2.343+ (set (make-local-variable 'mq-top) patch)
2.344+ (setq mq-prev-buffer prev-buffer)
2.345+ (insert (hg-run0 "qheader"))
2.346+ (goto-char (point-min)))
2.347+ (mq-edit-mode)
2.348+ (cd root)))
2.349+ (message "Type `C-c C-c' to finish editing and refresh the patch."))
2.350+
2.351+(defun mq-new (name)
2.352+ "Create a new empty patch named NAME.
2.353+The patch is applied on top of the current topmost patch.
2.354+With a prefix argument, forcibly create the patch even if the working
2.355+directory is modified."
2.356+ (interactive (list (mq-read-patch-name "qseries" " to create" t)))
2.357+ (message "Creating patch...")
2.358+ (let ((ret (if current-prefix-arg
2.359+ (hg-run "qnew" "-f" name)
2.360+ (hg-run "qnew" name))))
2.361+ (if (equal (car ret) 0)
2.362+ (progn
2.363+ (hg-update-mode-lines (buffer-file-name))
2.364+ (message "Creating patch... done."))
2.365+ (error "Creating patch... %s" (hg-chomp (cdr ret))))))
2.366+
2.367+(defun mq-edit-series ()
2.368+ "Edit the MQ series file directly."
2.369+ (interactive)
2.370+ (let ((root (hg-root)))
2.371+ (unless root
2.372+ (error "Not in an MQ repository!"))
2.373+ (find-file (concat root ".hg/patches/series"))))
2.374+
2.375+(defun mq-diff (&optional git)
2.376+ "Display a diff of the topmost applied patch.
2.377+With a prefix argument, display a git-compatible diff."
2.378+ (interactive "P")
2.379+ (hg-view-output ((format "MQ: Diff of %s" (mq-patch-info "qtop")))
2.380+ (if git
2.381+ (call-process (hg-binary) nil t nil "qdiff" "--git")
2.382+ (call-process (hg-binary) nil t nil "qdiff"))
2.383+ (diff-mode)
2.384+ (font-lock-fontify-buffer)))
2.385+
2.386+(defun mq-signoff ()
2.387+ "Sign off on the current patch, in the style used by the Linux kernel.
2.388+If the variable mq-signoff-address is non-nil, it will be used, otherwise
2.389+the value of the ui.username item from your hgrc will be used."
2.390+ (interactive)
2.391+ (let ((was-editing (eq major-mode 'mq-edit-mode))
2.392+ signed)
2.393+ (unless was-editing
2.394+ (mq-refresh-edit))
2.395+ (save-excursion
2.396+ (let* ((user (or mq-signoff-address
2.397+ (hg-run0 "debugconfig" "ui.username")))
2.398+ (signoff (concat "Signed-off-by: " user)))
2.399+ (if (search-forward signoff nil t)
2.400+ (message "You have already signed off on this patch.")
2.401+ (goto-char (point-max))
2.402+ (let ((case-fold-search t))
2.403+ (if (re-search-backward "^Signed-off-by: " nil t)
2.404+ (forward-line 1)
2.405+ (insert "\n")))
2.406+ (insert signoff)
2.407+ (message "%s" signoff)
2.408+ (setq signed t))))
2.409+ (unless was-editing
2.410+ (if signed
2.411+ (mq-edit-finish)
2.412+ (mq-edit-kill)))))
2.413+
2.414+
2.415+(provide 'mq)
2.416+
2.417+
2.418+;;; Local Variables:
2.419+;;; prompt-to-byte-compile: nil
2.420+;;; end:
