branch: elpa/adoc-mode
commit 696af9920c52c44240ef2e74535e2844fe22c5c4
Author: Bozhidar Batsov <[email protected]>
Commit: Bozhidar Batsov <[email protected]>
Add heading navigation commands
Model next/previous heading, forward/backward at the same level, and
up-to-parent on markdown-mode and org-mode. The commands understand both
one-line and two-line titles and skip headings hidden by folding.
Promote/demote move from C-c C-p / C-c C-d to M-left / M-right (org-style)
to free up C-c C-p for previous-heading. Enable outline-minor-mode by
default and widen outline-regexp to cover level-5 (======) titles.
---
CHANGELOG.md | 2 +
README.adoc | 5 +-
adoc-mode.el | 195 ++++++++++++++++++++++++++++++++++++++++++++-----
test/adoc-mode-test.el | 123 +++++++++++++++++++++++++++++++
4 files changed, 306 insertions(+), 19 deletions(-)
diff --git a/CHANGELOG.md b/CHANGELOG.md
index db86b5843b..cd1d2a02bd 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -4,6 +4,7 @@
### New features
+- 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.
- New `adoc-highlight-face` for `#text#` / `##text##` highlighted spans
(inherits the standard `highlight` face); previously these reused
`adoc-gen-face`.
@@ -14,6 +15,7 @@
### Changes
+- Title promotion and demotion move to `M-left` and `M-right` (org-style),
freeing up `C-c C-p` and `C-c C-d` for the new heading-navigation commands.
Previously `adoc-promote` lived on `C-c C-p` and `adoc-demote` on `C-c C-d`.
- `adoc-gen-face`, `adoc-verbatim-face`, `adoc-secondary-text-face`, and
`adoc-replacement-face` now inherit from `font-lock-*` faces instead of
hardcoding literal colours. Themes that style the font-lock palette will now
style AsciiDoc buffers consistently. Users who relied on the old defaults can
restore them via `M-x customize-face`.
- Simplify `adoc-meta-face` to `(:inherit shadow :slant normal :weight
normal)` instead of overriding eleven attributes including `:family
"Monospace"`. AsciiDoc markup characters now respect the user's font choices
and theme `shadow` colour rather than being forced into a monospace family with
hardcoded grays.
- Drop the dated 3D button decoration (`:box (:style released-button)`) and
hardcoded hex colours from `adoc-command-face` and
`adoc-complex-replacement-face`; inherit from `font-lock-builtin-face` instead.
diff --git a/README.adoc b/README.adoc
index a3219cca09..3514377502 100644
--- a/README.adoc
+++ b/README.adoc
@@ -39,10 +39,11 @@ 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.)
-- title management: promote / demote, toggle between one-line and two-line
styles, adjust underline length
+- 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
- 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
-- support for `outline-mode` (one-line title style only)
+- `outline-minor-mode` enabled out of the box for folding (one-line title
style only)
- integration with `flyspell-mode` (skips non-prose regions), comment commands
(`M-;`), and compilation mode
=== Demo
diff --git a/adoc-mode.el b/adoc-mode.el
index a74eb07755..e4036b9d26 100644
--- a/adoc-mode.el
+++ b/adoc-mode.el
@@ -3090,6 +3090,168 @@ and title's text are not preserved, afterwards its
always one space."
(forward-line -1))
(move-to-column saved-col))))
+;;;; Heading navigation
+
+(defun adoc--re-all-titles ()
+ "Return a regexp matching any section title (one-line or two-line)."
+ (let* ((two-line-count (length adoc-two-line-title-del))
+ (core
+ (mapconcat
+ (lambda (level)
+ (if (< level two-line-count)
+ (concat
+ (adoc-re-one-line-title level)
+ "\\|"
+ (adoc-re-two-line-title (nth level adoc-two-line-title-del)))
+ (adoc-re-one-line-title level)))
+ (number-sequence 0 adoc-title-max-level)
+ "\\)\\|\\(?:")))
+ (concat "\\(?:" core "\\)")))
+
+(defun adoc--title-bounds ()
+ "Return (LEVEL START END) when point is on a section title, else nil.
+START and END delimit the whole title (both lines for a two-line
+title); point need not be on the first line."
+ (let ((descriptor (adoc-title-descriptor)))
+ (when descriptor
+ (list (nth 2 descriptor) (nth 4 descriptor) (nth 5 descriptor)))))
+
+(defun adoc--forward-heading ()
+ "Move point to the start of the next section title.
+Return the title's level, or nil if there is no following title.
+Point is left unchanged when nil is returned."
+ (let ((bounds (adoc--title-bounds))
+ (re (adoc--re-all-titles))
+ (orig (point))
+ level)
+ ;; If we're on a title, step past it so we don't match it again.
+ (when bounds (goto-char (nth 2 bounds)))
+ (while (and (not level) (re-search-forward re nil t))
+ (goto-char (match-beginning 0))
+ (let ((descriptor (adoc-title-descriptor)))
+ (if descriptor
+ (setq level (nth 2 descriptor))
+ ;; A regexp match the descriptor rejects; skip the line and retry.
+ (forward-line 1))))
+ (unless level (goto-char orig))
+ level))
+
+(defun adoc--backward-heading ()
+ "Move point to the start of the previous section title.
+Return the title's level, or nil if there is no preceding title.
+Point is left unchanged when nil is returned."
+ (let ((bounds (adoc--title-bounds))
+ (re (adoc--re-all-titles))
+ (orig (point))
+ level)
+ (when bounds (goto-char (nth 1 bounds)))
+ (while (and (not level) (re-search-backward re nil t))
+ (goto-char (match-beginning 0))
+ (let ((descriptor (adoc-title-descriptor)))
+ (when descriptor (setq level (nth 2 descriptor)))))
+ (unless level (goto-char orig))
+ level))
+
+(defun adoc--back-to-heading ()
+ "Move to the title heading the section point is in, return its level.
+Signal a `user-error' when point is before the first section title."
+ (let ((bounds (adoc--title-bounds)))
+ (cond
+ (bounds (goto-char (nth 1 bounds)) (car bounds))
+ (t (let ((level (adoc--backward-heading)))
+ (unless level (user-error "Before first section title"))
+ level)))))
+
+(defun adoc-next-visible-heading (arg)
+ "Move forward to the ARGth next visible section title.
+With a negative ARG, move backward (see
+`adoc-previous-visible-heading')."
+ (interactive "p")
+ (if (< arg 0)
+ (adoc-previous-visible-heading (- arg))
+ (let ((orig (point))
+ level)
+ (dotimes (_ arg)
+ (while (and (setq level (adoc--forward-heading))
+ (invisible-p (point))))
+ (unless level
+ (goto-char orig)
+ (user-error "No following section title"))))))
+
+(defun adoc-previous-visible-heading (arg)
+ "Move backward to the ARGth previous visible section title.
+With a negative ARG, move forward (see
+`adoc-next-visible-heading')."
+ (interactive "p")
+ (if (< arg 0)
+ (adoc-next-visible-heading (- arg))
+ (let ((orig (point))
+ level)
+ (dotimes (_ arg)
+ (while (and (setq level (adoc--backward-heading))
+ (invisible-p (point))))
+ (unless level
+ (goto-char orig)
+ (user-error "No preceding section title"))))))
+
+(defun adoc-forward-same-level (arg)
+ "Move forward to the ARGth next visible title at the same level.
+A title at a shallower (more important) level or the end of the
+buffer stops the search. With a negative ARG, move backward."
+ (interactive "p")
+ (if (< arg 0)
+ (adoc-backward-same-level (- arg))
+ (let ((orig (point))
+ (level (adoc--back-to-heading)))
+ (dotimes (_ arg)
+ (let (target stop found)
+ (while (and (not target) (not stop)
+ (setq found (adoc--forward-heading)))
+ (cond
+ ((< found level) (setq stop t))
+ ((and (= found level) (not (invisible-p (point))))
+ (setq target (point)))))
+ (unless target
+ (goto-char orig)
+ (user-error "No following same-level section title")))))))
+
+(defun adoc-backward-same-level (arg)
+ "Move backward to the ARGth previous visible title at the same level.
+A title at a shallower (more important) level or the start of the
+buffer stops the search. With a negative ARG, move forward."
+ (interactive "p")
+ (if (< arg 0)
+ (adoc-forward-same-level (- arg))
+ (let ((orig (point))
+ (level (adoc--back-to-heading)))
+ (dotimes (_ arg)
+ (let (target stop found)
+ (while (and (not target) (not stop)
+ (setq found (adoc--backward-heading)))
+ (cond
+ ((< found level) (setq stop t))
+ ((and (= found level) (not (invisible-p (point))))
+ (setq target (point)))))
+ (unless target
+ (goto-char orig)
+ (user-error "No preceding same-level section title")))))))
+
+(defun adoc-up-heading (arg)
+ "Move to the visible parent title, ARG levels up."
+ (interactive "p")
+ (let ((orig (point))
+ (level (adoc--back-to-heading)))
+ (dotimes (_ arg)
+ (let (target found)
+ (while (and (not target)
+ (setq found (adoc--backward-heading)))
+ (when (and (< found level) (not (invisible-p (point))))
+ (setq target (point)
+ level found)))
+ (unless target
+ (goto-char orig)
+ (user-error "No parent section title"))))))
+
(defvar sgml-char-names)
(defun adoc-make-unichar-alist ()
@@ -3173,20 +3335,7 @@ LOCAL-ATTRIBUTE-FACE-ALIST before it is looked up in
(defun adoc-imenu-create-index ()
(let* ((index-alist)
- (two-line-count (length adoc-two-line-title-del))
- (re-all-titles-core
- (mapconcat
- (lambda (level)
- (if (< level two-line-count)
- (concat
- (adoc-re-one-line-title level)
- "\\|"
- (adoc-re-two-line-title (nth level adoc-two-line-title-del)))
- (adoc-re-one-line-title level)))
- (number-sequence 0 adoc-title-max-level)
- "\\)\\|\\(?:"))
- (re-all-titles
- (concat "\\(?:" re-all-titles-core "\\)")))
+ (re-all-titles (adoc--re-all-titles)))
(save-restriction
(widen)
(goto-char (point-min))
@@ -3283,14 +3432,25 @@ ITEMS is a list of (name pos . level)."
(defvar adoc-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "\C-c\C-d" 'adoc-demote)
- (define-key map "\C-c\C-p" 'adoc-promote)
+ (define-key map "\C-c\C-n" 'adoc-next-visible-heading)
+ (define-key map "\C-c\C-p" 'adoc-previous-visible-heading)
+ (define-key map "\C-c\C-f" 'adoc-forward-same-level)
+ (define-key map "\C-c\C-b" 'adoc-backward-same-level)
+ (define-key map "\C-c\C-u" 'adoc-up-heading)
+ (define-key map (kbd "M-<left>") 'adoc-promote)
+ (define-key map (kbd "M-<right>") 'adoc-demote)
(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)
(define-key map (kbd "M-.") 'adoc-follow-thing-at-point)
(easy-menu-define adoc-mode-menu map "Menu for adoc mode"
`("AsciiDoc"
+ ["Next heading" adoc-next-visible-heading]
+ ["Previous heading" adoc-previous-visible-heading]
+ ["Forward (same level)" adoc-forward-same-level]
+ ["Backward (same level)" adoc-backward-same-level]
+ ["Up to parent heading" adoc-up-heading]
+ "---"
["Promote" adoc-promote]
["Demote" adoc-demote]
["Toggle title type" adoc-toggle-title-type]
@@ -3498,11 +3658,12 @@ Turning on Adoc mode runs the normal hook
`adoc-mode-hook'."
(add-hook 'font-lock-extend-region-functions #'adoc-font-lock-extend-region
nil t)
;; outline mode
- (setq-local outline-regexp "=\\{1,5\\}[ \t]+[^ \t\n]")
+ (setq-local outline-regexp "=\\{1,6\\}[ \t]+[^ \t\n]")
(setq-local outline-level (lambda ()
(save-excursion
(skip-chars-forward "=")
(current-column))))
+ (outline-minor-mode 1)
;; fill
(add-hook 'fill-nobreak-predicate #'adoc-fill-nobreak-p nil t)
diff --git a/test/adoc-mode-test.el b/test/adoc-mode-test.el
index 9d9df92800..f2e923ebe9 100644
--- a/test/adoc-mode-test.el
+++ b/test/adoc-mode-test.el
@@ -890,6 +890,129 @@ on top of the `<mark>' default)."
(adoctest-trans "lorem!\n========!" "lorem\n=====" '(adoc-adjust-title-del))
(adoctest-trans "lorem!\n=====!" "lorem\n=====" '(adoc-adjust-title-del)))
+;;;; Heading navigation
+
+(defun adoctest-insert-nav-doc ()
+ "Insert a small multi-level document used by the navigation tests."
+ (insert "= Doc Title\n\n"
+ "intro\n\n"
+ "== Section A\n\n"
+ "text a\n\n"
+ "=== Sub A1\n\n"
+ "text\n\n"
+ "=== Sub A2\n\n"
+ "more\n\n"
+ "== Section B\n\n"
+ "end\n"))
+
+(defun adoctest-goto-heading (text)
+ "Move point to the beginning of the line containing TEXT."
+ (goto-char (point-min))
+ (search-forward text)
+ (beginning-of-line))
+
+(ert-deftest adoctest-test-next-visible-heading ()
+ (with-temp-buffer
+ (adoc-mode)
+ (adoctest-insert-nav-doc)
+ (goto-char (point-min))
+ (adoc-next-visible-heading 1)
+ (should (looking-at-p "== Section A$"))
+ (adoc-next-visible-heading 1)
+ (should (looking-at-p "=== Sub A1$"))
+ ;; a count argument moves several headings at once
+ (adoc-next-visible-heading 2)
+ (should (looking-at-p "== Section B$"))
+ ;; nothing past the last heading: point stays put, signals a user-error
+ (let ((pos (point)))
+ (should-error (adoc-next-visible-heading 1) :type 'user-error)
+ (should (= (point) pos)))))
+
+(ert-deftest adoctest-test-previous-visible-heading ()
+ (with-temp-buffer
+ (adoc-mode)
+ (adoctest-insert-nav-doc)
+ (adoctest-goto-heading "Section B")
+ (adoc-previous-visible-heading 1)
+ (should (looking-at-p "=== Sub A2$"))
+ (adoc-previous-visible-heading 2)
+ (should (looking-at-p "== Section A$"))
+ ;; from within a section body it climbs to that section's heading
+ (adoctest-goto-heading "text a")
+ (adoc-previous-visible-heading 1)
+ (should (looking-at-p "== Section A$"))
+ ;; a negative argument moves forward
+ (adoc-previous-visible-heading -1)
+ (should (looking-at-p "=== Sub A1$"))))
+
+(ert-deftest adoctest-test-forward-same-level ()
+ (with-temp-buffer
+ (adoc-mode)
+ (adoctest-insert-nav-doc)
+ ;; level-1 -> level-1, skipping the level-2 subsections in between
+ (adoctest-goto-heading "Section A")
+ (adoc-forward-same-level 1)
+ (should (looking-at-p "== Section B$"))
+ ;; level-2 -> level-2
+ (adoctest-goto-heading "Sub A1")
+ (adoc-forward-same-level 1)
+ (should (looking-at-p "=== Sub A2$"))
+ ;; a shallower heading stops the search; point is restored
+ (adoctest-goto-heading "Sub A2")
+ (let ((pos (point)))
+ (should-error (adoc-forward-same-level 1) :type 'user-error)
+ (should (= (point) pos)))))
+
+(ert-deftest adoctest-test-backward-same-level ()
+ (with-temp-buffer
+ (adoc-mode)
+ (adoctest-insert-nav-doc)
+ (adoctest-goto-heading "Section B")
+ (adoc-backward-same-level 1)
+ (should (looking-at-p "== Section A$"))
+ (adoctest-goto-heading "Sub A2")
+ (adoc-backward-same-level 1)
+ (should (looking-at-p "=== Sub A1$"))
+ ;; a shallower heading stops the search; point is restored
+ (adoctest-goto-heading "Sub A1")
+ (let ((pos (point)))
+ (should-error (adoc-backward-same-level 1) :type 'user-error)
+ (should (= (point) pos)))))
+
+(ert-deftest adoctest-test-up-heading ()
+ (with-temp-buffer
+ (adoc-mode)
+ (adoctest-insert-nav-doc)
+ (adoctest-goto-heading "Sub A1")
+ (adoc-up-heading 1)
+ (should (looking-at-p "== Section A$"))
+ ;; two levels up from a level-2 heading reaches the document title
+ (adoctest-goto-heading "Sub A2")
+ (adoc-up-heading 2)
+ (should (looking-at-p "= Doc Title$"))
+ ;; nothing above the document title: point is restored
+ (adoctest-goto-heading "Doc Title")
+ (let ((pos (point)))
+ (should-error (adoc-up-heading 1) :type 'user-error)
+ (should (= (point) pos)))))
+
+(ert-deftest adoctest-test-nav-two-line-titles ()
+ (with-temp-buffer
+ (adoc-mode)
+ (insert "Doc Title\n=========\n\n"
+ "intro\n\n"
+ "Section A\n---------\n\n"
+ "text\n\n"
+ "Section B\n---------\n\n"
+ "end\n")
+ (goto-char (point-min))
+ (adoc-next-visible-heading 1)
+ (should (looking-at-p "Section A$"))
+ (adoc-forward-same-level 1)
+ (should (looking-at-p "Section B$"))
+ (adoc-up-heading 1)
+ (should (looking-at-p "Doc Title$"))))
+
(ert-deftest adoctest-test-xref-at-point-1 ()
(unwind-protect
(progn
