branch: elpa/adoc-mode
commit 3fc5674064f6d79926e01162395c00b06199c460
Author: Bozhidar Batsov <[email protected]>
Commit: Bozhidar Batsov <[email protected]>
Add list item move and renumber commands
Add adoc-move-list-item-up (M-up) and adoc-move-list-item-down (M-down),
which transpose the list item at point (together with its nested
sub-items and continuation lines) past its previous or next sibling.
Siblings must share the same list type, level and indentation, so two
distinct adjacent lists are never merged.
Add adoc-renumber-list, which renumbers a contiguous arabic or
alphabetic explicitly-numbered list starting from its first item's
value.
---
CHANGELOG.md | 1 +
README.adoc | 3 +-
adoc-mode.el | 198 +++++++++++++++++++++++++++++++++++++++++++++++++
test/adoc-mode-test.el | 72 ++++++++++++++++++
4 files changed, 272 insertions(+), 2 deletions(-)
diff --git a/CHANGELOG.md b/CHANGELOG.md
index bf0f3eecea..5343d29810 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -5,6 +5,7 @@
### New features
- Add list editing: `adoc-promote` (`M-left`) and `adoc-demote` (`M-right`)
now nest the list item at point one level deeper or shallower (for unordered
`*`/`-` and implicitly-numbered `.` lists) in addition to acting on section
titles, and the new `adoc-insert-list-item` (`M-RET`) inserts a sibling item
below the current one, keeping its indentation and marker and incrementing the
number/letter of explicitly-numbered items.
+- Add `adoc-move-list-item-up` (`M-up`) and `adoc-move-list-item-down`
(`M-down`), which move the list item at point (together with its nested
sub-items) past its previous/next sibling, and `adoc-renumber-list`, which
renumbers a contiguous arabic (`1.`) or alphabetic (`a.`/`A.`)
explicitly-numbered list starting from its first item's value.
- Add heading navigation commands modelled on `markdown-mode` and `org-mode`:
`adoc-next-visible-heading` (`C-c C-n`), `adoc-previous-visible-heading` (`C-c
C-p`), `adoc-forward-same-level` (`C-c C-f`), `adoc-backward-same-level` (`C-c
C-b`), and `adoc-up-heading` (`C-c C-u`). They understand both one-line (`==
Title`) and two-line (underlined) titles and skip headings hidden by folding.
`outline-minor-mode` is now enabled by default so the folding commands are
available out of the box.
- New `adoc-title-scaling` defcustom (default `t`) and
`adoc-title-scaling-values` list let users disable the variable-height title
faces or pick their own scale factors. Set the boolean to nil for
uniformly-sized headings, or customise the list to control the level-0..5
heights. Mirrors `markdown-header-scaling`.
- New `adoc-blockquote-face` for the body of `[quote]` and `[verse]` delimited
blocks (inherits `font-lock-doc-face`); previously the body was left
unfontified.
diff --git a/README.adoc b/README.adoc
index 0cf8053a5a..dfb469fb05 100644
--- a/README.adoc
+++ b/README.adoc
@@ -41,7 +41,7 @@ Here are some of the main features of `adoc-mode`:
- ~50 tempo templates for inserting AsciiDoc markup (formatting, titles,
blocks, lists, macros, etc.)
- heading navigation modelled on `markdown-mode` / `org-mode`: next / previous
heading (`C-c C-n` / `C-c C-p`), forward / backward at the same level (`C-c
C-f` / `C-c C-b`), and up to the parent heading (`C-c C-u`)
- title management: promote / demote (`M-left` / `M-right`), toggle between
one-line and two-line styles, adjust underline length
-- list editing: `M-left` / `M-right` also nest the list item at point deeper
or shallower, and `M-RET` inserts a sibling item (incrementing the number for
explicitly-numbered lists)
+- list editing: `M-left` / `M-right` nest the list item at point deeper or
shallower, `M-RET` inserts a sibling item (incrementing the number for
explicitly-numbered lists), `M-up` / `M-down` move an item (with its sub-items)
past its siblings, and `M-x adoc-renumber-list` renumbers an
explicitly-numbered list
- navigate to anchors (`C-c C-a`) and follow URLs, `include::` macros, and
xrefs at point (`C-c C-o` / `M-.`)
- nested `imenu` index with hierarchical heading structure
- `outline-minor-mode` enabled out of the box for folding (one-line title
style only)
@@ -233,7 +233,6 @@ These days all upstream packages (e.g. on MELPA) are built
from Bozhidar's fork.
Here are some features that we're considering to add in the future:
-- Moving list items up / down and renumbering explicitly-numbered lists
- Correctly highlighting backslash escapes
Check out the issue tracker for more details.
diff --git a/adoc-mode.el b/adoc-mode.el
index 584ced5929..e7084b0578 100644
--- a/adoc-mode.el
+++ b/adoc-mode.el
@@ -2987,6 +2987,199 @@ incremented number or letter."
(end-of-line)
(insert "\n" indent new-marker " "))))
+(defun adoc--line-list-level ()
+ "Return the nesting level of the list item on the current line, or nil."
+ (let ((item (adoc--list-item-at-point)))
+ (and item (plist-get item :level))))
+
+(defun adoc--list-item-block-end (level)
+ "Return the position at the end of the list item block on the current line.
+Point must be at the beginning of the marker line of an item at
+nesting LEVEL. The block runs through any immediately following
+continuation lines and more deeply nested items, stopping before
+the first blank line, sibling, or shallower item. The returned
+position is at the beginning of a line (or `point-max')."
+ (save-excursion
+ (forward-line 1)
+ (let ((end (point)))
+ (while (and (not (eobp))
+ (not (looking-at-p "[ \t]*$"))
+ (let ((il (adoc--line-list-level)))
+ (or (null il) (> il level))))
+ (forward-line 1)
+ (setq end (point)))
+ end)))
+
+(defun adoc--same-list-p (item)
+ "Return non-nil if the item on the current line is a sibling of ITEM.
+Siblings share the same list type, nesting level and indentation
+\(and, for explicitly-numbered lists, the same marker kind), so
+two distinct adjacent lists are not treated as one."
+ (let ((other (adoc--list-item-at-point)))
+ (and other
+ (eq (plist-get other :type) (plist-get item :type))
+ (= (plist-get other :level) (plist-get item :level))
+ (string= (plist-get other :indent) (plist-get item :indent))
+ (or (not (eq (plist-get item :type) 'explicit-numbered))
+ (eq (adoc--explicit-marker-kind (plist-get other :marker))
+ (adoc--explicit-marker-kind (plist-get item :marker)))))))
+
+(defun adoc--next-sibling-start (from item)
+ "Return the start of the next sibling of ITEM at or after FROM, or nil.
+Blank lines, continuation lines and more deeply nested items are
+skipped. A shallower item, or a same-level item belonging to a
+different list, stops the search and yields nil."
+ (let ((level (plist-get item :level)))
+ (save-excursion
+ (goto-char from)
+ (catch 'found
+ (while (not (eobp))
+ (unless (looking-at-p "[ \t]*$")
+ (let ((il (adoc--line-list-level)))
+ (cond
+ ((null il))
+ ((and (= il level) (adoc--same-list-p item)) (throw 'found
(point)))
+ ((<= il level) (throw 'found nil)))))
+ (forward-line 1))
+ nil))))
+
+(defun adoc--prev-sibling-start (before item)
+ "Return the start of the previous sibling of ITEM before BEFORE, or nil.
+Blank lines, continuation lines and more deeply nested items are
+skipped. A shallower item, or a same-level item belonging to a
+different list, stops the search and yields nil."
+ (let ((level (plist-get item :level)))
+ (save-excursion
+ (goto-char before)
+ (catch 'found
+ (while (not (bobp))
+ (forward-line -1)
+ (unless (looking-at-p "[ \t]*$")
+ (let ((il (adoc--line-list-level)))
+ (cond
+ ((null il))
+ ((and (= il level) (adoc--same-list-p item)) (throw 'found
(point)))
+ ((<= il level) (throw 'found nil))))))
+ nil))))
+
+(defun adoc--move-list-item (down)
+ "Move the list item at point past its sibling, DOWN when non-nil else up.
+The item's nested sub-items and continuation lines move with it."
+ (let ((item (adoc--list-item-at-point)))
+ (unless item
+ (user-error "Not on a list item"))
+ (let ((level (plist-get item :level))
+ (col (current-column)))
+ (beginning-of-line)
+ (let* ((s1 (point))
+ (e1 (adoc--list-item-block-end level)))
+ (if down
+ (let ((s2 (adoc--next-sibling-start e1 item)))
+ (unless s2 (user-error "No next item at this level"))
+ (let ((e2 (save-excursion
+ (goto-char s2)
+ (adoc--list-item-block-end level))))
+ ;; Avoid merging lines when the buffer lacks a final newline.
+ (when (and (= e2 (point-max)) (/= (char-before e2) ?\n))
+ (save-excursion (goto-char (point-max)) (insert "\n"))
+ (setq e2 (point-max)))
+ (transpose-regions s1 e1 s2 e2)
+ (goto-char (+ s1 (- e2 e1)))
+ (move-to-column col)))
+ (let ((ps (adoc--prev-sibling-start s1 item)))
+ (unless ps (user-error "No previous item at this level"))
+ ;; Avoid merging lines when the buffer lacks a final newline.
+ (when (and (= e1 (point-max)) (/= (char-before e1) ?\n))
+ (save-excursion (goto-char (point-max)) (insert "\n"))
+ (setq e1 (point-max)))
+ (transpose-regions ps s1 s1 e1)
+ (goto-char ps)
+ (move-to-column col)))))))
+
+(defun adoc-move-list-item-down (&optional arg)
+ "Move the list item at point down past the next sibling ARG times.
+The item's nested sub-items and continuation lines move with it."
+ (interactive "p")
+ (dotimes (_ (or arg 1))
+ (adoc--move-list-item t)))
+
+(defun adoc-move-list-item-up (&optional arg)
+ "Move the list item at point up past the previous sibling ARG times.
+The item's nested sub-items and continuation lines move with it."
+ (interactive "p")
+ (dotimes (_ (or arg 1))
+ (adoc--move-list-item nil)))
+
+(defun adoc--explicit-marker-kind (marker)
+ "Return the kind of an explicitly-numbered list MARKER.
+One of `arabic', `lower-alpha', `upper-alpha', `lower-roman',
+`upper-roman', or nil."
+ (cond
+ ((string-match-p "\\`[0-9]+\\.\\'" marker) 'arabic)
+ ((string-match-p "\\`[a-z]\\.\\'" marker) 'lower-alpha)
+ ((string-match-p "\\`[A-Z]\\.\\'" marker) 'upper-alpha)
+ ((string-match-p "\\`[ivxlcdm]+)\\'" marker) 'lower-roman)
+ ((string-match-p "\\`[IVXLCDM]+)\\'" marker) 'upper-roman)))
+
+(defun adoc--explicit-marker-value (kind marker)
+ "Return the 1-based ordinal that MARKER represents for list KIND."
+ (pcase kind
+ ('arabic (string-to-number marker))
+ ('lower-alpha (1+ (- (aref marker 0) ?a)))
+ ('upper-alpha (1+ (- (aref marker 0) ?A)))))
+
+(defun adoc--explicit-marker (kind n)
+ "Return the marker string for the Nth (1-based) item of list KIND."
+ (pcase kind
+ ('arabic (format "%d." n))
+ ('lower-alpha (format "%c." (+ ?a (1- n))))
+ ('upper-alpha (format "%c." (+ ?A (1- n))))))
+
+(defun adoc--explicit-item-on-line-p (kind indent)
+ "Non-nil if the current line holds an explicit item of KIND and INDENT."
+ (let ((item (adoc--list-item-at-point)))
+ (and item
+ (eq (plist-get item :type) 'explicit-numbered)
+ (string= (plist-get item :indent) indent)
+ (eq (adoc--explicit-marker-kind (plist-get item :marker)) kind))))
+
+(defun adoc-renumber-list ()
+ "Renumber the explicitly-numbered list at point.
+Only flat arabic (\"1.\") and alphabetic (\"a.\"/\"A.\") lists are
+renumbered; the sequence starts from the first item's current
+value. Roman-numeral lists are left untouched."
+ (interactive)
+ (let ((item (adoc--list-item-at-point)))
+ (unless (and item (eq (plist-get item :type) 'explicit-numbered))
+ (user-error "Not on an explicitly-numbered list item"))
+ (let* ((indent (plist-get item :indent))
+ (kind (adoc--explicit-marker-kind (plist-get item :marker))))
+ (unless (memq kind '(arabic lower-alpha upper-alpha))
+ (user-error "Can only renumber arabic or alphabetic lists"))
+ (save-excursion
+ (beginning-of-line)
+ ;; Walk back to the first item of the run.
+ (while (save-excursion (and (zerop (forward-line -1))
+ (adoc--explicit-item-on-line-p kind
indent)))
+ (forward-line -1))
+ (let ((n (adoc--explicit-marker-value
+ kind (plist-get (adoc--list-item-at-point) :marker))))
+ (while (and (not (eobp))
+ (adoc--explicit-item-on-line-p kind indent))
+ (when (and (memq kind '(lower-alpha upper-alpha)) (> n 26))
+ (user-error "Alphabetic lists cannot have more than 26 items"))
+ (let* ((it (adoc--list-item-at-point))
+ (beg (plist-get it :marker-beg))
+ (old (plist-get it :marker))
+ (new (adoc--explicit-marker kind n)))
+ (unless (string= old new)
+ (save-excursion
+ (goto-char beg)
+ (delete-region beg (+ beg (length old)))
+ (insert new))))
+ (setq n (1+ n))
+ (forward-line 1)))))))
+
(defun adoc-calc ()
"(Re-)calculates variables used in adoc-mode.
Needs to be called after changes to certain (customization)
@@ -3551,6 +3744,8 @@ ITEMS is a list of (name pos . level)."
(define-key map (kbd "M-<left>") 'adoc-promote)
(define-key map (kbd "M-<right>") 'adoc-demote)
(define-key map (kbd "M-RET") 'adoc-insert-list-item)
+ (define-key map (kbd "M-<up>") 'adoc-move-list-item-up)
+ (define-key map (kbd "M-<down>") 'adoc-move-list-item-down)
(define-key map "\C-c\C-t" 'adoc-toggle-title-type)
(define-key map "\C-c\C-a" 'adoc-goto-ref-label)
(define-key map "\C-c\C-o" 'adoc-follow-thing-at-point)
@@ -3566,6 +3761,9 @@ ITEMS is a list of (name pos . level)."
["Promote (title / list item)" adoc-promote]
["Demote (title / list item)" adoc-demote]
["Insert list item" adoc-insert-list-item]
+ ["Move list item up" adoc-move-list-item-up]
+ ["Move list item down" adoc-move-list-item-down]
+ ["Renumber list" adoc-renumber-list]
["Toggle title type" adoc-toggle-title-type]
["Adjust title underline" adoc-adjust-title-del]
["Follow thing at point" adoc-follow-thing-at-point]
diff --git a/test/adoc-mode-test.el b/test/adoc-mode-test.el
index 8a544f113a..565e3ca528 100644
--- a/test/adoc-mode-test.el
+++ b/test/adoc-mode-test.el
@@ -1066,6 +1066,78 @@ on top of the `<mark>' default)."
(should-error (adoc-insert-list-item) :type 'user-error)
(should (string-equal (buffer-string) "just some prose"))))
+(ert-deftest adoctest-test-move-list-item-down ()
+ (adoctest-trans "* a!\n* b\n" "* b\n* a\n" '(adoc-move-list-item-down))
+ ;; a missing final newline must not merge the two items into one line
+ (adoctest-trans "* a!\n* b" "* b\n* a\n" '(adoc-move-list-item-down))
+ ;; the item carries its nested sub-items with it
+ (adoctest-trans "* one!\n** sub\n* two\n" "* two\n* one\n** sub\n"
+ '(adoc-move-list-item-down)))
+
+(ert-deftest adoctest-test-move-list-item-up ()
+ (adoctest-trans "* a\n* b!\n" "* b\n* a\n" '(adoc-move-list-item-up))
+ ;; a missing final newline must not merge the two items into one line
+ (adoctest-trans ". one\n. two!" ". two\n. one\n" '(adoc-move-list-item-up))
+ (adoctest-trans "* one\n** sub\n* two!\n" "* two\n* one\n** sub\n"
+ '(adoc-move-list-item-up)))
+
+(ert-deftest adoctest-test-move-list-item-distinct-lists ()
+ ;; a same-level item of a different list type is not a sibling
+ (with-temp-buffer
+ (adoc-mode)
+ (insert "1. alpha\n- bullet\n2. beta\n")
+ (goto-char (point-min))
+ (should-error (adoc-move-list-item-down) :type 'user-error)
+ (should (string-equal (buffer-string) "1. alpha\n- bullet\n2. beta\n"))))
+
+(ert-deftest adoctest-test-move-list-item-no-sibling ()
+ (with-temp-buffer
+ (adoc-mode)
+ (insert "* only\n")
+ (goto-char (point-min))
+ (should-error (adoc-move-list-item-down) :type 'user-error)
+ (should (string-equal (buffer-string) "* only\n")))
+ ;; a shallower neighbour is not a sibling
+ (with-temp-buffer
+ (adoc-mode)
+ (insert "** a\n* b\n")
+ (goto-char (point-min))
+ (should-error (adoc-move-list-item-down) :type 'user-error)
+ (should (string-equal (buffer-string) "** a\n* b\n"))))
+
+(ert-deftest adoctest-test-renumber-list ()
+ (adoctest-trans "1. a!\n1. b\n1. c\n" "1. a\n2. b\n3. c\n"
'(adoc-renumber-list))
+ ;; works from any item in the run, and preserves the first item's start value
+ (adoctest-trans "1. a\n5. b!\n9. c\n" "1. a\n2. b\n3. c\n"
'(adoc-renumber-list))
+ (adoctest-trans "3. a!\n1. b\n" "3. a\n4. b\n" '(adoc-renumber-list))
+ ;; alphabetic lists
+ (adoctest-trans "a. x!\na. y\n" "a. x\nb. y\n" '(adoc-renumber-list))
+ ;; a missing final newline must terminate (not loop forever)
+ (adoctest-trans "1. a!\n9. b" "1. a\n2. b" '(adoc-renumber-list)))
+
+(ert-deftest adoctest-test-renumber-list-alpha-overflow ()
+ (with-temp-buffer
+ (adoc-mode)
+ (dotimes (_ 27) (insert "a. item\n"))
+ (goto-char (point-min))
+ (should-error (adoc-renumber-list) :type 'user-error)))
+
+(ert-deftest adoctest-test-renumber-list-errors ()
+ ;; roman lists are left untouched
+ (with-temp-buffer
+ (adoc-mode)
+ (insert "i) a\nv) b\n")
+ (goto-char (point-min))
+ (should-error (adoc-renumber-list) :type 'user-error)
+ (should (string-equal (buffer-string) "i) a\nv) b\n")))
+ ;; not on an explicitly-numbered list
+ (with-temp-buffer
+ (adoc-mode)
+ (insert "* a\n* b\n")
+ (goto-char (point-min))
+ (should-error (adoc-renumber-list) :type 'user-error)
+ (should (string-equal (buffer-string) "* a\n* b\n"))))
+
(ert-deftest adoctest-test-xref-at-point-1 ()
(unwind-protect
(progn
