[nongnu] elpa/adoc-mode 2a088d1e83 020/199: added meta-face-cleanup, initial version

[ELPA Syncer]

branch: elpa/adoc-mode
commit 2a088d1e834ac8ac81825039de47d00f6d161f17
Author: Florian Kaufmann <sensorflo@gmail.com>
Commit: Florian Kaufmann <sensorflo@gmail.com>

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