Skip to content

Instantly share code, notes, and snippets.

@pervognsen
Created Mar 11, 2010
Embed
What would you like to do?
(require 'cl)
(defmacro ignore-errors (error-symbols &rest body)
`(condition-case nil
(progn ,@body)
,@(loop for error-symbol in error-symbols
collect `(,error-symbol nil))))
(defmacro swap (x y)
(let ((temp (gensym)))
`(let ((,temp ,x))
(setq ,x ,y)
(setq ,y ,temp))))
(defun in-region-p (x lo hi)
(and (<= lo x) (< x hi)))
(defun swap-regions (startr1 endr1 startr2 endr2)
(let ((region2 (delete-and-extract-region startr2 endr2)))
(goto-char startr2)
(insert (delete-and-extract-region startr1 endr1))
(goto-char startr1)
(insert region2)))
(defun swap-regions-and-point (startr1 endr1 startr2 endr2)
(when (< startr2 startr1)
(swap startr1 startr2)
(swap endr1 endr2))
(let* ((offset (- (- endr2 startr2) (- endr1 startr1)))
(new-point (cond ((in-region-p (point) startr1 endr1) (+ startr2 (- (point) startr1) offset))
((in-region-p (point) startr2 endr2) (+ startr1 (- (point) startr2)))
(t (point)))))
(swap-regions startr1 endr1 startr2 endr2)
(goto-char new-point)))
(defmacro save-point (&rest body)
`(save-excursion ,@body (point)))
(defun drag (n next beginning end)
(swap-regions-and-point (save-point (funcall beginning))
(save-point (funcall end))
(save-point (funcall next n) (funcall beginning))
(save-point (funcall next n) (funcall end))))
(defun beginning-of (forward backward)
(let ((base-point (save-point (funcall backward) (funcall forward))))
(when (or (= base-point (save-point (funcall forward)))
(= base-point (point)))
(funcall backward))))
(defun end-of (forward backward)
(beginning-of backward forward))
(defun next-of (n forward beginning end)
(if (>= n 0)
(funcall forward (+ n (if (= (point) (save-point (funcall end))) 0 1)))
(funcall forward (- n (if (= (point) (save-point (funcall beginning))) 0 1))))
(funcall beginning))
(defmacro defdrag (name forward backward)
(let ((beginning-of-symbol (intern (concat "beginning-of-" (symbol-name name))))
(end-of-symbol (intern (concat "end-of-" (symbol-name name))))
(next-symbol (intern (concat "next-" (symbol-name name))))
(drag-symbol (intern (concat "drag-" (symbol-name name)))))
`(progn
(defun ,beginning-of-symbol ()
(interactive)
(beginning-of ,forward ,backward))
(defun ,end-of-symbol ()
(interactive)
(end-of ,forward ,backward))
(defun ,next-symbol (n)
(interactive "*p")
(next-of n ,forward ',beginning-of-symbol ',end-of-symbol))
(defun ,drag-symbol (n)
(interactive "*p")
(drag n ',next-symbol ',beginning-of-symbol ',end-of-symbol)))))
;; Default draggers
(defun drag-line (n)
(interactive "*p")
(drag n 'forward-line 'beginning-of-line 'end-of-line))
(defun drag-char (n)
(interactive "*p")
(drag n 'forward-char nil 'forward-char))
(defdrag word 'forward-word 'backward-word)
(defdrag sentence 'forward-sentence 'backward-sentence)
;; (defdrag paragraph
;; (lambda (&optional n)
;; (forward-paragraph (or n 1))
;; (when (save-excursion (re-search-forward paragraph-separate nil t))
;; (forward-char)))
;; (lambda (&optional n)
;; (backward-paragraph (or n 1))
;; (when (save-excursion (re-search-forward paragraph-separate nil t)
;; (backward-char)))))
(defdrag sexp
(lambda (&optional n)
(ignore-errors (scan-error)
(forward-sexp (or n 1))))
(lambda (&optional n)
(ignore-errors (scan-error)
(backward-sexp (or n 1)))))
;; Experiments
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment