├── .gitignore ├── .travis.yml ├── Makefile ├── test-util.el ├── jagger.el ├── README.md ├── test-jagger-swap.el ├── jagger-sort.el ├── jagger-util.el ├── test-jagger-util.el ├── jagger-swap.el ├── test-jagger-move.el └── jagger-move.el /.gitignore: -------------------------------------------------------------------------------- 1 | *.elc 2 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: ruby 2 | 3 | cache: 4 | directories: 5 | - $HOME/.evm 6 | 7 | before_install: 8 | - (cd $HOME/.evm && git pull) || git clone https://github.com/rejeep/evm.git $HOME/.evm 9 | - export PATH=$HOME/.evm/bin:$PATH 10 | - evm config path /tmp 11 | - evm install $EVM_EMACS --use --skip 12 | 13 | env: 14 | - EVM_EMACS=emacs-24.4-travis 15 | - EVM_EMACS=emacs-24.5-travis 16 | - EVM_EMACS=emacs-25.1-travis 17 | - EVM_EMACS=emacs-25.2-travis 18 | - EVM_EMACS=emacs-25.3-travis 19 | - EVM_EMACS=emacs-26.1-travis 20 | #- EVM_EMACS=emacs-git-snapshot-travis 21 | 22 | matrix: 23 | allow_failures: 24 | - env: EVM_EMACS=emacs-git-snapshot-travis 25 | 26 | script: 27 | make 28 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | EMACS ?= emacs 2 | 3 | ELS = jagger-util.el \ 4 | jagger-swap.el \ 5 | jagger-move.el \ 6 | jagger-sort.el 7 | 8 | TEST_ELS = test-util.el \ 9 | test-jagger-util.el \ 10 | test-jagger-swap.el \ 11 | test-jagger-move.el 12 | 13 | # If the first argument is "test"... 14 | ifeq (test,$(firstword $(MAKECMDGOALS))) 15 | # use the rest as arguments for "test" 16 | SELECTOR := $(wordlist 2, $(words $(MAKECMDGOALS)), $(MAKECMDGOALS)) 17 | # ...and turn them into do-nothing targets 18 | $(eval $(SELECTOR):;@:) 19 | endif 20 | 21 | all: compile test 22 | 23 | compile: 24 | $(EMACS) -batch -L . -f batch-byte-compile $(ELS) 25 | 26 | test: 27 | ifeq ($(SELECTOR),) 28 | $(EMACS) -Q --batch -L . $(addprefix -l , $(ELS) $(TEST_ELS)) -f ert-run-tests-batch-and-exit 29 | else 30 | $(EMACS) -Q --batch -L . $(addprefix -l , $(ELS) $(TEST_ELS)) --eval "(ert-run-tests-batch-and-exit '$(SELECTOR))" 31 | endif 32 | 33 | help: 34 | @echo make 35 | @echo make compile 36 | @echo make test [SELECTOR] 37 | 38 | clean: 39 | @rm -f *.elc 40 | -------------------------------------------------------------------------------- /test-util.el: -------------------------------------------------------------------------------- 1 | ;;; test-util.el --- Util functions for testing -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2018 Gong QiJian 4 | 5 | ;; This program is free software; you can redistribute it and/or modify 6 | ;; it under the terms of the GNU General Public License as published by 7 | ;; the Free Software Foundation, either version 3 of the License, or 8 | ;; (at your option) any later version. 9 | 10 | ;; This program is distributed in the hope that it will be useful, 11 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ;; GNU General Public License for more details. 14 | 15 | ;; You should have received a copy of the GNU General Public License 16 | ;; along with this program. If not, see . 17 | 18 | ;;; Code: 19 | 20 | (defun push-mark@nomsg (fn &optional location nomsg activate) 21 | (funcall fn location t activate)) 22 | 23 | (advice-add 'push-mark :around 'push-mark@nomsg) 24 | 25 | (provide 'test-util) 26 | 27 | ;;; test-util.el ends here 28 | -------------------------------------------------------------------------------- /jagger.el: -------------------------------------------------------------------------------- 1 | ;;; jagger.el --- Move/swap things more convenient in Emacs -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2018 Gong QiJian 4 | 5 | ;; Author: Gong QiJian 6 | ;; Created: 2018/08/28 7 | ;; Version: 0.1.0 8 | ;; Package-Requires: ((emacs "24.4")) 9 | ;; URL: https://github.com/twlz0ne/jagger 10 | ;; Keywords: convenience editing 11 | 12 | ;; This program is free software; you can redistribute it and/or modify 13 | ;; it under the terms of the GNU General Public License as published by 14 | ;; the Free Software Foundation, either version 3 of the License, or 15 | ;; (at your option) any later version. 16 | 17 | ;; This program is distributed in the hope that it will be useful, 18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20 | ;; GNU General Public License for more details. 21 | 22 | ;; You should have received a copy of the GNU General Public License 23 | ;; along with this program. If not, see . 24 | 25 | ;;; Commentary: 26 | 27 | ;; This package provides some functions to make moving/swapping things 28 | ;; (including regions, sexps, lines, words) more convenient in Emacs. 29 | ;; 30 | ;; For a basic overview, see readme at 31 | ;; https://github.com/twlz0ne/jagger 32 | 33 | ;;; Change Log: 34 | 35 | ;; 0.1.0 2018/08/28 Initial version. 36 | 37 | ;;; Code: 38 | 39 | (defgroup jagger nil 40 | "Jagger settings." 41 | :group 'jagger) 42 | 43 | (require 'jagger-util) 44 | (require 'jagger-swap ) 45 | (require 'jagger-move ) 46 | (require 'jagger-sort) 47 | 48 | (provide 'jagger) 49 | 50 | ;;; jagger.el ends here 51 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | [![Build Status](https://travis-ci.com/twlz0ne/jagger.svg?branch=master)](https://travis-ci.com/twlz0ne/jagger) 2 | 3 | ## Jagger 4 | 5 | Move/swap things (including regions, sexps, lines, words) more conveniently in Emacs. 6 | 7 | ## Installation 8 | 9 | Copy file `jagger*.el` to directory `~/.emacs.d/site-lisp/jagger/`, for example, and add this to your .emacs 10 | 11 | ```elisp 12 | (add-to-list 'load-path (expand-file-name "~/.emacs.d/site-lisp/jagger")) 13 | (require 'jagger) 14 | ``` 15 | 16 | ## Usage 17 | 18 | ### Swap two regions (allow across buffers) 19 | 20 | - Select region1 21 | - `jagger-swap-regions-mark-region` set mark and highlight it with overlay 22 | - Select region2 23 | - `jagger-swap-regions` apply swap, clean overlay 24 | 25 | A more natural way is to mark regions automatically when yanking. There is an example for evil: 26 | 27 | ```elisp 28 | (defun evil-yank@set-mark (begin end &rest argv) 29 | (jagger-swap-regions-mark-region-1 begin end)) 30 | 31 | (advice-add 'evil-yank :before 'evil-yank@set-mark) 32 | (define-key evil-visual-state-map (kbd "M-p") 'jagger-swap-regions) 33 | ``` 34 | 35 | Then you can use it like this: 36 | 37 | - `y` yank region1 as usual, there is no highlight 38 | - Select region2 39 | - `M-p` to apply swap 40 | 41 | ### Swap things (sexps/words/lines) around point 42 | 43 | ``` 44 | (foo| bar) -> (|bar foo) ;; jagger-swap-sexps 45 | ``` 46 | 47 | ### Swap things (sexps/words/lines) surround region 48 | 49 | ``` 50 | (foo [(qux "quux")] bar) -> (bar (qux "quux")| foo) ;; jagger-swap-sexps 51 | ``` 52 | 53 | ### Move things at point backward/forward 54 | 55 | ``` 56 | (|foo bar) -> (bar |foo) ;; jagger-move-sexp-forward 57 | ``` 58 | 59 | ### Move sexp backward/forward 60 | 61 | ``` 62 | ([foo] (qux "quux") bar) -> ((qux "quux") [foo] bar) ;; jagger-move-sexp-forward 63 | ([foo (qux "quux")] bar) -> (bar [foo (qux "quux")]) 64 | ``` 65 | 66 | ### Move line up/down 67 | 68 | ``` 69 | |foo => bar ;; jagger-move-line-down 70 | bar |foo 71 | ``` 72 | 73 | ### Move region up/down 74 | 75 | ``` 76 | [foo qux ;; jagger-move-line-down 77 | bar] => [foo 78 | qux bar] 79 | ``` 80 | 81 | ### Sort sexps at point in temp buffer 82 | 83 | Original bffer: 84 | 85 | ``` 86 | (foo (qux "quux") bar) 87 | ``` 88 | 89 | `M-x jagger-sort-sexps-at-point-in-temp-buffer` switch to temp buffer in other window: 90 | 91 | ``` 92 | foo (qux "quux") ;; M-j/k to move one line at point \ 93 | (qux "quux") => bar ;; or multiple lines in region \down/down 94 | bar foo 95 | ``` 96 | 97 | `C-c C-c` commit changes to original buffer: 98 | 99 | ``` 100 | ((qux "quux") bar foo) 101 | ``` 102 | 103 | or `C-c C-k` discard changes. 104 | -------------------------------------------------------------------------------- /test-jagger-swap.el: -------------------------------------------------------------------------------- 1 | ;;; test-jagger-swap.el --- tests of jagger-swap -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2018 Gong QiJian 4 | 5 | ;; This program is free software; you can redistribute it and/or modify 6 | ;; it under the terms of the GNU General Public License as published by 7 | ;; the Free Software Foundation, either version 3 of the License, or 8 | ;; (at your option) any later version. 9 | 10 | ;; This program is distributed in the hope that it will be useful, 11 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ;; GNU General Public License for more details. 14 | 15 | ;; You should have received a copy of the GNU General Public License 16 | ;; along with this program. If not, see . 17 | 18 | ;;; Code: 19 | 20 | (require 'ert) 21 | (require 'jagger-swap) 22 | (require 'test-util) 23 | 24 | (defun test-jagger-swap-regions--set-mark (buffer content mark-fn &optional erase-p) 25 | "Fill `BUFFER' with `CONTENT' and call `MARK-FN' to set mark. 26 | The `CONTENT' must contain a string surround by `[]', example: 27 | 28 | [foo] bar 29 | 30 | If ERASE-P not nil, erase the buffer." 31 | (with-current-buffer (get-buffer-create buffer) 32 | (if erase-p 33 | (erase-buffer) 34 | (goto-char (point-max))) 35 | ;; (when (region-active-p) 36 | (deactivate-mark) 37 | ;; ) 38 | (insert content) 39 | (goto-char (point-min)) 40 | (re-search-forward "\\[\\([^]]+\\)\\]" nil t 1) 41 | (replace-match (format "%s" (match-string 1))) 42 | (goto-char (match-beginning 0)) 43 | (set-mark (match-end 0)) 44 | (when noninteractive 45 | (transient-mark-mode)) ;; MUST 46 | (funcall mark-fn) 47 | )) 48 | 49 | (ert-deftest test-jagger-swap-regions () 50 | (test-jagger-swap-regions--set-mark "buf0" "[foo] " 'jagger-swap-regions-mark-region t) 51 | (test-jagger-swap-regions--set-mark "buf0" "[bar]" 'jagger-swap-regions) 52 | (should 53 | (equal "bar foo" (with-current-buffer "buf0" (buffer-string))))) 54 | 55 | (ert-deftest test-jagger-swap-regions-cross-buffer () 56 | (test-jagger-swap-regions--set-mark "buf1" "foo [bar]" 'jagger-swap-regions-mark-region t) 57 | (test-jagger-swap-regions--set-mark "buf2" "[foo] bar" 'jagger-swap-regions t) 58 | (should 59 | (and (equal "foo foo" (with-current-buffer "buf1" (buffer-string))) 60 | (equal "bar bar" (with-current-buffer "buf2" (buffer-string)))))) 61 | 62 | (defun test-jagger-sort-sexps-at-point--common (init-data expected-data stop-at-pattern line-down-n) 63 | "Common code of test jagger-sort-sexps-at-point-in-temp-buffer. 64 | INIT-DATA EXPECTED-DATA STOP-AT-PATTERN LINE-DOWN-N." 65 | (with-current-buffer (get-buffer-create "*.el") 66 | (erase-buffer) 67 | (insert init-data) 68 | (lisp-mode) 69 | (goto-char (point-min)) 70 | (re-search-forward stop-at-pattern) 71 | (jagger-sort-sexps-at-point-in-temp-buffer) 72 | (jagger-move-line-down line-down-n) 73 | (jagger-sort-sexps-at-point--edit-commit)) 74 | (with-current-buffer (get-buffer "*.el") 75 | (let ((actual (replace-regexp-in-string "\n[\s]+" " " (buffer-substring-no-properties (point-min) (point-max))))) 76 | (should (equal actual expected-data))))) 77 | 78 | (ert-deftest test-jagger-sort-sexps-at-point-1 () 79 | (test-jagger-sort-sexps-at-point--common 80 | "(foo (qux 81 | \"quux\") 82 | bar)" 83 | "((qux \"quux\") bar foo)" 84 | "bar" 85 | 2)) 86 | 87 | (ert-deftest test-jagger-sort-sexps-at-point-2 () 88 | (test-jagger-sort-sexps-at-point--common 89 | "(foo (qux 90 | \"quux\") 91 | bar)" 92 | "(foo (\"quux\" qux) bar)" 93 | "quux" 94 | 1)) 95 | 96 | (provide 'test-jagger-swap) 97 | 98 | ;;; test-jagger-swap.el ends here 99 | -------------------------------------------------------------------------------- /jagger-sort.el: -------------------------------------------------------------------------------- 1 | ;;; jagger-sort.el --- Sorting mode -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2018 Gong QiJian 4 | 5 | ;; Author: Gong QiJian 6 | ;; Created: 2018/08/28 7 | ;; Version: 0.1.0 8 | ;; Package-Requires: ((emacs "24.4")) 9 | ;; URL: https://github.com/twlz0ne/jagger 10 | ;; Keywords: convenience editing 11 | 12 | ;; This program is free software; you can redistribute it and/or modify 13 | ;; it under the terms of the GNU General Public License as published by 14 | ;; the Free Software Foundation, either version 3 of the License, or 15 | ;; (at your option) any later version. 16 | 17 | ;; This program is distributed in the hope that it will be useful, 18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20 | ;; GNU General Public License for more details. 21 | 22 | ;; You should have received a copy of the GNU General Public License 23 | ;; along with this program. If not, see . 24 | 25 | ;;; Code: 26 | 27 | (require 'jagger-util) 28 | 29 | (defcustom jagger-sort-mode-hook nil 30 | "Hooks called when jagger-sort-mode fires up." 31 | :type 'hook 32 | :group 'swap-temp) 33 | 34 | (defvar jagger-sort-mode--line-mark nil) 35 | 36 | (defvar jagger-sort-mode-map 37 | (let ((map (make-sparse-keymap))) 38 | (define-key map (kbd "M-j") 'jagger-move-line-down) 39 | (define-key map (kbd "M-k") 'jagger-move-line-up) 40 | (define-key map (kbd "C-c C-c") 'jagger-sort-sexps-at-point--edit-commit) 41 | (define-key map (kbd "C-c C-k") 'kill-buffer-and-window) 42 | map) 43 | "Keymap for `jagger-sort-mode'.") 44 | 45 | (defun jagger-sort-mode--move-down () 46 | (interactive) 47 | (if (region-active-p) 48 | (message "move %S to %S" 49 | (cons (region-beginning) (region-end)) 50 | (jagger-util--bounds-of-forward-thing 'line) 51 | ))) 52 | 53 | (define-derived-mode jagger-sort-mode fundamental-mode "SwapSort" 54 | "Major mode for reorder swap items.\\{jagger-sort-map}" 55 | (setq jagger-sort-mode--line-mark nil)) 56 | 57 | (defvar jagger-sort--lines-and-sexps '()) 58 | 59 | (defvar jagger-sort--bounds-and-sexps '()) 60 | 61 | (defvar jagger-sort-sexps-at-point--temp-buffer nil) 62 | 63 | (defun jagger-sort-sexps-at-point--edit-commit () 64 | (interactive) 65 | (let* ((buf (buffer-substring-no-properties (point-min) (point-max))) 66 | (sorted-lines (reverse (split-string buf "\n")))) 67 | (pop sorted-lines) ;; drop empty element 68 | (with-current-buffer (get-buffer jagger-sort-sexps-at-point--temp-buffer) 69 | (let ((sorted-sexps 70 | (mapcar (lambda (line) (assoc line jagger-sort--lines-and-sexps)) sorted-lines))) 71 | (mapc (lambda (bound-sexp) 72 | (let ((bound (car bound-sexp)) 73 | (sexp (pop sorted-sexps))) 74 | (delete-region (car bound) (cdr bound)) 75 | (goto-char (car bound)) 76 | (insert (car sexp)))) 77 | (reverse jagger-sort--bounds-and-sexps)))) 78 | (kill-buffer-and-window))) 79 | 80 | (defun jagger-sort-sexps-at-point-in-temp-buffer () 81 | "Sort sexps in current list or region." 82 | (interactive) 83 | (let* ((tmpbuf "*Swap sexps*") 84 | (bounds-sexps (jagger-util--bounds-and-sexps-at-point)) 85 | (lines-sexps (mapcar 86 | (lambda (bound-sexp) 87 | (let ((sexp (cdr bound-sexp))) 88 | (cons (replace-regexp-in-string "\n[\s]+" " " (format "%s" sexp)) 89 | sexp))) 90 | bounds-sexps))) 91 | (setq jagger-sort--lines-and-sexps lines-sexps) 92 | (setq jagger-sort--bounds-and-sexps bounds-sexps) 93 | (setq jagger-sort-sexps-at-point--temp-buffer (current-buffer)) 94 | (with-current-buffer (get-buffer-create tmpbuf) 95 | (erase-buffer) 96 | (add-hook 97 | 'jagger-sort-mode-hook 98 | (lambda () 99 | (setq header-line-format 100 | (substitute-command-keys 101 | "Edit, then exit with `\\[jagger-sort-sexps-at-point--edit-commit]' or abort with `\\[kill-buffer-and-window]'") ))) 102 | (jagger-sort-mode) 103 | (mapc (lambda (line-sexp) 104 | (insert (format "%s\n" (car line-sexp)))) 105 | jagger-sort--lines-and-sexps) 106 | (goto-char (point-min))) 107 | (switch-to-buffer-other-window tmpbuf) 108 | )) 109 | 110 | (provide 'jagger-sort) 111 | 112 | ;;; jagger-sort.el ends here 113 | -------------------------------------------------------------------------------- /jagger-util.el: -------------------------------------------------------------------------------- 1 | ;;; jagger-util.el --- Util functions -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2018 Gong QiJian 4 | 5 | ;; Author: Gong QiJian 6 | ;; Created: 2018/08/28 7 | ;; Version: 0.1.0 8 | ;; Package-Requires: ((emacs "24.4")) 9 | ;; URL: https://github.com/twlz0ne/jagger 10 | ;; Keywords: convenience editing 11 | 12 | ;; This program is free software; you can redistribute it and/or modify 13 | ;; it under the terms of the GNU General Public License as published by 14 | ;; the Free Software Foundation, either version 3 of the License, or 15 | ;; (at your option) any later version. 16 | 17 | ;; This program is distributed in the hope that it will be useful, 18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20 | ;; GNU General Public License for more details. 21 | 22 | ;; You should have received a copy of the GNU General Public License 23 | ;; along with this program. If not, see . 24 | 25 | ;;; Code: 26 | 27 | (if (featurep 'subr-x) 28 | (require 'subr-x)) 29 | 30 | (defun backward-line () 31 | (forward-line -1)) 32 | 33 | (defun bounds-of-list-at-point () 34 | "Return the bounds of the list at point." 35 | (if (version<= "26.1" emacs-version) 36 | (funcall (get 'list 'bounds-of-thing-at-point)) 37 | (save-excursion 38 | (let* ((st (parse-partial-sexp (point-min) (point))) 39 | (beg (or (and (eq 4 (car (syntax-after (point)))) 40 | (not (nth 8 st)) 41 | (point)) 42 | (nth 1 st)))) 43 | (when beg 44 | (goto-char beg) 45 | (forward-sexp) 46 | (cons beg (point))))))) 47 | 48 | (unless (fboundp 'string-trim-left) 49 | (defsubst string-trim-left (string &optional regexp) 50 | "Trim STRING of leading string matching REGEXP. 51 | 52 | REGEXP defaults to \"[ \\t\\n\\r]+\"." 53 | (if (string-match (concat "\\`\\(?:" (or regexp "[ \t\n\r]+") "\\)") string) 54 | (substring string (match-end 0)) 55 | string))) 56 | 57 | (unless (fboundp 'string-trim-right) 58 | (defsubst string-trim-right (string &optional regexp) 59 | "Trim STRING of trailing string matching REGEXP. 60 | 61 | REGEXP defaults to \"[ \\t\\n\\r]+\"." 62 | (let ((i (string-match-p (concat "\\(?:" (or regexp "[ \t\n\r]+") "\\)\\'") 63 | string))) 64 | (if i (substring string 0 i) string)))) 65 | 66 | (defun jagger-util--bounds-of-thing-at-point (thing) 67 | "Determine the start and end buffer locations for the THING at point." 68 | (if (region-active-p) 69 | (cons (region-beginning) (region-end)) 70 | (let ((bounds (bounds-of-thing-at-point thing))) 71 | (if (and (eq thing 'line) 72 | (eq (char-before (cdr bounds)) 10)) 73 | (cons (car bounds) (1- (cdr bounds))) 74 | bounds)))) 75 | 76 | (defun jagger-util--bounds-of-forward-thing (thing &optional start) 77 | "Bound of forward `THING' at point or `START'." 78 | (if (eq thing 'line) 79 | (save-excursion 80 | (when start 81 | (goto-char start)) 82 | (when (= 0 (forward-line)) 83 | (cons (point-at-bol) (point-at-eol)))) 84 | (let ((forwardfn (intern (format "forward-%s" thing))) 85 | (backwardfn (intern (format "backward-%s" thing)))) 86 | (save-excursion 87 | (when start 88 | (goto-char start)) 89 | (funcall forwardfn) 90 | (cons (save-excursion 91 | (funcall backwardfn) 92 | (point)) 93 | (point)))))) 94 | 95 | (defun jagger-util--bounds-of-backward-thing (thing &optional start) 96 | "Bound of backward `THING' at point or `START'." 97 | (if (eq thing 'line) 98 | (save-excursion 99 | (when start 100 | (goto-char start)) 101 | (when (= 0 (backward-line)) 102 | (cons (point-at-bol) (point-at-eol)))) 103 | (let ((forwardfn (intern (format "forward-%s" thing))) 104 | (backwardfn (intern (format "backward-%s" thing)))) 105 | (save-excursion 106 | (when start 107 | (goto-char start)) 108 | (funcall backwardfn) 109 | (cons (point) 110 | (save-excursion 111 | (funcall forwardfn) 112 | (point))))))) 113 | 114 | (defun jagger-util--bounds-and-sexps-at-point () 115 | "Bounds of sexps at point." 116 | (let ((list-bound (bounds-of-list-at-point)) 117 | (bounds-sexps '())) 118 | (save-excursion 119 | (goto-char (cdr list-bound)) 120 | (down-list -1) 121 | (catch 'break 122 | (while t 123 | (condition-case err 124 | (backward-sexp) 125 | (error 126 | (pcase err 127 | (`(scan-error "Containing expression ends prematurely" . ,_) 128 | (throw 'break nil))))) 129 | (let ((bound (bounds-of-thing-at-point 'sexp)) 130 | (sexp (thing-at-point 'sexp t))) 131 | (push (cons bound sexp) bounds-sexps))))) 132 | bounds-sexps)) 133 | 134 | (defun jagger-util--region-overlapped-p (reg1 reg2) 135 | "Determine if REG1 overlapped with REG2." 136 | (let ((beg1 (car reg1)) 137 | (end1 (cdr reg1)) 138 | (beg2 (car reg2)) 139 | (end2 (cdr reg2))) 140 | (not (or (and (<= end1 beg2) (<= end1 end2)) ;; (beg1 . end1) vs (beg2 . end2) 141 | (and (<= end2 beg1) (<= end2 end1)) ;; (beg2 . end2) vs (beg1 . end1) 142 | )))) 143 | 144 | (provide 'jagger-util) 145 | 146 | ;;; jagger-util.el ends here 147 | -------------------------------------------------------------------------------- /test-jagger-util.el: -------------------------------------------------------------------------------- 1 | ;;; test-jagger-util.el --- Test jagger-util -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2018 Gong QiJian 4 | 5 | ;; This program is free software; you can redistribute it and/or modify 6 | ;; it under the terms of the GNU General Public License as published by 7 | ;; the Free Software Foundation, either version 3 of the License, or 8 | ;; (at your option) any later version. 9 | 10 | ;; This program is distributed in the hope that it will be useful, 11 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ;; GNU General Public License for more details. 14 | 15 | ;; You should have received a copy of the GNU General Public License 16 | ;; along with this program. If not, see . 17 | 18 | ;;; Code: 19 | 20 | (require 'ert) 21 | (require 'jagger-util) 22 | (require 'test-util) 23 | 24 | (ert-deftest test-jagger-util--bounds-of-thing-at-point--line-1 () 25 | (with-temp-buffer 26 | ;; 12344567889012 27 | ;; [ ]| 28 | (insert "foo\nbar\nquux") 29 | (goto-char 0) 30 | (should 31 | (equal (jagger-util--bounds-of-thing-at-point 'line) 32 | (cons 1 4))))) 33 | 34 | (ert-deftest test-jagger-util--bounds-of-thing-at-point--line-2 () 35 | (with-temp-buffer 36 | ;; 12344567889012 37 | ;; [ ]| 38 | (insert "foo\nbar\nquux") 39 | (goto-char 5) 40 | (should 41 | (equal (jagger-util--bounds-of-thing-at-point 'line) 42 | (cons 5 8))))) 43 | 44 | (ert-deftest test-jagger-util--bounds-of-thing-at-point--line-n () 45 | (with-temp-buffer 46 | ;; 123445678890123 47 | ;; [ ]| 48 | (insert "foo\nbar\nquux") 49 | (goto-char 9) 50 | (should 51 | (equal (jagger-util--bounds-of-thing-at-point 'line) 52 | (cons 9 13))))) 53 | 54 | (defun test-jagger-util--bounds-of-line-at-point--with-region--common 55 | (initial expected region-pattern fn) 56 | (with-temp-buffer 57 | (insert initial) 58 | (goto-char (point-min)) 59 | (re-search-forward region-pattern) 60 | (when noninteractive 61 | (transient-mark-mode)) ;; MUST 62 | (set-mark (- (point) (length region-pattern))) 63 | (should 64 | (equal expected 65 | (funcall fn 'line (if (eq fn 'jagger-util--bounds-of-forward-thing) 66 | (region-end) 67 | (region-beginning))))))) 68 | 69 | (ert-deftest test-jagger-util--bounds-of-thing-at-point--line-with-region-1 () 70 | ;; backward 71 | 72 | (test-jagger-util--bounds-of-line-at-point--with-region--common 73 | ;;234566789012345677890123 74 | "(foo)\n(qux quux)\n(bar)" 75 | (cons 1 6) 76 | "(qux quux)\n(bar)" 77 | 'jagger-util--bounds-of-backward-thing) 78 | 79 | (test-jagger-util--bounds-of-line-at-point--with-region--common 80 | ;;234566789012345677890123 81 | "(foo)\n(qux quux)\n(bar)\n" 82 | (cons 1 6) 83 | "(qux quux)\n(bar)\n" 84 | 'jagger-util--bounds-of-backward-thing) 85 | 86 | (test-jagger-util--bounds-of-line-at-point--with-region--common 87 | ;;234566789012345677890123 88 | "(foo)\n(qux quux)\n(bar)" 89 | nil 90 | "(foo)\n(qux quux)\n(bar)" 91 | 'jagger-util--bounds-of-backward-thing) 92 | 93 | ;; forward 94 | 95 | (test-jagger-util--bounds-of-line-at-point--with-region--common 96 | ;;234566789012345677890123 97 | "(foo)\n(qux quux)\n(bar)" 98 | (cons 18 23) 99 | "(foo)\n(qux quux)" 100 | 'jagger-util--bounds-of-forward-thing) 101 | 102 | (test-jagger-util--bounds-of-line-at-point--with-region--common 103 | ;;234566789012345677890123 104 | "(foo)\n(qux quux)\n(bar)" 105 | (cons 18 23) 106 | "(foo)\n(qux quux)\n" 107 | 'jagger-util--bounds-of-forward-thing) 108 | 109 | (test-jagger-util--bounds-of-line-at-point--with-region--common 110 | ;;234566789012345677890123 111 | "(foo)\n(qux quux)\n(bar)" 112 | nil 113 | "(foo)\n(qux quux)\n(bar)" 114 | 'jagger-util--bounds-of-forward-thing)) 115 | 116 | (ert-deftest test-jagger-util--bounds-and-sexps-at-point-1 () 117 | (with-temp-buffer 118 | ;; 123456789012345678901234567 119 | ;; [ ][ ][ ] 120 | (insert "(foo (abc def ghi jkl) bar)") 121 | (lisp-mode) 122 | (goto-char (point-min)) 123 | (re-search-forward "bar") 124 | (should 125 | (equal (jagger-util--bounds-and-sexps-at-point) 126 | '(((2 . 5) . "foo") ((6 . 23) . "(abc def ghi jkl)") ((24 . 27) . "bar")))))) 127 | 128 | (ert-deftest test-jagger-util--bounds-and-sexps-at-point-2 () 129 | (with-temp-buffer 130 | ;; 1234567890123456789012 131 | ;; [ ][ ][ ][ ] 132 | (insert "(foo (abc def ghi jkl) bar)") 133 | (lisp-mode) 134 | (goto-char (point-min)) 135 | (re-search-forward "ghi") 136 | (should 137 | (equal (jagger-util--bounds-and-sexps-at-point) 138 | '(((7 . 10) . "abc") ((11 . 14) . "def") ((15 . 18) . "ghi") ((19 . 22) . "jkl")))))) 139 | 140 | (ert-deftest tset-jagger-util--region-overlapped-p () 141 | (should-not (jagger-util--region-overlapped-p '(1 . 2) '(3 . 4))) 142 | (should-not (jagger-util--region-overlapped-p '(3 . 4) '(1 . 2))) 143 | 144 | (should-not (jagger-util--region-overlapped-p '(1 . 2) '(2 . 4))) 145 | (should-not (jagger-util--region-overlapped-p '(2 . 4) '(1 . 2))) 146 | 147 | (should-not (jagger-util--region-overlapped-p '(1 . 4) '(4 . 4))) 148 | (should-not (jagger-util--region-overlapped-p '(4 . 4) '(1 . 4))) 149 | 150 | (should-not (jagger-util--region-overlapped-p '(1 . 1) '(1 . 4))) 151 | (should-not (jagger-util--region-overlapped-p '(1 . 4) '(1 . 1))) 152 | 153 | (should (jagger-util--region-overlapped-p '(1 . 3) '(2 . 4))) 154 | (should (jagger-util--region-overlapped-p '(2 . 4) '(1 . 3))) 155 | 156 | (should (jagger-util--region-overlapped-p '(1 . 4) '(2 . 3))) 157 | (should (jagger-util--region-overlapped-p '(2 . 3) '(1 . 4))) 158 | 159 | (should (jagger-util--region-overlapped-p '(1 . 4) '(2 . 4))) 160 | (should (jagger-util--region-overlapped-p '(2 . 4) '(1 . 4))) 161 | 162 | (should (jagger-util--region-overlapped-p '(1 . 4) '(1 . 4))) 163 | (should (jagger-util--region-overlapped-p '(1 . 4) '(1 . 4)))) 164 | 165 | (provide 'test-jagger-util) 166 | 167 | ;;; test-jagger-util.el ends here 168 | -------------------------------------------------------------------------------- /jagger-swap.el: -------------------------------------------------------------------------------- 1 | ;;; jagger-swap.el --- Swapping functions -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2018 Gong QiJian 4 | 5 | ;; Author: Gong QiJian 6 | ;; Created: 2018/08/28 7 | ;; Version: 0.1.0 8 | ;; Package-Requires: ((emacs "24.4")) 9 | ;; URL: https://github.com/twlz0ne/jagger 10 | ;; Keywords: convenience editing 11 | 12 | ;; This program is free software; you can redistribute it and/or modify 13 | ;; it under the terms of the GNU General Public License as published by 14 | ;; the Free Software Foundation, either version 3 of the License, or 15 | ;; (at your option) any later version. 16 | 17 | ;; This program is distributed in the hope that it will be useful, 18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20 | ;; GNU General Public License for more details. 21 | 22 | ;; You should have received a copy of the GNU General Public License 23 | ;; along with this program. If not, see . 24 | 25 | ;;; Code: 26 | 27 | (require 'jagger-util) 28 | 29 | (defvar jagger-swap-regions-mark-face '(:inherit isearch) "Face of marked region.") 30 | 31 | (defvar jagger-swap-regions--marks '() "Region mark list.") 32 | 33 | (defun jagger-swap-regions--make-overlay (begin end &optional highlight-p) 34 | "Make overlay of region from `BEGIN' to `END'. 35 | If `HIGHLIGHT-P' not nil, the region needs to be highlighted." 36 | (interactive "r") 37 | (let ((ov (make-overlay begin end nil nil t))) 38 | (when highlight-p 39 | (overlay-put ov 'face jagger-swap-regions-mark-face)) 40 | ov)) 41 | 42 | (defun jagger-swap-regions--marked-content (mark) 43 | "Return no properties content from `MARK'." 44 | (let* ((begin (overlay-start (cdr mark))) 45 | (end (overlay-end (cdr mark)))) 46 | (with-current-buffer (car mark) (buffer-substring-no-properties begin end)))) 47 | 48 | (defun jagger-swap-regions--swap (mark-A mark-B) 49 | "Swap region `MARK-A' with region `MARK-B'." 50 | (save-excursion 51 | (let* ((A-begin (overlay-start (cdr mark-A))) 52 | (A-end (overlay-end (cdr mark-A))) 53 | (A-str (with-current-buffer (car mark-A) (buffer-substring-no-properties A-begin A-end))) 54 | (B-begin (overlay-start (cdr mark-B))) 55 | (B-end (overlay-end (cdr mark-B))) 56 | (B-str (with-current-buffer (car mark-B) (buffer-substring-no-properties B-begin B-end)))) 57 | (with-current-buffer (car mark-B) 58 | (delete-region B-begin B-end) 59 | (goto-char B-begin) 60 | (insert A-str)) 61 | (with-current-buffer (car mark-A) 62 | (delete-region A-begin A-end) 63 | (goto-char A-begin) 64 | (insert B-str))))) 65 | 66 | (defun jagger-swap-regions-clean-marks () 67 | "Clean all marsk." 68 | (interactive) 69 | (while (car jagger-swap-regions--marks) 70 | (delete-overlay (cdr (pop jagger-swap-regions--marks))))) 71 | 72 | (defun jagger-swap-regions-mark-region-1 (reg-begin reg-end &optional highlight-p) 73 | "Mark region from `REG-BEGIN' to `REG-END' as the first mark. 74 | If `HIGHLIGHT-P' not nil, the region needs to be highlighted." 75 | (jagger-swap-regions-clean-marks) 76 | (let* ((ov (jagger-swap-regions--make-overlay reg-begin reg-end highlight-p)) 77 | (mk (cons (buffer-name) ov))) 78 | (push mk jagger-swap-regions--marks) 79 | mk)) 80 | 81 | (defun jagger-swap-regions-mark-region-n (reg-begin reg-end &optional highlight-p) 82 | (let* ((ov (jagger-swap-regions--make-overlay reg-begin reg-end highlight-p)) 83 | (mk (cons (buffer-name) ov))) 84 | (push mk jagger-swap-regions--marks) 85 | mk)) 86 | 87 | (defun jagger-swap-regions-append-mark () 88 | "Add current region to mark list." 89 | (interactive) 90 | (when (region-active-p) 91 | (jagger-swap-regions-mark-region-n (region-beginning) (region-end) t) 92 | (deactivate-mark))) 93 | 94 | (defun jagger-swap-regions-mark-region () 95 | "Set current region as the first mark." 96 | (interactive) 97 | (when (region-active-p) 98 | (jagger-swap-regions-mark-region-1 (region-beginning) (region-end) t) 99 | (deactivate-mark))) 100 | 101 | (defun jagger-swap-regions () 102 | "Swap current region with latest." 103 | (interactive) 104 | (when (region-active-p) 105 | (let* ((mark-A (car jagger-swap-regions--marks))) 106 | (when mark-A 107 | (let* ((ovl-B (jagger-swap-regions--make-overlay (region-beginning) (region-end))) 108 | (ovl-B-begin (overlay-start ovl-B)) 109 | (ovl-B-end (overlay-end ovl-B)) 110 | (ovl-A (cdr mark-A)) 111 | (ovl-A-begin (overlay-start ovl-A)) 112 | (ovl-A-end (overlay-end ovl-A)) 113 | (swapped t)) 114 | (if (eq (car mark-A) (buffer-name)) 115 | (cond 116 | ((>= ovl-B-begin ovl-A-end) 117 | (jagger-swap-regions--swap mark-A (cons (buffer-name) ovl-B))) 118 | ((<= ovl-B-end ovl-A-begin) 119 | (jagger-swap-regions--swap (cons (buffer-name) ovl-B) mark-A)) 120 | (t (progn 121 | (setq swapped nil)))) 122 | (jagger-swap-regions--swap (cons (buffer-name) ovl-B) mark-A)) 123 | (delete-overlay ovl-B) 124 | (when swapped 125 | (deactivate-mark) 126 | (jagger-swap-regions-clean-marks))))))) 127 | 128 | (defun jagger-swap-things-1 (bound1 bound2) 129 | "Swap `BOUND1' with `BOUND2'." 130 | (interactive) 131 | (let ((beg1 (car bound1)) 132 | (end1 (cdr bound1)) 133 | (beg2 (car bound2)) 134 | (end2 (cdr bound2))) 135 | (if (or (and (< beg2 beg1) (< beg1 end2)) 136 | (and (< beg1 beg2) (< beg2 end1))) 137 | (error "Unable to swap overlapping regions") 138 | (save-excursion 139 | (insert 140 | (prog1 (delete-and-extract-region beg2 end2) 141 | (goto-char beg2) 142 | (insert 143 | (delete-and-extract-region beg1 end1)) 144 | (goto-char beg1))))))) 145 | 146 | (defun jagger-swap-things (thing) 147 | "Swap THINGs around point or region that from `BEG' to `END'." 148 | (interactive) 149 | (if (region-active-p) 150 | (jagger-swap-things-1 (jagger-util--bounds-of-backward-thing thing (region-beginning)) 151 | (jagger-util--bounds-of-forward-thing thing (region-end))) 152 | (jagger-swap-things-1 (jagger-util--bounds-of-backward-thing thing) 153 | (jagger-util--bounds-of-forward-thing thing)))) 154 | 155 | (defun jagger-swap-words () 156 | "Swap words around point or region that from `BEG' to `END'." 157 | (interactive) 158 | (jagger-swap-things 'word)) 159 | 160 | (defun jagger-swap-sexps () 161 | "Swap sexps around point or region that from `BEG' to `END'." 162 | (interactive) 163 | (jagger-swap-things 'sexp)) 164 | 165 | (defun jagger-swap-lines () 166 | "Swap lines around point or region that from `BEG' to `END'." 167 | (interactive) 168 | (jagger-swap-things 'line)) 169 | 170 | (provide 'jagger-swap) 171 | 172 | ;;; jagger-swap.el ends here 173 | -------------------------------------------------------------------------------- /test-jagger-move.el: -------------------------------------------------------------------------------- 1 | ;;; test-jagger-move.el --- Test jagger-move -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2018 Gong QiJian 4 | 5 | ;; This program is free software; you can redistribute it and/or modify 6 | ;; it under the terms of the GNU General Public License as published by 7 | ;; the Free Software Foundation, either version 3 of the License, or 8 | ;; (at your option) any later version. 9 | 10 | ;; This program is distributed in the hope that it will be useful, 11 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | ;; GNU General Public License for more details. 14 | 15 | ;; You should have received a copy of the GNU General Public License 16 | ;; along with this program. If not, see . 17 | 18 | ;;; Code: 19 | 20 | (require 'ert) 21 | (require 'jagger-move) 22 | (require 'test-util) 23 | 24 | (defun test-jagger-move--common (fn initial expected stop-at-pattern repeat-times) 25 | (with-temp-buffer 26 | (insert initial) 27 | (lisp-mode) 28 | (goto-char (point-min)) 29 | (re-search-forward stop-at-pattern) 30 | (dotimes (_ repeat-times) 31 | (funcall fn)) 32 | (should (equal (buffer-substring (point-min) (point-max)) 33 | expected)))) 34 | 35 | (defun test-jagger-move-with-region--common (fn initial expected region-pattern repeat-times) 36 | (with-temp-buffer 37 | (insert initial) 38 | (lisp-mode) 39 | (goto-char (point-min)) 40 | (re-search-forward region-pattern) 41 | (set-mark (- (point) (length region-pattern))) 42 | (when noninteractive 43 | (transient-mark-mode)) ;; MUST 44 | (dotimes (_ repeat-times) 45 | (funcall fn)) 46 | (should (and (region-active-p) 47 | (equal (buffer-substring (region-beginning) (region-end)) 48 | region-pattern) 49 | (equal (buffer-substring (point-min) (point-max)) 50 | expected))))) 51 | 52 | (ert-deftest test-jagger-move-sexp-forward () 53 | (test-jagger-move--common 'jagger-move-sexp-forward 54 | "(foo (qux \"quux\") bar)" 55 | "((qux \"quux\") foo bar)" 56 | "foo" 57 | 1)) 58 | 59 | (ert-deftest test-jagger-move-sexp-forward-with-region () 60 | (test-jagger-move-with-region--common 61 | 'jagger-move-sexp-forward 62 | "(foo (qux \"quux\") bar)" 63 | "((qux \"quux\") foo bar)" 64 | "foo" 65 | 1)) 66 | 67 | (ert-deftest test-jagger-move-sexp-backward () 68 | (test-jagger-move--common 'jagger-move-sexp-backward 69 | "(foo (qux \"quux\") bar)" 70 | "((qux \"quux\") foo bar)" 71 | "(qux \"quux\")" 72 | 1)) 73 | 74 | (ert-deftest test-jagger-move-sexp-backward-with-region () 75 | (test-jagger-move-with-region--common 76 | 'jagger-move-sexp-backward 77 | "(foo (qux \"quux\") bar)" 78 | "((qux \"quux\") foo bar)" 79 | "(qux \"quux\")" 80 | 1)) 81 | 82 | (ert-deftest test-jagger-move-word-forward () 83 | (test-jagger-move--common 'jagger-move-word-forward 84 | ";; foo-quux-bar" 85 | ";; quux-foo-bar" 86 | "foo" 87 | 1)) 88 | 89 | (ert-deftest test-jagger-move-word-backward () 90 | (test-jagger-move--common 'jagger-move-word-backward 91 | ";; foo-quux-bar" 92 | ";; quux-foo-bar" 93 | "quux" 94 | 1)) 95 | 96 | (require 'cl) 97 | 98 | (cl-defun test-jagger-move-line--common (&key initial expected from step) 99 | (with-temp-buffer 100 | (insert initial) 101 | (goto-line from) 102 | (jagger-move-line step) 103 | (should (equal (buffer-substring-no-properties (point-min) (point-max)) 104 | expected)))) 105 | 106 | (cl-defun test-jagger-move-multiple-lines--common 107 | (&key initial expected region-pattern expected-region step) 108 | (with-temp-buffer 109 | (insert initial) 110 | (when noninteractive 111 | (transient-mark-mode)) 112 | (goto-char (point-min)) 113 | (re-search-forward region-pattern) 114 | (set-mark (- (point) (length region-pattern))) 115 | (jagger-move-line step) 116 | (should (and (equal (buffer-substring-no-properties (point-min) (point-max)) 117 | expected) 118 | (equal (buffer-substring-no-properties (region-beginning) (region-end)) 119 | expected-region))))) 120 | 121 | (ert-deftest test-jagger-move-line () 122 | ;; move line down 123 | (test-jagger-move-line--common 124 | :initial "foo\n(qux quux)\nbar" 125 | :expected "(qux quux)\nfoo\nbar" 126 | :from 1 127 | :step 1) 128 | (test-jagger-move-line--common 129 | :initial "foo\n(qux quux)\nbar" 130 | :expected "(qux quux)\nbar\nfoo" 131 | :from 1 132 | :step 2) 133 | (test-jagger-move-line--common 134 | :initial "foo\n(qux quux)\nbar" 135 | :expected "(qux quux)\nbar\nfoo" 136 | :from 1 137 | :step 3) 138 | 139 | ;; move down (with trailing newline) 140 | (test-jagger-move-line--common 141 | :initial "foo\n(qux quux)\nbar\n" 142 | :expected "(qux quux)\nfoo\nbar\n" 143 | :from 1 144 | :step 1) 145 | (test-jagger-move-line--common 146 | :initial "foo\n(qux quux)\nbar\n" 147 | :expected "(qux quux)\nbar\nfoo\n" 148 | :from 1 149 | :step 2) 150 | (test-jagger-move-line--common 151 | :initial "foo\n(qux quux)\nbar\n" 152 | :expected "(qux quux)\nbar\nfoo\n" 153 | :from 1 154 | :step 3) 155 | 156 | ;; move line down 157 | (test-jagger-move-line--common 158 | :initial "foo\n(qux quux)\nbar" 159 | :expected "(qux quux)\nfoo\nbar" 160 | :from 2 161 | :step -1) 162 | (test-jagger-move-line--common 163 | :initial "foo\n(qux quux)\nbar" 164 | :expected "(qux quux)\nfoo\nbar" 165 | :from 2 166 | :step -2) 167 | 168 | ;; move line down (from end of buffer) 169 | (test-jagger-move-line--common 170 | :initial "foo\n(qux quux)\nbar" 171 | :expected "foo\nbar\n(qux quux)" 172 | :from 3 173 | :step -1) 174 | (test-jagger-move-line--common 175 | :initial "foo\n(qux quux)\nbar" 176 | :expected "bar\nfoo\n(qux quux)" 177 | :from 3 178 | :step -2) 179 | (test-jagger-move-line--common 180 | :initial "foo\n(qux quux)\nbar" 181 | :expected "bar\nfoo\n(qux quux)" 182 | :from 3 183 | :step -3) 184 | 185 | ;; move line down (from end of buffer with trailing newline) 186 | (test-jagger-move-line--common 187 | :initial "foo\n(qux quux)\nbar\n" 188 | :expected "foo\nbar\n(qux quux)\n" 189 | :from 3 190 | :step -1) 191 | (test-jagger-move-line--common 192 | :initial "foo\n(qux quux)\nbar\n" 193 | :expected "bar\nfoo\n(qux quux)\n" 194 | :from 3 195 | :step -2) 196 | (test-jagger-move-line--common 197 | :initial "foo\n(qux quux)\nbar\n" 198 | :expected "bar\nfoo\n(qux quux)\n" 199 | :from 3 200 | :step -3) 201 | 202 | ;; move selected lines down 203 | (test-jagger-move-multiple-lines--common 204 | :initial "foo\nqux\nquux\nbar" 205 | :expected "quux\nfoo\nqux\nbar" 206 | :region-pattern "foo\nqux\n" 207 | :expected-region "foo\nqux\n" 208 | :step 1) 209 | (test-jagger-move-multiple-lines--common 210 | :initial "foo\nqux\nquux\nbar" 211 | :expected "quux\nbar\nfoo\nqux" 212 | :region-pattern "foo\nqux\n" 213 | :expected-region "foo\nqux" 214 | :step 2) 215 | (test-jagger-move-multiple-lines--common 216 | :initial "foo\nqux\nquux\nbar" 217 | :expected "quux\nbar\nfoo\nqux" 218 | :region-pattern "foo\nqux\n" 219 | :expected-region "foo\nqux" 220 | :step 3) 221 | 222 | ;; move selected lines up 223 | (test-jagger-move-multiple-lines--common 224 | :initial "foo\nqux\nquux\nbar" 225 | :expected "foo\nquux\nbar\nqux" 226 | :region-pattern "quux\nbar" 227 | :expected-region "quux\nbar\n" 228 | :step -1) 229 | (test-jagger-move-multiple-lines--common 230 | :initial "foo\nqux\nquux\nbar" 231 | :expected "quux\nbar\nfoo\nqux" 232 | :region-pattern "quux\nbar" 233 | :expected-region "quux\nbar\n" 234 | :step -2) 235 | (test-jagger-move-multiple-lines--common 236 | :initial "foo\nqux\nquux\nbar" 237 | :expected "quux\nbar\nfoo\nqux" 238 | :region-pattern "quux\nbar" 239 | :expected-region "quux\nbar\n" 240 | :step -3) 241 | ) 242 | 243 | (provide 'test-jagger-move) 244 | 245 | ;;; test-jagger-move.el ends here 246 | 247 | -------------------------------------------------------------------------------- /jagger-move.el: -------------------------------------------------------------------------------- 1 | ;;; jagger-move.el --- Moving functions -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2018 Gong QiJian 4 | 5 | ;; Author: Gong QiJian 6 | ;; Created: 2018/08/28 7 | ;; Version: 0.1.0 8 | ;; Package-Requires: ((emacs "24.4")) 9 | ;; URL: https://github.com/twlz0ne/jagger 10 | ;; Keywords: convenience editing 11 | 12 | ;; This program is free software; you can redistribute it and/or modify 13 | ;; it under the terms of the GNU General Public License as published by 14 | ;; the Free Software Foundation, either version 3 of the License, or 15 | ;; (at your option) any later version. 16 | 17 | ;; This program is distributed in the hope that it will be useful, 18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20 | ;; GNU General Public License for more details. 21 | 22 | ;; You should have received a copy of the GNU General Public License 23 | ;; along with this program. If not, see . 24 | 25 | ;;; Code: 26 | 27 | (require 'jagger-util) 28 | (require 'jagger-swap) 29 | 30 | (defvar jagger-move--last-region-mark nil 31 | "Region mark for restore hook.") 32 | 33 | (defun jagger-move--restore-region-hook () 34 | (remove-hook 'deactivate-mark-hook 'jagger-move--restore-region-hook) 35 | (let ((reg jagger-move--last-region-mark)) 36 | (when reg 37 | (if (and (fboundp 'evil-visual-state-p) 38 | (fboundp 'evil-visual-select) 39 | (evil-visual-state-p)) 40 | (evil-visual-select (car reg) (cdr reg)) 41 | (goto-char (cdr reg)) 42 | (set-mark (car reg)))))) 43 | 44 | (defun jagger-move--restore-region (beg end) 45 | "Restore region at new place from BEG to END. 46 | Also add hook to `deactivate-mark-hook' and backup region." 47 | (add-hook 'deactivate-mark-hook 'jagger-move--restore-region-hook) 48 | (if (and (fboundp 'evil-visual-state-p) 49 | (fboundp 'evil-visual-select) 50 | (evil-visual-state-p)) 51 | (evil-visual-select beg (1- end)) 52 | (goto-char end) 53 | (set-mark beg)) 54 | (setq jagger-move--last-region-mark (cons beg end))) 55 | 56 | (defun jagger-move-line (n) 57 | "Move the current line or region up or down by N lines." 58 | (interactive "p") 59 | (let* ((restore-region-p (region-active-p)) 60 | (bounds (if (region-active-p) 61 | (cons (region-beginning) (region-end)) 62 | (bounds-of-thing-at-point 'line))) 63 | (end-line-of-bounds (line-number-at-pos (- (cdr bounds) 64 | (if (equal 10 (char-before (cdr bounds))) 65 | 1 0)))) 66 | (trailing-newline (> (line-number-at-pos (point-max)) 67 | (line-number-at-pos (1- (point-max))))) 68 | (borrow-trailing (and (not trailing-newline) 69 | (equal (point-max) (cdr bounds))))) 70 | (cond 71 | ((and (< n 0) (= (line-number-at-pos (car bounds)) 72 | (line-number-at-pos (point-min)))) 73 | (message "Beginning fo buffer")) 74 | ((and (> n 0) (or (= end-line-of-bounds (line-number-at-pos (point-max))) 75 | (= end-line-of-bounds (line-number-at-pos (1- (point-max)))))) 76 | (message "End of buffer")) 77 | (t 78 | (let* ((col (current-column)) 79 | (eob (= (point-max) (- (cdr bounds) 80 | (if (equal 10 (char-before (cdr bounds))) 81 | 1 0)))) 82 | (to-end (and (> n 0) 83 | (>= (+ n (line-number-at-pos (1- (cdr bounds)))) 84 | (line-number-at-pos (point-max))))) 85 | (line (delete-and-extract-region (- (car bounds) 86 | (if borrow-trailing 1 0)) 87 | (cdr bounds))) 88 | ov) 89 | (if (and eob (< n 0)) 90 | ;; up 91 | (forward-line (1+ n)) 92 | ;;down 93 | (forward-line n)) 94 | 95 | (when restore-region-p 96 | (let ((pos (if (and to-end (not trailing-newline)) (point-at-eol) (point-at-bol)))) 97 | (setq ov (jagger-swap-regions--make-overlay pos pos t)))) 98 | 99 | ;; "\n" => "\n" 100 | (when borrow-trailing 101 | (setq line (concat (string-trim-left line "\n") "\n"))) 102 | 103 | (if (and to-end (not trailing-newline)) 104 | ;; "\n" => "\n" 105 | (insert (concat "\n" (string-trim-right line "\n"))) 106 | (insert line)) 107 | 108 | ;; Restore point or region 109 | (if ov 110 | (progn 111 | (jagger-move--restore-region (+ (overlay-start ov) 112 | (if (and to-end (not trailing-newline)) 1 0)) 113 | (overlay-end ov)) 114 | (delete-overlay ov)) 115 | (forward-line -1) 116 | (forward-char col))))))) 117 | 118 | (defun jagger-move-line-up (&optional n) 119 | "Move the current line up by N lines." 120 | (interactive "p") 121 | (jagger-move-line (if (null n) -1 (- n)))) 122 | 123 | (defun jagger-move-line-down (&optional n) 124 | "Move the current line down by N lines." 125 | (interactive "p") 126 | (jagger-move-line (if (null n) 1 n))) 127 | 128 | (defun jagger-move-thing-forward (thing) 129 | "Move the current THING or region forward by THING. 130 | THING should be ‘sexp’ or ‘word’." 131 | (interactive) 132 | (condition-case err 133 | (let* ((reg-bound (if (region-active-p) 134 | (cons (region-beginning) (region-end)))) 135 | (cur-bound (or reg-bound 136 | (jagger-util--bounds-of-thing-at-point thing))) 137 | (dst-bound (jagger-util--bounds-of-forward-thing thing (cdr cur-bound))) 138 | (ov1 (jagger-swap-regions-mark-region-1 (car cur-bound) (cdr cur-bound) t)) 139 | (ov2 (jagger-swap-regions-mark-region-n (car dst-bound) (cdr dst-bound) t)) 140 | (cur-point (point))) 141 | (unless (or (not cur-bound) 142 | (not dst-bound) 143 | (jagger-util--region-overlapped-p cur-bound dst-bound)) 144 | (save-excursion 145 | (jagger-swap-regions--swap ov1 ov2)) 146 | (if reg-bound 147 | (jagger-move--restore-region (overlay-start (cdr ov2)) 148 | (overlay-end (cdr ov2))) 149 | (goto-char (- (cdr dst-bound) 150 | (- (cdr cur-bound) cur-point)))))) 151 | (error 152 | (pcase err 153 | (`(scan-error "Containing expression ends prematurely" . ,_) 154 | (message "Already at the boundary"))))) 155 | (jagger-swap-regions-clean-marks)) 156 | 157 | (defun jagger-move-thing-backward (thing) 158 | "Move the current THING or region backward by THING. 159 | THING should be ‘sexp’ or ‘word’." 160 | (interactive) 161 | (condition-case err 162 | (let* ((reg-bound (if (region-active-p) 163 | (cons (region-beginning) (region-end)))) 164 | (cur-bound (or reg-bound 165 | (jagger-util--bounds-of-thing-at-point thing))) 166 | (dst-bound (jagger-util--bounds-of-backward-thing thing (car cur-bound))) 167 | (ov1 (jagger-swap-regions-mark-region-1 (car cur-bound) (cdr cur-bound) t)) 168 | (ov2 (jagger-swap-regions-mark-region-n (car dst-bound) (cdr dst-bound) t)) 169 | (cur-point (point))) 170 | (unless (or (not cur-bound) 171 | (not dst-bound) 172 | (jagger-util--region-overlapped-p cur-bound dst-bound)) 173 | (save-excursion 174 | (jagger-swap-regions--swap ov2 ov1)) 175 | (if reg-bound 176 | (jagger-move--restore-region (overlay-start (cdr ov2)) 177 | (overlay-end (cdr ov2))) 178 | (goto-char (+ (car dst-bound) 179 | (- cur-point (car cur-bound))))))) 180 | (error 181 | (pcase err 182 | (`(scan-error "Containing expression ends prematurely" . ,_) 183 | (message "Already at the boundary"))))) 184 | (jagger-swap-regions-clean-marks)) 185 | 186 | (defun jagger-move-sexp-forward () 187 | "Move the current sexp forward." 188 | (interactive) 189 | (jagger-move-thing-forward 'sexp)) 190 | 191 | (defun jagger-move-sexp-backward () 192 | "Move the current sexp backward." 193 | (interactive) 194 | (jagger-move-thing-backward 'sexp)) 195 | 196 | (defun jagger-move-word-forward () 197 | "Move the current word forward." 198 | (interactive) 199 | (jagger-move-thing-forward 'word)) 200 | 201 | (defun jagger-move-word-backward () 202 | "Move the current word backward." 203 | (interactive) 204 | (jagger-move-thing-backward 'word)) 205 | 206 | (provide 'jagger-move) 207 | 208 | ;;; jagger-move.el ends here 209 | --------------------------------------------------------------------------------