[2/3]
--- lib/markup.scm 2020-06-18 10:33:06.355741000 +0000
+++ lib/markup-fix.scm 2020-08-04 13:36:44.240919125 +0000
@@ -94,40 +94,58 @@
(define (string->sxml markup s)
- (define (string->sxml-rec s res)
- (let ((match (irregex-search (regex markup) s)))
- (cond ((string-null? s)
- res)
- ((not match)
- (append-element res s))
- (else
- (let* ((start (irregex-match-start-index match))
- (end (irregex-match-end-index match))
+ (define (string->sxml-iter s res isdel bc-close-failed)
+ (if (string-null? s)
+ res
+ (let ((match (irregex-search (regex markup) s)))
+ (if (not match)
+ (string->sxml-iter "" (cons s res) isdel bc-close-failed)
+ (let* ((start (irregex-match-start-index match))
+ (end (irregex-match-end-index match))
(substr (irregex-match-substring match))
- (s1 (substring s 0 start))
- (s2 (substring s end (string-length s))))
- (if (string-null? s1)
- (string->sxml-rec
- s2
- (append-element res ((transform markup) substr)))
- (if (and (eq? (name markup) 'del) ;; exception to escape spoiler inside code
- (between-code? s1 s2))
- (string->sxml-rec "" (append-element res (string-append s1 substr s2)))
- (string->sxml-rec
- s2
- (append-element res s1 ((transform markup) substr))))))))))
- (string->sxml-rec s '()))
+ (s1 (substring s 0 start))
+ (s2 (substring s end (string-length s))))
+ (cond ((string-null? s1)
+ (string->sxml-iter s2 (cons ((transform markup) substr) res) isdel bc-close-failed))
+ ((and isdel (not bc-close-failed)) ;; exception to escape spoiler inside code
+ (let ((pos (between-code? s1 s2)))
+ (if (< pos 0)
+ (string->sxml-iter s2 (cons ((transform markup) substr) (cons s1 res)) isdel (= pos -2))
+ (string->sxml-iter (string-tail s2 pos) (cons (string-append s1 substr (string-head s2 pos)) res) isdel #f))))
+ (else
+ (string->sxml-iter s2 (cons ((transform markup) substr) (cons s1 res)) isdel bc-close-failed))))))))
+ (reverse (string->sxml-iter s '() (eq? (name markup) 'del) #f)))
-;; edge false positive (between-code? "==code== ==code==" "==")
-;; could add another pass of spoiler, but ok good-enough
(define (between-code? s1 s2)
- (let ((m1 (irregex-search (irregex ".*==$|.*==[^ ]") s1)) ;opening code in s1
- (m2 (irregex-search (irregex ".*[^ ]==") s1)) ;closing code in s1
- (m3 (irregex-search (irregex "^==|.*?[^ ]==") s2)) ;closing code in s2
- (imei irregex-match-end-index))
- (if (and m1 m3 (or (not m2) (>= (imei m1) (imei m2))))
- #t
- #f)))
+ (if (between-code-scan-open s1)
+ (if (and (>= (string-length s2) 2)
+ (substring=? s2 0 2 "==" 0 2))
+ 2
+ (let ((m (irregex-search between-code-irx-close s2)))
+ (if (irregex-match-data? m)
+ (irregex-match-end-index m)
+ -2)))
+ -1))
+
+(define between-code-irx-open
+ (irregex "==[^ ]"))
+
+(define between-code-irx-close
+ (irregex "[^ ]=="))
+
+(define (between-code-scan-open s)
+ (define (iter pos end irx)
+ (let ((match (irregex-search irx s pos end)))
+ (if (not match)
+ pos
+ (iter (irregex-match-end-index match)
+ end irx))))
+ (let* ((slen (string-length s))
+ (pos (iter 0 slen (regex code)))
+ (open (irregex-search between-code-irx-open s pos slen)))
+ (or (irregex-match-data? open)
+ (and (>= (- slen pos) 2)
+ (substring=? s (- slen 2) slen "==" 0 2)))))
(define (lines->sxml markup l)
(append-map (lambda (e)
@@ -152,25 +170,25 @@
(define bold
(transform-rule
'bold
- (irregex "\\*\\*[^ ].*?[^ ]\\*\\*|\\*\\*[^ ]\\*\\*")
+ (irregex "\\*\\*[^ ](?!\\*\\*).*?[^ ]\\*\\*|\\*\\*[^ ]\\*\\*")
(lambda (sub) `(b ,(substring sub 2 (- (string-length sub) 2))))))
(define italic
(transform-rule
'italic
- (irregex "__[^ ].*?[^ ]__|__[^ ]__")
+ (irregex "__[^ ](?!__).*?[^ ]__|__[^ ]__")
(lambda (sub) `(i ,(substring sub 2 (- (string-length sub) 2))))))
(define code
(transform-rule
'code
- (irregex "==[^ ].*?[^ ]==|==[^ ]==")
+ (irregex "==[^ ](?!==).*?[^ ]==|==[^ ]==")
(lambda (sub) `(code ,(substring sub 2 (- (string-length sub) 2))))))
(define del
(transform-rule
'del
- (irregex "~~[^ ].*?[^ ]~~|~~[^ ]~~")
+ (irregex "~~[^ ](?!~~).*?[^ ]~~|~~[^ ]~~")
(lambda (sub) `(del ,(substring sub 2 (- (string-length sub) 2))))))
(define quotelink