move-lines.el 4.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146
  1. ;;; move-lines.el --- move current line or lines surrounding region up or down
  2. ;;
  3. ;; Copyright (C) 2014-2017 Emanuele Tomasi <targzeta@gmail.com>
  4. ;;
  5. ;; Author: Emanuele Tomasi <targzeta@gmail.com>
  6. ;; URL: https://github.com/targzeta/move-lines
  7. ;; Maintainer: Emanuele Tomasi <targzeta@gmail.com>
  8. ;; Keywords: convenience
  9. ;; Version: 2.0
  10. ;;
  11. ;; This file is NOT part of GNU Emacs.
  12. ;;
  13. ;; This program is free software: you can redistribute it and/or
  14. ;; modify it under the terms of the GNU General Public License as
  15. ;; published by the Free Software Foundation, either version 3 of the
  16. ;; License, or (at your option) any later version.
  17. ;;
  18. ;; This program is distributed in the hope that it will be useful,
  19. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  21. ;; General Public License for more details.
  22. ;;
  23. ;; You should have received a copy of the GNU General Public License
  24. ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
  25. ;;
  26. ;;; Commentary;
  27. ;;
  28. ;; There are two entry points: `move-lines-up' moves the text up and
  29. ;; `move-lines-down' that moves the text down.
  30. ;;
  31. ;; Copy this file in a directory which is in the Emacs `load-path'. Then,
  32. ;; execute the following code either directly or in your .emacs file:
  33. ;;
  34. ;; (require 'move-lines)
  35. ;; (move-lines-binding)
  36. ;;
  37. ;; Now, you can move the line(s) up by M-p or M-<up> or down by M-n or
  38. ;; M-<down>.
  39. ;;
  40. ;;; Code:
  41. (defun move-lines--internal (n)
  42. "Moves the current line or, if region is actives, the lines surrounding
  43. region, of N lines. Down if N is positive, up if is negative"
  44. ;; The text area spans from the beginning of the first line (text-start) to
  45. ;; the end of the last line, '\n' included (text-end). Its coordinates are
  46. ;; the number of chars from the beginning of buffer.
  47. ;; The region is within the text area and its coordinates are the (negative)
  48. ;; numbers of chars from text-end.
  49. ;;
  50. ;; E.g.:
  51. ;; Lorem ipsum dolor sit amet, consectetur adipisci elit,\n
  52. ;; ^ ^ ^ ^
  53. ;; text-start(1) region-start(-35) region-end(-14) text-end(55)
  54. ;;
  55. ;; We assume that point is always ahead the mark, else temporarily we swap
  56. ;; them.
  57. ;; If we act on the latest line of the buffer and it hasn't a newline, we
  58. ;; temporarily add one.
  59. (let* (text-start
  60. text-end
  61. (region-start (point))
  62. (region-end region-start)
  63. swap-point-mark
  64. delete-latest-newline)
  65. ;; STEP 1: identifying the text to cut.
  66. (when (region-active-p)
  67. (if (> (point) (mark))
  68. (setq region-start (mark))
  69. (exchange-point-and-mark)
  70. (setq swap-point-mark t
  71. region-end (point))))
  72. ;; text-end and region-end
  73. (end-of-line)
  74. ;; If point !< point-max, this buffers doesn't have the trailing newline.
  75. (if (< (point) (point-max))
  76. (forward-char 1)
  77. (setq delete-latest-newline t)
  78. (insert-char ?\n))
  79. (setq text-end (point)
  80. region-end (- region-end text-end))
  81. ;; text-start and region-start
  82. (goto-char region-start)
  83. (beginning-of-line)
  84. (setq text-start (point)
  85. region-start (- region-start text-end))
  86. ;; STEP 2: cut and paste.
  87. (let ((text (delete-and-extract-region text-start text-end)))
  88. (forward-line n)
  89. ;; If the current-column != 0, I have moved the region at the bottom of a
  90. ;; buffer doesn't have the trailing newline.
  91. (when (not (= (current-column) 0))
  92. (insert-char ?\n)
  93. (setq delete-latest-newline t))
  94. (insert text))
  95. ;; STEP 3: Restoring.
  96. (forward-char region-end)
  97. (when delete-latest-newline
  98. (save-excursion
  99. (goto-char (point-max))
  100. (delete-char -1)))
  101. (when (region-active-p)
  102. (setq deactivate-mark nil)
  103. (set-mark (+ (point) (- region-start region-end)))
  104. (if swap-point-mark
  105. (exchange-point-and-mark)))))
  106. ;;;###autoload
  107. (defun move-lines-up (n)
  108. "Moves the current line or, if region is actives, the lines surrounding
  109. region, up by N lines, or 1 line if N is nil."
  110. (interactive "p")
  111. (if (eq n nil)
  112. (setq n 1))
  113. (move-lines--internal (- n)))
  114. ;;;###autoload
  115. (defun move-lines-down (n)
  116. "Moves the current line or, if region is actives, the lines surrounding
  117. region, down by N lines, or 1 line if N is nil."
  118. (interactive "p")
  119. (if (eq n nil)
  120. (setq n 1))
  121. (move-lines--internal n))
  122. ;;;###autoload
  123. (defun move-lines-binding ()
  124. "Sets the default key binding for moving lines. M-p or M-<up> for moving up
  125. and M-n or M-<down> for moving down."
  126. (global-set-key (kbd "M-p") 'move-lines-up)
  127. (global-set-key (kbd "M-<up>") 'move-lines-up)
  128. (global-set-key (kbd "M-n") 'move-lines-down)
  129. (global-set-key (kbd "M-<down>") 'move-lines-down))
  130. (provide 'move-lines)
  131. ;; move-lines.el ends here