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 ()

Reply via email to