branch: elpa/adoc-mode
commit fb170735f8d5c5249058196e1e7c0ba2f0f1bf46
Author: Florian Kaufmann <sensor...@gmail.com>
Commit: Florian Kaufmann <sensor...@gmail.com>
bugfixes and new tests for promote/denote/toggle title
---
adoc-mode-test.el | 71 ++++++++++++++++++++++++++++++++++++-------------------
adoc-mode.el | 40 +++++++++++++++++++++----------
2 files changed, 75 insertions(+), 36 deletions(-)
diff --git a/adoc-mode-test.el b/adoc-mode-test.el
index 16afb6500b..51221b296a 100644
--- a/adoc-mode-test.el
+++ b/adoc-mode-test.el
@@ -57,16 +57,29 @@
;; tear-down
(kill-buffer buf-name))))
-(defun adoctest-trans (original-text expected-text transform-fn &optional args)
- (let ((pos 0)
- (line 0))
- (while (and (< pos (length original-text))
- (setq pos (string-match "\n\\|\\'" original-text pos)))
- (adoctest-trans-inner original-text expected-text transform-fn args line)
- (setq line (1+ line))
- (setq pos (1+ pos)))))
-
-(defun adoctest-trans-inner (original-text expected-text transform-fn args
line)
+(defun adoctest-trans (original-text expected-text transform)
+ (if (string-match "!" original-text)
+ ;; original-text has ! markers
+ (let ((pos 0)
+ (pos-old 0)
+ (pos-list)
+ (new-original-text ""))
+ ;; original-text -> new-original-text by removing ! and remembering
their positions
+ (while (and (< pos (length original-text))
+ (setq pos (string-match "!" original-text pos)))
+ (setq new-original-text (concat new-original-text (substring
original-text pos-old pos)))
+ (setq pos-list (cons (length new-original-text) pos-list))
+ (setq pos (1+ pos))
+ (setq pos-old pos))
+ (setq new-original-text (concat new-original-text (substring
original-text pos-old pos)))
+ ;; run adoctest-trans-inner for each remembered pos
+ (while pos-list
+ (adoctest-trans-inner new-original-text expected-text transform (car
pos-list))
+ (setq pos-list (cdr pos-list))))
+ ;; original-text has no ! markers
+ (adoctest-trans-inner original-text expected-text transform)))
+
+(defun adoctest-trans-inner (original-text expected-text transform &optional
pos)
(let ((not-done t)
(font-lock-support-mode))
(unwind-protect
@@ -76,9 +89,10 @@
(delete-region (point-min) (point-max))
(adoc-mode)
(insert original-text)
- (goto-line line)
+ (when pos
+ (goto-char pos))
;; exercise
- (funcall transform-fn args)
+ (eval transform)
;; verify
(should (string-equal (buffer-substring (point-min) (point-max))
expected-text)))
;; tear-down
@@ -489,24 +503,33 @@
"lorem ** ipsum " markup-gen-face "::" markup-list-face " " nil "sit **
dolor" 'no-face))
(ert-deftest adoctest-test-promote-title ()
- (adoctest-trans "= foo" "== foo" 'adoc-promote-title 1)
- (adoctest-trans "===== foo" "= foo" 'adoc-promote-title 1)
- (adoctest-trans "== foo" "==== foo" 'adoc-promote-title 2)
+ (adoctest-trans "= foo" "== foo" '(adoc-promote-title 1))
+ (adoctest-trans "===== foo" "= foo" '(adoc-promote-title 1))
+ (adoctest-trans "== foo" "==== foo" '(adoc-promote-title 2))
- (adoctest-trans "= foo =" "== foo ==" 'adoc-promote-title 1)
- (adoctest-trans "===== foo =====" "= foo =" 'adoc-promote-title 1)
- (adoctest-trans "== foo ==" "==== foo ====" 'adoc-promote-title 2)
+ (adoctest-trans "= foo =" "== foo ==" '(adoc-promote-title 1))
+ (adoctest-trans "===== foo =====" "= foo =" '(adoc-promote-title 1))
+ (adoctest-trans "== foo ==" "==== foo ====" '(adoc-promote-title 2))
- (adoctest-trans "foo\n===" "foo\n---" 'adoc-promote-title 1)
- (adoctest-trans "foo\n+++" "foo\n===" 'adoc-promote-title 1)
- (adoctest-trans "foo\n---" "foo\n^^^" 'adoc-promote-title 2))
+ (adoctest-trans "foo!\n===!" "foo\n---" '(adoc-promote-title 1))
+ (adoctest-trans "foo!\n+++!" "foo\n===" '(adoc-promote-title 1))
+ (adoctest-trans "foo!\n---!" "foo\n^^^" '(adoc-promote-title 2)))
;; since it's a whitebox test we know denote and promote only differ by inverse
;; arg. So denote doesn't need to be throuhly tested again
(ert-deftest adoctest-test-denote-title ()
- (adoctest-trans "= foo" "===== foo" 'adoc-denote-title 1)
- (adoctest-trans "= foo =" "===== foo =====" 'adoc-denote-title 1)
- (adoctest-trans "foo\n===" "foo\n+++" 'adoc-denote-title 1))
+ (adoctest-trans "= foo" "===== foo" '(adoc-denote-title 1))
+ (adoctest-trans "= foo =" "===== foo =====" '(adoc-denote-title 1))
+ (adoctest-trans "foo!\n===!" "foo\n+++" '(adoc-denote-title 1)))
+
+;; todo: test after transition point is still on title lines
+(ert-deftest adoctest-test-toggle-title-type ()
+ (adoctest-trans "= one" "one\n===" '(adoc-toggle-title-type))
+ (adoctest-trans "two!\n===!" "= two" '(adoc-toggle-title-type))
+ (adoctest-trans "= three!\nbar" "three\n=====\nbar"
'(adoc-toggle-title-type))
+ (adoctest-trans "four!\n====!\nbar" "= four\nbar" '(adoc-toggle-title-type))
+ (adoctest-trans "= five" "= five =" '(adoc-toggle-title-type t))
+ (adoctest-trans "= six =" "= six" '(adoc-toggle-title-type t)))
(ert-deftest adoctest-pre-test-byte-compile ()
;; todo: also test for warnings
diff --git a/adoc-mode.el b/adoc-mode.el
index 57ba3b39f5..b14c2b8df4 100644
--- a/adoc-mode.el
+++ b/adoc-mode.el
@@ -406,15 +406,18 @@ match-data has this sub groups:
4 trailing delimiter only inclusive whites between title text and delimiter
0 only chars that belong to the title block element
-== my title == n
---12------23----
- 4-4"
+== my title == n
+---12------23------
+ 4--4"
(let* ((del (if level
(make-string (+ level 1) ?=)
(concat "=\\{1," (+ adoc-title-max-level 1) "\\}"))))
(concat
"^\\(" del "[ \t]+\\)" ; 1
"\\([^ \t\n].*?\\)" ; 2
+ ;; using \n instad $ is important so group 3 is guaranteed to be at least
1
+ ;; char long (except when at the end of the buffer()). That is important
to
+ ;; to have a place to put the text property adoc-reserved on.
"\\(\\([ \t]+" del "\\)?[ \t]*\\(?:\n\\|\\'\\)\\)" ))) ; 3 & 4
(defun adoc-make-one-line-title (sub-type level text)
@@ -441,7 +444,9 @@ a two line title underline, see also
`adoc-re-two-line-title'."
(regexp-quote (substring x 0 1)) "?"
"\\)"))
(if del (list del) adoc-two-line-title-del) "\\|")
- "\\)[ \t]*$"))
+ ;; adoc-re-two-line-title shall have same behaviour als one line, thus
+ ;; also here use \n instead $
+ "\\)[ \t]*\\(?:\n\\|\\'\\)"))
;; asciidoc.conf regexps for _first_ line
;; ^(?P<title>.*?)$
@@ -1812,7 +1817,7 @@ trailing delimiter ('== my title ==').
(when found
(list type sub-type level text (match-beginning 0) (match-end 0))))))
-(defun adoc-make-title(descriptor)
+(defun adoc-make-title (descriptor)
(let ((type (nth 0 descriptor))
(sub-type (nth 1 descriptor))
(level (nth 2 descriptor))
@@ -1851,6 +1856,7 @@ and title's text are not preserved, afterwards its always
one space."
(let ((descriptor (adoc-title-descriptor)))
(if (or create (not descriptor))
(error "Point is not on a title"))
+
;; todo: set descriptor to default
;; (if (not descriptor)
;; (setq descriptor (list 1 1 2 ?? adoc-default-title-type
adoc-default-title-sub-type)))
@@ -1889,16 +1895,26 @@ and title's text are not preserved, afterwards its
always one space."
(start (nth 4 descriptor))
(end (nth 5 descriptor))
(saved-col (current-column)))
+
+ ;; set new title descriptor
(setcar (nthcdr 0 descriptor) new-type-val)
(setcar (nthcdr 1 descriptor) new-sub-type-val)
(setcar (nthcdr 2 descriptor) new-level)
- (beginning-of-line)
- (when (and (eq type 2) (looking-at (adoc-re-two-line-title-undlerline)))
- (forward-line -1)
- (beginning-of-line))
- (delete-region start end)
- (insert (adoc-make-title descriptor))
- (when (eq new-type-val 2)
+
+ ;; replace old title by new
+ (let ((end-char (char-before end)))
+ (beginning-of-line)
+ (when (and (eq type 2) (looking-at (adoc-re-two-line-title-undlerline)))
+ (forward-line -1)
+ (beginning-of-line))
+ (delete-region start end)
+ (insert (adoc-make-title descriptor))
+ (when (equal end-char ?\n)
+ (insert "\n")
+ (forward-line -1)))
+
+ ;; reposition point
+ (when (and (eq new-type-val 2) (eq type 1))
(forward-line -1))
(move-to-column saved-col))))
