Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

rm

  • Loading branch information...
commit 7027d76a650e31e67234a4c5282f56cae9307bcd 1 parent 6eaf1f9
@tavisrudd authored
Showing with 0 additions and 772 deletions.
  1. +0 −772 vendor/mercurial-queues.el
View
772 vendor/mercurial-queues.el
@@ -1,772 +0,0 @@
-;;; mercurial-queues.el --- commands for working with Mercurial patch queues
-
-;; Copyright (C) 2009 Jim Blandy
-
-;; Author: Jim Blandy <jimb@red-bean.com>
-;; Version: 0.1
-
-;; mercurial-queues.el is free software; you can redistribute it
-;; and/or modify it under the terms of the GNU General Public
-;; License as published by the Free Software Foundation; either
-;; version 2, or (at your option) any later version.
-;;
-;; mercurial-queues.el is distributed in the hope that it will be
-;; useful, but WITHOUT ANY WARRANTY; without even the implied
-;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-;; See the GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; This package provides commands for working with Mercurial patch
-;; queues, described here:
-;;
-;; http://mercurial.selenic.com/wiki/MqExtension
-;; http://hgbook.red-bean.com/read/managing-change-with-mercurial-queues.html
-;;
-;; Briefly, a patch queue is a sequence of patches meant to apply to
-;; some source tree under Mercurial's control. The 'hg qpush' command
-;; applies the next patch in the series; 'hg qpop' un-applies the last
-;; applied patch; and 'hg qrefresh' integrates any changes you've made
-;; to the working files into the top patch.
-;;
-;; Patch queues are useful for maintaining a set of patches you intend
-;; to submit for review: instead of merging others' changes into your
-;; latest sources, you pop all your patches, update, and then re-push,
-;; adjusting and refreshing the patches as appropriate. This way, the
-;; patches stay applicable to the latest sources, ready for review.
-;;
-;; This package provides:
-;;
-;; - Emacs commands for pushing, refreshing, and popping patches,
-;; creating new patches, deleting patches, and incorporating patches
-;; into the ordinary Mercurial history, and
-;;
-;; - An Emacs mode for viewing and editing the patch series, showing
-;; which patches are currently applied.
-;;
-;; Installation
-;; ============
-;;
-;; To use this package, place this file in a directory listed in your
-;; load-path, and then put the following in your .emacs file:
-;;
-;; (require 'mercurial-queues)
-;; (add-to-list 'auto-mode-alist '(".hg/patches/series$" . mq-series-mode))
-;;
-;; Usage
-;; =====
-;; With this package loaded, the following commands are available:
-;;
-;; C-x q n --- Apply the next patch in the series (as by 'hg qpush').
-;; C-x q p --- Un-apply the last applied patch (as by 'hg qpop').
-;; C-x q r --- Incorporate the current changes to the working files into the
-;; top patch (as by 'hg qrefresh').
-;; C-x q s --- Visit the series file in a Series Mode buffer. Series Mode
-;; shows which patches are currently applied, and provides
-;; commands to push/pop up to a given patch, visit patches, and
-;; so on. You can edit the seris with the normal Emacs editing
-;; commands. Visit the Series Mode documentation with `C-h m
-;; series-mode RET' for details.
-;; C-x 4 q s --- Visit the series file in another window.
-;;
-;; This package takes over the global binding of `C-x q' as a prefix
-;; for its commands. This is normally bound to `kbd-macro-query', but
-;; that command is also available as `C-x C-k q', under the common
-;; `C-x C-k' prefix for all macro-related commands.
-;;
-;; Ideas
-;; =====
-;;
-;; qdelete
-;; mark pushed patches as read-only
-;;
-;; font-locking highlighting for series file comments.
-;;
-;; When pushing a patch produces a conflict, it would be nice to
-;; gather up the .rej files into a diff-mode buffer. Users could use
-;; the diff-mode commands to visit the erstwhile context, etc.
-
-(require 'cl)
-
-
-;;; Customizable things.
-
-(defface mq-applied-patch '((t :weight bold))
- "Face for applied patches in a Mercurial Queues `series' file.")
-
-(defface mq-condition-positive-selected
- '((((class color)) :foreground "#00c011"))
- "Face for positive guard conditions (#+) whose guards are selected.")
-
-(defface mq-condition-negative-selected
- '((((class color)) :foreground "#b60000"))
- "Face for negative guard conditions (#+) whose guards are selected.")
-
-
-;;; Utility functions.
-
-(defun mq-hg-root-directory ()
- "Return the root of the Mercurial tree containing the currently visited file.
-This is the directory containing the `.hg' subdirectory.
-If the current buffer's default directory is `ROOT/.hg/patches',
-then we return `ROOT', even if there is a `ROOT/.hg/patches/.hg'
-directory."
- (let ((dir default-directory))
- (unless dir
- (error "Selected buffer has no default directory"))
- (setq dir (expand-file-name dir))
-
- ;; It can be useful for the ROOT/.hg/patches directory itself to be a
- ;; Mercurial root, with its own metadata in ROOT/.hg/patches/.hg. Calling
- ;; this function in such a directory should arguably return
- ;; ROOT/.hg/patches.
- ;;
- ;; However, it doesn't seem very useful to have queues of patches to
- ;; patches (metaqueues!), and it does seem useful for the global series
- ;; commands --- mq-visit-series, etc. --- to operate using ROOT when
- ;; invoked in ROOT/.hg/patches, regardless of whether that directory is
- ;; itself a root. So we do that.
- (if (string-match "\\`\\(.*/\\)\\.hg/patches/\\'" dir)
- (match-string 1 dir)
- (while (not (file-directory-p (expand-file-name ".hg" dir)))
- (let ((parent (file-name-directory (directory-file-name dir))))
- ;; We've reached the root when the above hands us back the
- ;; same thing we gave it.
- (when (string-equal dir parent)
- (error "directory not managed by mercurial: %s" default-directory))
- (setq dir parent)))
- dir)))
-
-(defun mq-patch-directory-name (root)
- "Return the patch directory for the Mercurial root directory ROOT."
- (file-name-as-directory (expand-file-name ".hg/patches" root)))
-
-(defun mq-root-for-patch-directory (dir)
- "If DIR is a patch directory, return its root. Otherwise, return nil."
- (when (string-match "\\`\\(.*/\\)\\.hg/patches/\\'" dir)
- (match-string 1 dir)))
-
-(defun mq-metadata-file-name (root name)
- "Return the name of the MQ metadata file NAME for the Mercurial tree ROOT."
- (expand-file-name name (mq-patch-directory-name root)))
-
-(defun mq-series-file-name (root) (mq-metadata-file-name root "series"))
-(defun mq-status-file-name (root) (mq-metadata-file-name root "status"))
-(defun mq-guards-file-name (root) (mq-metadata-file-name root "guards"))
-
-(defun mq-check-for-queue ()
- "Raise an error if the current directory has no associated patch queue."
- (let* ((root (mq-hg-root-directory))
- (patch-directory (mq-patch-directory-name root))
- (series-file (mq-series-file-name root)))
- (unless (file-directory-p patch-directory)
- (error "Mercurial tree has no patch directory: %s" root))
- (unless (file-exists-p series-file)
- (error "Mercurial tree has no series file: %s" root))))
-
-(defun mq-parse-status-file (filename)
- "Parse the contents of the MQ status file named FILENAME.
-The return value is a list of the applied patches, from last to earliest.
-If there is no status file, this returns nil."
- (if (file-exists-p filename)
- (with-temp-buffer
- (insert-file-contents filename)
- (goto-char (point-min))
- (let (patches)
- (while (< (point) (point-max))
- (unless (looking-at "[0-9a-f]*:\\(.*\\)$")
- (error "unrecognized line in MQ status file"))
- (push (match-string 1) patches)
- (forward-line 1))
- patches))
- nil))
-
-(defun mq-parse-guards-file (filename)
- "Parse the contents of the MQ guards file.
-The return value is a list of the selected guards, as symbols.
-If there is no 'guards' file, return nil."
- (if (file-exists-p filename)
- (with-temp-buffer
- (insert-file-contents filename)
- (goto-char (point-min))
- (let (guards)
- (while (< (point) (point-max))
- (let ((start (point)))
- (end-of-line)
- (let ((guard (intern (buffer-substring start (point)))))
- (push guard guards)
- (forward-line 1))))
- guards))
- nil))
-
-(defun mq-parse-guard-conditions ()
- "Parse the current patch's guard conditions.
-This assumes point is on the patch's line in the series file.
-The return value is a list (ANYPOS TABLE), where:
-- ANYPOS is true (non-nil) if there are any positive guard conditions, and
-- TABLE is a hash table mapping guard names (as interned symbols)
- to the symbols `+' (for positive guards) or `-' (for negative
- guards).
-For example, parsing the line:
-
- printer-param.patch #+foo-bar -baz -quux
-
-yields `(t TABLE)', where TABLE maps `foo-bar' to `+', and `baz' and
-`quux' to `-'."
- (let (any-positive
- (table (make-hash-table :test (function eq))))
- (save-excursion
- (end-of-line)
- (let ((end (point)))
- (beginning-of-line)
- (while (re-search-forward "#\\([-+]\\)\\([^#[:space:]]+\\)" end t)
- (let ((state (intern (match-string 1)))
- (guard (intern (match-string 2))))
- (puthash guard state table)
- (when (eq state '+)
- (setq any-positive t))))))
- (list any-positive table)))
-
-(defun mq-patch-enabled-p (guards conditions)
- "Return true if GUARDS satisfies CONDITIONS.
-GUARDS is a list of the currently selected guards, as interned symbols.
-CONDITIONS is a (ANYPOS . TABLE) list representing a set of guard
-conditions, of the type returned by mq-parse-guard-conditions.
-
-Mercurial seems to enable a patch if:
-- it has no negative conditions whose guards are selected, and
-- it has either:
- - no positive guard conditions, or
- - one of the positive conditions' guards is selected."
- (let ((anypos (car conditions))
- (table (cadr conditions))
- found-negative
- found-positive)
- (mapcar (lambda (g) (case (gethash g table)
- ((+) (setq found-positive t))
- ((-) (setq found-negative t))))
- guards)
- (and (not found-negative)
- (or (not anypos) found-positive))))
-
-(defun mq-all-condition-guards ()
- "Return a list of all guards mentioned in the current buffer's conditions.
-This scans the current buffer, presumed to be a series file, for
-guard conditions, and returns a list of all the guards mentioned,
-as symbols."
- (let ((guards (make-hash-table :test (function eq))))
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward "#[-+]\\([^#[:space:]]+\\)" nil t)
- (let ((guard (intern (match-string 1))))
- (puthash guard t guards))))
- (let (guard-list)
- (maphash (lambda (g v) (push g guard-list))
- guards)
- guard-list)))
-
-(defun mq-parse-series-line ()
- "Parse the current series file line, returning the patch name and conditions.
-The return value is nil if the current line contains no patch, or
-
- a list of the form (NAME CONDITIONS) where
-NAME is the name of the patch file, and CONDITIONS represents the
-guard conditions for enabling the patch. CONDITIONS is a value of
-the sort returned by mq-parse-guard-conditions."
- (save-excursion
- (beginning-of-line)
- (if (looking-at "[[:blank:]]*\\([^#[:space:]]+\\)")
- (list (match-string 1) (mq-parse-guard-conditions)))))
-
-(defun mq-shell-command (string &rest args)
- "Display and run the shell command COMMAND, in an appropriate directory.
-If the current default-directory is `ROOT/.hg/patches', then run
-the command with ROOT as its default directory. Otherwise, use
-default-directory unchanged."
- (let ((command (apply (function format) string args)))
- (message "Running command: %s" command)
- (let ((default-directory
- (or (mq-root-for-patch-directory default-directory)
- default-directory)))
- (shell-command command))))
-
-(defun mq-top-patch-name (root)
- "Return the name of the top patch, or nil if none are pushed."
- (car (mq-parse-status-file (mq-status-file-name root))))
-
-(defun mq-next-patch-name (root)
- "Return the name of the next patch to be applied, or nil if all are pushed."
- ;; If calling 'hg qnext' becomes a pain, we could probably emulate
- ;; this in lisp, as we do have the code to parse series lines and
- ;; evaluate guard conditions.
- (let ((output
- ;; hg qnext is unhelpful when run in a patches directory with its
- ;; own .hg subdirectory.
- (let ((default-directory root))
- (shell-command-to-string "hg qnext"))))
-
- ;; Omit any trailing newline.
- (if (string-equal (substring output -1) "\n")
- (setq output (substring output 0 -1)))
-
- ;; This is not great.
- (if (string-equal output "all patches applied")
- nil
- ;; Check that the output is a filename; otherwise, assume it's
- ;; an error message.
- (let ((patch-directory (mq-patch-directory-name root)))
- (unless (file-exists-p (expand-file-name output patch-directory))
- (error "hg qnext: %s" output))
- output))))
-
-(defun mq-suggest-unapplied-patch (root)
- "Choose a helpful default for prompts for the name of an unapplied patch.
-ROOT is the repository root of whose series the patch should be
-an unapplied member. We return the patch's file name relative to
-the patches directory.
-If the current buffer is a series-mode buffer, return the patch
-on the line containing point, if that patch is unapplied.
-If the current buffer is a diff-mode buffer visiting an unapplied
-patch in the patches directory, return its name.
-Otherwise, return nil."
- ;; I thought it would be nice to return the first unapplied patch if
- ;; neither of the above yield results, but 1) that might be slow,
- ;; and 2) if there isn't a likely choice, I'd rather not put
- ;; something in the minibuffer that people have to delete.
- (let (status
- (patch
- (or
- ;; If we're in a series-mode buffer, try to parse the
- ;; current line.
- (and (eq major-mode 'mq-series-mode)
- (let ((line (mq-parse-series-line)))
- ;; Use the status data we've already collected.
- (setq status mq-status)
- (car line)))
- ;; If we're in a diff-mode buffer, visiting a patch in our
- ;; patches directory, then use the buffer name.
- (and (eq major-mode 'diff-mode)
- buffer-file-name
- (let ((patch-directory (mq-patch-directory-name root)))
- (when (string-equal patch-directory
- (file-name-directory buffer-file-name))
- (file-name-nondirectory buffer-file-name)))))))
- (unless status
- (setq status (mq-parse-status-file (mq-status-file-name root))))
- (unless (member patch status)
- patch)))
-
-
-;;; Series Mode, for editing series files.
-
-;; Buffer-local variables.
-(defvar mq-patches-directory nil
- "Name of the patches directory for this series buffer.")
-
-(defvar mq-status-file-name nil
- "Name of the `status' file for this series buffer.")
-
-(defvar mq-guards-file-name nil
- "Name of the `guards' file for this series buffer.")
-
-(defvar mq-status nil
- "A list of the patches currently applied for this series buffer.
-More recently pushed patches appear earlier in the list.")
-
-(defvar mq-guards nil
- "The selected guards for this series buffer's queue.
-This is a list of symbols named after the guards.")
-
-(defvar mq-font-lock-keywords nil
- "A list of computed regular expressions for font-lock mode to highlight.
-These include selected guards, applied patches, and so on.
-The value of this variable changes as the user pushes and pops patches,
-changes the set of selected guards, and so forth. We abuse font-lock mode
-a little bit to make this work.")
-
-(defun mq-compute-font-lock ()
- "Compute the current buffer's font lock keywords, based on status and guards."
- (let (keywords)
- (mapc (lambda (patch)
- (let ((regexp (format "^\\s-*%s[# \t\n]" (regexp-quote patch))))
- (push `(,regexp . 'mq-applied-patch)
- keywords)))
- mq-status)
- (mapc (lambda (guard)
- (let* ((guard-regexp (regexp-quote (symbol-name guard)))
- (positive-regexp (concat "#\\+" guard-regexp))
- (negative-regexp (concat "#-" guard-regexp)))
- (push `(,positive-regexp . 'mq-condition-positive-selected)
- keywords)
- (push `(,negative-regexp . 'mq-condition-negative-selected)
- keywords)))
- mq-guards)
- (setq mq-font-lock-keywords (nreverse keywords))
- ;; Tell font-lock mode to recompute its regexps. This is kind of a kludge.
- (set (make-local-variable 'font-lock-set-defaults) nil)
- (font-lock-fontify-buffer)))
-
-(defun mq-refresh-status-and-guards ()
- "Reread the `status' and `guards' files for the current series buffer."
- (unless (eq major-mode 'mq-series-mode)
- (error "mq-refresh-status-and-guards should only run in a series buffer"))
- (setq mq-status (mq-parse-status-file mq-status-file-name))
- (setq mq-guards (mq-parse-guards-file mq-guards-file-name))
- (mq-compute-font-lock))
-
-(defun mq-series-mode ()
- "A major mode for working with Mercurial Queues patch series files.
-If the buffer visits a series file in the `.hg/patches' directory
-of a Mercurial repository, then the buffer's default directory is
-the top of that repository.
-
-The following commands are available in all buffers:
-
- \\[mq-qpush] Apply the next patch in the series (as by 'hg qpush').
- \\[mq-qpop] Un-apply the top patch in the series (as by 'hg qpop').
- \\[mq-qrefresh] Incorporate the current changes to the working files
- into the top patch (as by 'hg qrefresh').
- \\[mq-visit-top-patch] Visit the top patch file.
- \\[mq-visit-top-patch-other-window] Visit the top patch file in another window.
- \\[mq-visit-series] Visit the series file relevant to the current buffer in
- a Series Mode buffer.
- \\[mq-visit-series-other-window] As above, but visit the series file in another window.
- \\[mq-qnew] Insert a new patch in the series, on top of the current patch.
- \\[mq-show-top-next] Show the names of the top and next patches.
- \\[mq-qpop-all] Un-apply all patches (as by 'hg qpop -a').
- \\[mq-qpush-all] Apply all patches in the series (as by 'hg qpush -a').
-
-Visiting a series file in Series Mode provides highlighting
-showing the current state of the series, and special commands for
-editing series files.
-
-- Names of applied patches appear in bold (the `mq-applied-patch' face).
-
-- Positive guard conditions (`#+foo') whose guards are selected
- appear in green (the `mq-condition-positive-selected' face).
-
-- Negative guard conditions (`#-foo') whose guards are selected
- appear in red (the `mq-condition-negative-selected' face).
-
-The following commands are available in the series file:
-\\<mq-series-mode-map>
- \\[mq-go-to-patch] Push or pop patches as necessary to make the patch on the
- current line the top patch.
- \\[mq-find-patch] Visit the patch file on the current line.
- \\[mq-find-patch-other-window] Visit the patch file on the current line in another window.
- \\[mq-qfold] Incorporate the patch on the current line into the top patch.
-
-Here is a complete list of the bindings available in Series Mode:
-
-\\{mq-series-mode-map}"
- (interactive)
- (kill-all-local-variables)
- (setq major-mode 'mq-series-mode)
- (setq mode-name "Series")
- (use-local-map mq-series-mode-map)
-
- ;; The buffer-local variable mq-patches-directory is the directory
- ;; actually containing the series file, but for convenience we set
- ;; default-directory to the root of the repository.
- (set (make-local-variable 'mq-patches-directory) default-directory)
- (setq default-directory
- (or (mq-root-for-patch-directory default-directory)
- (mq-hg-root-directory)))
-
- (set (make-local-variable 'mq-status-file-name)
- (mq-status-file-name default-directory))
- (set (make-local-variable 'mq-guards-file-name)
- (mq-guards-file-name default-directory))
- (make-local-variable 'mq-status)
- (make-local-variable 'mq-guards)
- (make-local-variable 'mq-font-lock-keywords)
- (setq font-lock-defaults '(mq-font-lock-keywords))
- (mq-refresh-status-and-guards)
-
- (run-mode-hooks 'mq-series-mode-hook))
-
-(defalias 'series-mode 'mq-series-mode)
-
-(defvar mq-series-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-c\C-c" 'mq-go-to-patch)
- (define-key map "\C-c\C-f" 'mq-find-patch)
- (define-key map "\C-c\C-i" 'mq-qfold)
- (define-key map "\C-c4\C-f" 'mq-find-patch-other-window)
- map))
-
-(defun mq-refresh-buffers (root)
- "Revert all unmodified buffers visiting changed files in ROOT.
-Note that this also updates the contents of the `series' buffer, if it has
-changed."
- (let ((root-regexp (concat "\\`" (regexp-quote root))))
- (loop for buffer in (buffer-list)
- do (save-excursion
- (set-buffer buffer)
- (if (and (not (buffer-modified-p))
- buffer-file-name
- (string-match root-regexp buffer-file-name)
- (file-exists-p buffer-file-name)
- (not (verify-visited-file-modtime (current-buffer))))
- (revert-buffer t t))))))
-
-(defun mq-refresh ()
- "Refresh Emacs's state after pushing or popping patches.
-This reverts all unmodified buffers visiting files in the the
-current mercurial tree, if the visited file seems to have changed."
- (let ((root (mq-hg-root-directory)))
- (mq-refresh-buffers root)
- ;; The above will catch changes to the status file. But if the
- ;; operation changed the status or guard files without changing
- ;; the series file, we need to catch those explicitly.
- (let* ((series (mq-series-file-name root))
- (buffer (get-file-buffer series)))
- (when buffer
- (save-excursion
- (set-buffer buffer)
- (mq-refresh-status-and-guards))))))
-
-(defun mq-go-to-patch ()
- "Make the patch on the current line the top, by pushing or popping as needed."
- (interactive)
- (save-some-buffers)
- (let ((line (mq-parse-series-line)))
- (unless line
- (error "no patch name on current line"))
- (let ((patch (car line)))
- ;; If the patch is already the top one, say something helpful.
- (if (equal patch (car mq-status))
- (message "patch is already the top patch: %s" patch)
- ;; If the patch is currently applied, we assume we should pop.
- ;; Otherwise, we assume we should push.
- (let ((operation (if (member patch mq-status) "qpop" "qpush")))
- (mq-shell-command "hg %s '%s'" operation patch)
- (mq-refresh))))))
-
-(defun mq-find-patch ()
- "Visit the patch on the current line."
- (interactive)
- (let* ((root (mq-hg-root-directory))
- (patch-directory (mq-patch-directory-name root))
- (line (mq-parse-series-line))
- (patch (car line)))
- (unless line
- (error "no patch name on current line"))
- (find-file (expand-file-name patch patch-directory))))
-
-(defun mq-find-patch-other-window ()
- "Visit the patch on the current line in another window."
- (interactive)
- (let* ((root (mq-hg-root-directory))
- (patch-directory (mq-patch-directory-name root))
- (line (mq-parse-series-line))
- (patch (car line)))
- (unless line
- (error "no patch name on current line"))
- (find-file-other-window (expand-file-name patch patch-directory))))
-
-(defun mq-point-to-patch (patch)
- "Move point to the series buffer line for PATCH.
-If PATCH is nil, or there is no such patch, move to the top patch.
-If there is no applied patch, move point to the top of the buffer"
- (goto-char (point-min))
- (cond
- ((and patch
- (re-search-forward (format "^\\s-*%s\\([#[:space:]]\\|\\'\\)"
- (regexp-quote patch))
- nil t))
- (goto-char (match-beginning 0)))
- ((and mq-status
- (re-search-forward (format "^\\s-*%s\\([#[:space:]]\\|\\'\\)"
- (regexp-quote (car mq-status)))
- nil t))
- (goto-char (match-beginning 0)))
- (t (goto-char (point-min)))))
-
-
-;;; Global commands, available in all files.
-
-(defun mq-push-pop-command (command force)
- "Subroutine for Mercurial Queues push/pop commands.
-Check that the current buffer is visiting a file to which some
-queue applies; run the command `hg COMMAND'; and refresh Emacs's
-state (buffer contents, series file markup).
-If FORCE is non-nil, pass the `--force' flag to command as well."
- (mq-check-for-queue)
- (save-some-buffers)
- (when force (setq command (concat command " --force")))
- (mq-shell-command command)
- (mq-refresh))
-
-(defun mq-qpush ()
- "Apply the next patch in the current buffer's Mercurial Queues patch series."
- (interactive)
- (mq-push-pop-command "hg qpush" nil))
-
-(defun mq-qpush-all ()
- "Apply all patches in the current buffer's Mercurial Queues patch series."
- (interactive)
- (mq-push-pop-command "hg qpush -a" nil))
-
-(defun mq-qpop (force)
- "Un-apply the last applied patch in the current buffer's Mercurial patch series.
-With a prefix argument, pass the '--force' flag, to pop even if there are
-local changes."
- (interactive "P")
- (mq-push-pop-command "hg qpop" force))
-
-(defun mq-qpop-all (force)
- "Un-apply all patches in the current buffer's Mercurial Queues patch series.
-With a prefix argument, pass the '--force' flag, to pop even if there are
-local changes."
- (interactive "P")
- (mq-push-pop-command "hg qpop -a" force))
-
-(defun mq-qrefresh ()
- "Incorporate uncommitted changes into the top Mercurial Queues patch."
- (interactive)
- (mq-check-for-queue)
- (save-some-buffers)
- (mq-shell-command "hg qrefresh")
- ;; If we have a buffer visiting that patch, try to refresh it.
- (let* ((root (mq-hg-root-directory))
- (patch-directory (mq-patch-directory-name root))
- (status (mq-parse-status-file (mq-status-file-name root))))
- (unless status
- (error "No patch currently applied; cannot refresh."))
- (let* ((top (expand-file-name (mq-top-patch-name root) patch-directory))
- (buffer (get-file-buffer top)))
- (if buffer
- (save-excursion
- (set-buffer buffer)
- (if (and (not (buffer-modified-p))
- (not (verify-visited-file-modtime (current-buffer))))
- (revert-buffer t t)))))))
-
-(defun mq-qnew (name &optional force)
- "Insert a new patch into the current Mercurial Queues patch series.
-The new patch follows the current top in the series, and is initially empty.
-Normally, there must not be any uncommitted changes in the
-working directory. With a prefix argument, create a new patch
-anyway, incorporating all such changes."
- (interactive
- (let* ((root (mq-hg-root-directory))
- (patch-directory (mq-patch-directory-name root)))
- (list (read-file-name "New patch name: " patch-directory "" nil
- ".patch")
- current-prefix-arg)))
- (cond
- ((string-equal name "")
- (message "No name for new patch provided; no new patch created"))
- ((file-exists-p name)
- (error "Patch already exists: %s" name))
- (t
- (let* ((root (mq-hg-root-directory))
- (patch-directory (mq-patch-directory-name root))
- (relative-name (file-relative-name name patch-directory)))
- (mq-shell-command "hg qnew%s '%s'"
- (if force " -f" "")
- relative-name)
- (mq-refresh)))))
-
-(defun mq-visit-series (&optional finder)
- "Visit the series file for the current buffer's Mercurial Queues patch series.
-If FINDER is non-nil, use that as the function to use to visit the file."
- (interactive)
- (let* ((root (mq-hg-root-directory))
- (series (mq-series-file-name root))
- (move-to
- (if (and buffer-file-name
- (string-match ".*\\.hg/patches/\\'" default-directory))
- (file-name-nondirectory buffer-file-name))))
- (funcall (or finder 'find-file) series)
- (mq-point-to-patch move-to)))
-
-(defun mq-visit-series-other-window ()
- "Visit the Mercurial Queues series file for current buffer in another window."
- (interactive)
- (mq-visit-series 'find-file-other-window))
-
-(defun mq-visit-top-patch (&optional finder)
- "Visit the top applied patch in the current buffer's Mercurial Queue.
-If FINDER is non-nil, use that as the function to visit the file."
- (interactive)
- (mq-check-for-queue)
- (let* ((root (mq-hg-root-directory))
- (patch-directory (mq-patch-directory-name root))
- (status (mq-parse-status-file (mq-status-file-name root))))
- (unless status
- (error "No patches currently applied in this buffer's source tree."))
- (funcall (or finder 'find-file)
- (expand-file-name (car status) patch-directory))))
-
-(defun mq-visit-top-patch-other-window ()
- "Visit the top applied patch for the current buffer in another window."
- (interactive)
- (mq-visit-top-patch 'find-file-other-window))
-
-(defun mq-show-top-next ()
- "Show the names of the top and next patch for this buffer's Mercurial Queue."
- (interactive)
- (mq-check-for-queue)
- (let* ((root (mq-hg-root-directory))
- (top (mq-top-patch-name root))
- (next (mq-next-patch-name root)))
- (if (not (or top next))
- (message "no patches applied or enabled")
- (let ((top-message (if top (format "top: %s" top)
- "no patches applied"))
- (next-message (if next (format "next: %s" next)
- "all enabled patches applied")))
- (message "%s; %s" top-message next-message)))))
-
-(defun mq-qfold (patch delete)
- "Incorporate an unapplied patch into the top patch, as by `hg qfold'.
-With a prefix argument, delete the incorporated patch."
- (interactive
- (let* ((root (mq-hg-root-directory))
- (patch-directory (mq-patch-directory-name root))
- (suggested (mq-suggest-unapplied-patch root)))
- (list (let ((default-directory patch-directory))
- (file-relative-name
- (read-file-name "Fold patch into top: " nil suggested t
- suggested)))
- current-prefix-arg)))
- (mq-shell-command "hg qfold%s '%s'"
- (if delete "" " --keep")
- patch)
- (mq-refresh))
-
-
-;;; Global key bindings.
-
-(defvar mq-global-map
- (let ((map (make-keymap)))
- (define-key map "n" 'mq-qpush)
- (define-key map "p" 'mq-qpop)
- (define-key map "r" 'mq-qrefresh)
- (define-key map "s" 'mq-visit-series)
- (define-key map "t" 'mq-visit-top-patch)
- (define-key map "o" 'mq-qnew)
- (define-key map "=" 'mq-show-top-next)
- (define-key map "<" 'mq-qpop-all)
- (define-key map ">" 'mq-qpush-all)
- (define-key map "i" 'mq-qfold)
- map))
-
-(defvar mq-global-other-window-map
- (let ((map (make-keymap)))
- (define-key map "s" 'mq-visit-series-other-window)
- (define-key map "t" 'mq-visit-top-patch-other-window)
- map))
-
-(global-set-key "\C-xq" mq-global-map)
-(global-set-key "\C-x4q" mq-global-other-window-map)
-
-
-(provide 'mercurial-queues)
Please sign in to comment.
Something went wrong with that request. Please try again.