branch: elpa/adoc-mode
commit 3eecec5d648d5761e41fbf3b1eba77b885a660fa
Author: Bozhidar Batsov <[email protected]>
Commit: Bozhidar Batsov <[email protected]>
Add region-aware text-styling commands
Add a C-c C-s prefix map of styling commands modelled on markdown-mode:
bold, italic, monospace, highlight, super/subscript, and link. The
markup commands wrap the active region or the word at point, toggle the
markup off when it is already wrapped, and insert an empty delimiter
pair when there is nothing to act on. adoc-insert-link prompts for a URL
and label and replaces the active region.
---
CHANGELOG.md | 1 +
README.adoc | 1 +
adoc-mode.el | 118 +++++++++++++++++++++++++++++++++++++++++++++++++
test/adoc-mode-test.el | 57 ++++++++++++++++++++++++
4 files changed, 177 insertions(+)
diff --git a/CHANGELOG.md b/CHANGELOG.md
index af2b323b0a..a28584aafd 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -4,6 +4,7 @@
### New features
+- Add region-aware text-styling commands under the `C-c C-s` prefix, modelled
on `markdown-mode`: `adoc-insert-bold` (`C-c C-s b`, `*text*`),
`adoc-insert-italic` (`i`, `_text_`), `adoc-insert-monospace` (`m`, `` `text`
``), `adoc-insert-highlight` (`h`, `#text#`), `adoc-insert-superscript` (`^`,
`^text^`), `adoc-insert-subscript` (`~`, `~text~`), and `adoc-insert-link`
(`l`). Each wraps the active region or the word at point, removes the markup
again when it is already wrapped, and inse [...]
- Add outline cycling commands modelled on `org-mode` and `markdown-mode`:
`adoc-cycle` (`TAB`) rotates the visibility of the section subtree at point
(folded / child titles / fully shown) when point is on a one-line title, and
otherwise indents as usual; `adoc-cycle-buffer` (`S-TAB`) rotates the whole
buffer between overview, contents, and show-all. Both build on the
`outline-cycle` / `outline-cycle-buffer` primitives.
- 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.
diff --git a/README.adoc b/README.adoc
index 6d50179d91..1d253115fb 100644
--- a/README.adoc
+++ b/README.adoc
@@ -39,6 +39,7 @@ Here are some of the main features of `adoc-mode`:
- font-lock support for Asciidoctor inline macros (`kbd:[]`, `btn:[]`,
`menu:[]`, etc.)
- inline image preview with right-click context menus and remote image support
- ~50 tempo templates for inserting AsciiDoc markup (formatting, titles,
blocks, lists, macros, etc.)
+- region-aware text-styling commands under `C-c C-s` (bold, italic, monospace,
highlight, super/subscript, link) that wrap the active region or word at point
and toggle the markup off when it's already there
- 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` 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
diff --git a/adoc-mode.el b/adoc-mode.el
index 5b6b1f4540..c3001eda4e 100644
--- a/adoc-mode.el
+++ b/adoc-mode.el
@@ -3582,6 +3582,114 @@ contents (all titles, no bodies), and the fully
expanded buffer
(interactive)
(outline-cycle-buffer))
+;;;; Text styling
+
+(defun adoc--insert-markup (left right)
+ "Wrap the active region or the word at point with LEFT and RIGHT.
+If the region (or word) is already wrapped with those delimiters,
+remove them instead, so the command toggles the markup off. With
+no region and no word at point, insert the delimiters and leave
+point between them."
+ (let ((ll (length left))
+ (rl (length right)))
+ (cond
+ ((use-region-p)
+ (let ((beg (region-beginning))
+ (end (region-end)))
+ (cond
+ ;; Delimiters sit just outside the region: unwrap them.
+ ((and (>= (- beg ll) (point-min))
+ (<= (+ end rl) (point-max))
+ (string= (buffer-substring-no-properties (- beg ll) beg) left)
+ (string= (buffer-substring-no-properties end (+ end rl)) right))
+ (delete-region end (+ end rl))
+ (delete-region (- beg ll) beg)
+ (goto-char (- end ll)))
+ ;; Delimiters sit just inside the region: unwrap them.
+ ((and (>= (- end beg) (+ ll rl))
+ (string= (buffer-substring-no-properties beg (+ beg ll)) left)
+ (string= (buffer-substring-no-properties (- end rl) end) right))
+ (delete-region (- end rl) end)
+ (delete-region beg (+ beg ll))
+ (goto-char (- end ll rl)))
+ (t
+ (goto-char end)
+ (insert right)
+ (goto-char beg)
+ (insert left)
+ (goto-char (+ end ll rl))))))
+ ((thing-at-point 'word)
+ (let* ((bounds (bounds-of-thing-at-point 'word))
+ (beg (car bounds))
+ (end (cdr bounds)))
+ (goto-char end)
+ (insert right)
+ (goto-char beg)
+ (insert left)
+ (goto-char (+ end ll rl))))
+ (t
+ (insert left right)
+ (backward-char rl)))))
+
+(defun adoc-insert-bold ()
+ "Make the region or word at point bold (`*text*'), or toggle it off."
+ (interactive)
+ (adoc--insert-markup "*" "*"))
+
+(defun adoc-insert-italic ()
+ "Emphasise the region or word at point (`_text_'), or toggle it off."
+ (interactive)
+ (adoc--insert-markup "_" "_"))
+
+(defun adoc-insert-monospace ()
+ "Make the region or word at point monospaced (\\=`text\\=`), or toggle it
off."
+ (interactive)
+ (adoc--insert-markup "`" "`"))
+
+(defun adoc-insert-highlight ()
+ "Highlight the region or word at point (`#text#'), or toggle it off."
+ (interactive)
+ (adoc--insert-markup "#" "#"))
+
+(defun adoc-insert-superscript ()
+ "Superscript the region or word at point (`^text^'), or toggle it off."
+ (interactive)
+ (adoc--insert-markup "^" "^"))
+
+(defun adoc-insert-subscript ()
+ "Subscript the region or word at point (`~text~'), or toggle it off."
+ (interactive)
+ (adoc--insert-markup "~" "~"))
+
+(defun adoc-insert-link (url &optional text)
+ "Insert an AsciiDoc link to URL labelled TEXT.
+Interactively, prompt for both; an active region supplies the
+default link text and is replaced by the link. When TEXT is
+empty, a bare URL is inserted."
+ (interactive
+ (let ((region (when (use-region-p)
+ (buffer-substring-no-properties
+ (region-beginning) (region-end)))))
+ (list (read-string "URL: ")
+ (read-string "Link text: " region))))
+ (when (use-region-p)
+ (delete-region (region-beginning) (region-end)))
+ (insert url)
+ (when (and text (> (length text) 0))
+ (insert "[" text "]")))
+
+(defvar adoc-style-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "b" 'adoc-insert-bold)
+ (define-key map "i" 'adoc-insert-italic)
+ (define-key map "m" 'adoc-insert-monospace)
+ (define-key map "h" 'adoc-insert-highlight)
+ (define-key map "l" 'adoc-insert-link)
+ (define-key map "^" 'adoc-insert-superscript)
+ (define-key map "~" 'adoc-insert-subscript)
+ map)
+ "Keymap for AsciiDoc text-styling commands, bound to \\`C-c C-s'.")
+
(defvar sgml-char-names)
(defun adoc-make-unichar-alist ()
@@ -3774,6 +3882,7 @@ ITEMS is a list of (name pos . level)."
(define-key map (kbd "M-<down>") 'adoc-move-list-item-down)
(define-key map (kbd "TAB") 'adoc-cycle)
(define-key map (kbd "<backtab>") 'adoc-cycle-buffer)
+ (define-key map "\C-c\C-s" adoc-style-map)
(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)
@@ -3795,6 +3904,15 @@ ITEMS is a list of (name pos . level)."
["Move list item up" adoc-move-list-item-up]
["Move list item down" adoc-move-list-item-down]
["Renumber list" adoc-renumber-list]
+ "---"
+ ("Styling"
+ ["Bold" adoc-insert-bold]
+ ["Italic" adoc-insert-italic]
+ ["Monospace" adoc-insert-monospace]
+ ["Highlight" adoc-insert-highlight]
+ ["Superscript" adoc-insert-superscript]
+ ["Subscript" adoc-insert-subscript]
+ ["Link" adoc-insert-link])
["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 2923c3da64..d0135005b6 100644
--- a/test/adoc-mode-test.el
+++ b/test/adoc-mode-test.el
@@ -1056,6 +1056,63 @@ on top of the `<mark>' default)."
(adoc-cycle-buffer)
(should-not (outline-invisible-p body)))))
+;;;; Text styling
+
+(ert-deftest adoctest-test-insert-markup-word ()
+ ;; with no region, the word at point is wrapped
+ (adoctest-trans "foo!" "*foo*" '(adoc-insert-bold))
+ (adoctest-trans "foo!" "_foo_" '(adoc-insert-italic))
+ (adoctest-trans "foo!" "`foo`" '(adoc-insert-monospace))
+ (adoctest-trans "foo!" "#foo#" '(adoc-insert-highlight))
+ (adoctest-trans "foo!" "^foo^" '(adoc-insert-superscript))
+ (adoctest-trans "foo!" "~foo~" '(adoc-insert-subscript)))
+
+(ert-deftest adoctest-test-insert-markup-empty ()
+ ;; with neither region nor word, insert an empty pair
+ (adoctest-trans "!" "**" '(adoc-insert-bold)))
+
+(ert-deftest adoctest-test-insert-bold-region ()
+ (with-temp-buffer
+ (adoc-mode)
+ (insert "foo bar baz")
+ (goto-char 5) (set-mark 8) (activate-mark) ; region "bar"
+ (adoc-insert-bold)
+ (should (string-equal (buffer-string) "foo *bar* baz"))))
+
+(ert-deftest adoctest-test-insert-bold-toggle-off ()
+ ;; delimiters just outside the region are removed
+ (with-temp-buffer
+ (adoc-mode)
+ (insert "foo *bar* baz")
+ (goto-char 6) (set-mark 9) (activate-mark) ; region "bar"
+ (adoc-insert-bold)
+ (should (string-equal (buffer-string) "foo bar baz")))
+ ;; delimiters inside the region are removed too
+ (with-temp-buffer
+ (adoc-mode)
+ (insert "foo *bar* baz")
+ (goto-char 5) (set-mark 10) (activate-mark) ; region "*bar*"
+ (adoc-insert-bold)
+ (should (string-equal (buffer-string) "foo bar baz"))))
+
+(ert-deftest adoctest-test-insert-link ()
+ (with-temp-buffer
+ (adoc-mode)
+ (adoc-insert-link "https://example.com" "Example")
+ (should (string-equal (buffer-string) "https://example.com[Example]")))
+ ;; an empty label yields a bare URL
+ (with-temp-buffer
+ (adoc-mode)
+ (adoc-insert-link "https://example.com" "")
+ (should (string-equal (buffer-string) "https://example.com")))
+ ;; an active region is replaced by the link
+ (with-temp-buffer
+ (adoc-mode)
+ (insert "see here now")
+ (goto-char 5) (set-mark 9) (activate-mark) ; region "here"
+ (adoc-insert-link "https://x.com" "here")
+ (should (string-equal (buffer-string) "see https://x.com[here] now"))))
+
;;;; List editing
(ert-deftest adoctest-test-list-promote-demote-unordered ()