Download
(eval-when-compile
(require 'cl))
(defvar trans-regions-recursive-editing-p nil)
(make-local-variable 'trans-regions-recursive-editing-p)
(defun trans-regions ()
"Transpose regions command."
(interactive)
(if (and (> (recursion-depth) 0)
trans-regions-recursive-editing-p)
(progn
(error "trans regions is in progress."))
(apply 'transpose-regions (trans-regions-read)))
(when (interactive-p)
(trans-regions-unhighlight)))
(defun trans-regions-select (msg)
(let ((orig-fmt mode-line-format))
(unwind-protect
(progn
(setq mode-line-format
(apply
'format "Select %s region. decide: \"%s\", abort: \"%s\""
msg
(loop for x in '(exit-recursive-edit abort-recursive-edit)
collect (substitute-command-keys
(format "\\[%s]" (symbol-name x))))))
(deactivate-mark)
(trans-regions-recursive-edit)
(list (region-beginning) (region-end)))
(setq mode-line-format orig-fmt))))
(defun trans-regions-read ()
(condition-case err
(append
(destructuring-bind (beg end)
(if (trans-regions-use-region-p)
(list (region-beginning) (region-end))
(trans-regions-select "first"))
(trans-regions-highlight beg end 'highlight))
(trans-regions-select "second"))
(quit (trans-regions-unhighlight)
(signal (car err) (cdr err)))))
(defun trans-regions-highlight (beg end face)
(let ((ovr (make-overlay beg end)))
(dolist (x `((trans-regions . t)
(face . ,face)
(evaporate . t)))
(overlay-put ovr (car x) (cdr x))))
(list beg end))
(defun trans-regions-unhighlight ()
(interactive)
(remove-overlays (point-min) (point-max) 'trans-regions t))
(defun trans-regions-recursive-edit ()
(setq trans-regions-recursive-editing-p t)
(unwind-protect
(recursive-edit)
(setq trans-regions-recursive-editing-p nil)))
(defun trans-regions-use-region-p ()
(and (and transient-mark-mode mark-active)
(> (region-end) (region-beginning))))
(provide 'trans-regions)