branch: elpa/adoc-mode
commit 2a088d1e834ac8ac81825039de47d00f6d161f17
Author: Florian Kaufmann <[email protected]>
Commit: Florian Kaufmann <[email protected]>
added meta-face-cleanup, initial version
---
adoc-mode-test.el | 17 +++++++++++++++++
adoc-mode.el | 26 ++++++++++++++++++++++++++
2 files changed, 43 insertions(+)
diff --git a/adoc-mode-test.el b/adoc-mode-test.el
index a4ba94d4ae..79e2f3a5d6 100644
--- a/adoc-mode-test.el
+++ b/adoc-mode-test.el
@@ -168,4 +168,21 @@
"+" markup-meta-face "\n" nil
"2nd list paragraph\n" nil ))
+(ert-deftest adoctest-test-meta-face-cleanup ()
+ ;; begin with a few simple explicit cases which are easier to debug in case
of troubles
+ (adoctest-faces
+ "*" markup-meta-hide-face "lorem " markup-strong-face
+ "_" markup-meta-hide-face "ipsum" '(markup-strong-face
markup-emphasis-face) "_" markup-meta-hide-face
+ " dolor" markup-strong-face "*" markup-meta-hide-face "\n" nil)
+ (adoctest-faces
+ "_" markup-meta-hide-face "lorem " markup-emphasis-face
+ "*" markup-meta-hide-face "ipsum" '(markup-strong-face
markup-emphasis-face) "*" markup-meta-hide-face
+ " dolor" markup-emphasis-face "_" markup-meta-hide-face "\n" nil)
+
+ ;; now test all possible cases
+ ;; mmm, that is all possible cases inbetween constrained/unconstrained quotes
+
+ ;; .... todo
+ )
+
(ert-run-tests-interactively "^adoctest-test-")
diff --git a/adoc-mode.el b/adoc-mode.el
index 3262668f84..c80e75e96b 100644
--- a/adoc-mode.el
+++ b/adoc-mode.el
@@ -957,6 +957,29 @@ When LITERAL-P is non-nil, the contained text is literal
text."
'adoc-flf-first-whites-fixed-width
'(1 adoc-align t)))
+;; ensures that faces from the markup-text group don't overwrite faces from the
+;; markup-meta group
+(defun adoc-flf-meta-face-cleanup (end)
+ (while (< (point) end)
+ (let* ((next-pos (next-single-property-change (point) 'face nil end))
+ (faces-raw (get-text-property (point) 'face))
+ (faces (if (listp faces-raw) faces-raw (list faces-raw)))
+ newfaces
+ meta-p)
+ (while faces
+ (if (member (car faces) '(markup-meta-hide-face markup-command-face
markup-attribute-face markup-value-face markup-complex-replacement-face
markup-list-face markup-table-face markup-table-row-face markup-table-cell-face
markup-anchor-face markup-internal-reference-face markup-comment-face
markup-preprocessor-face))
+ (progn
+ (setq meta-p t)
+ (setq newfaces (cons (car faces) newfaces)))
+ (if (not (string-match "markup-" (symbol-name (car faces))))
+ (setq newfaces (cons (car faces) newfaces))))
+ (setq faces (cdr faces)))
+ (if meta-p
+ (put-text-property (point) next-pos 'face
+ (if (= 1 (length newfaces)) (car newfaces)
newfaces)))
+ (goto-char next-pos)))
+ nil)
+
(defun adoc-unfontify-region-function (beg end)
;;
(font-lock-default-unfontify-region beg end)
@@ -1462,6 +1485,9 @@ When LITERAL-P is non-nil, the contained text is literal
text."
;; wanted to add a normal paragraph. List paragraphs are appended
;; implicitely.
(list "^\\(\\+[ \t]*\\)\n\\([ \t]+\\)[^ \t\n]" '(1 adoc-warning t) '(2
adoc-warning t))
+
+ ;; cleanup
+ (list 'adoc-flf-meta-face-cleanup)
))
(defun adoc-show-version ()
