Function: transpose-subr

transpose-subr is a byte-compiled function defined in simple.el.gz.

Signature

(transpose-subr MOVER ARG &optional SPECIAL)

Documentation

Subroutine to do the work of transposing objects.

Works for lines, sentences, paragraphs, etc. MOVER is a function that moves forward by units of the given object (e.g. forward-sentence, forward-paragraph), or a function calculating a cons of buffer positions.

  If ARG is zero, exchanges the current object with the one
containing mark. If ARG is an integer, moves the current object past ARG following (if ARG is positive) or preceding (if ARG is negative) objects, leaving point after the current object.

Source Code

;; Defined in /usr/src/emacs/lisp/simple.el.gz
;; FIXME seems to leave point BEFORE the current object when ARG = 0,
;; which seems inconsistent with the ARG /= 0 case.
;; FIXME document SPECIAL.
(defun transpose-subr (mover arg &optional special)
  "Subroutine to do the work of transposing objects.
Works for lines, sentences, paragraphs, etc.  MOVER is a function
that moves forward by units of the given
object (e.g. `forward-sentence', `forward-paragraph'), or a
function calculating a cons of buffer positions.

  If ARG is zero, exchanges the current object with the one
containing mark.  If ARG is an integer, moves the current object
past ARG following (if ARG is positive) or preceding (if ARG is
negative) objects, leaving point after the current object."
  (let ((aux (if special mover
	       (lambda (x)
		 (cons (progn (funcall mover x) (point))
		       (progn (funcall mover (- x)) (point))))))
	pos1 pos2)
    (cond
     ((= arg 0)
      (save-excursion
	(setq pos1 (funcall aux 1))
	(goto-char (or (mark) (error "No mark set in this buffer")))
	(setq pos2 (funcall aux 1))
	(transpose-subr-1 pos1 pos2))
      (exchange-point-and-mark))
     ((> arg 0)
      (setq pos1 (funcall aux -1))
      (setq pos2 (funcall aux arg))
      (transpose-subr-1 pos1 pos2)
      (goto-char (car pos2)))
     (t
      (setq pos1 (funcall aux -1))
      (goto-char (car pos1))
      (setq pos2 (funcall aux arg))
      (transpose-subr-1 pos1 pos2)
      (goto-char (+ (car pos2) (- (cdr pos1) (car pos1))))))))