prog

frontpage - thread list - new thread - preferences - ?

SchemeBBS [part 2]

27 2020-08-01 20:31

lib/markup.scm:string->sxml

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

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

(define (lines->sxml markup l)
  (append-map (lambda (e) 
                (cond ((string? e)
                       (string->sxml markup e))
                      ((eq? (car e) 'del)
                       `(,(cons 'del (lines->sxml markup (cdr e)))))
                      (else `(,e))))
              l))

Besides the various types of false positives in between-code?, the "exception to escape spoiler inside code" is also broken in another way. As soon as a spoiler exception is found, all subsequent spoilers on that line are ignored, including those that are completely outside code.

~~one~~ two ~~three~~ ==ab ~~cd~~ ef== gh ~~four~~ ij

~~one~~ two ~~three~~ ab ~~cd~~ ef gh ~~four~~ ij

This happens because of the

(string->sxml-rec "" (append-element res (string-append s1 substr s2)))

line which exempts the entire s2 from further spoiler processing. The solution is to also return the end position of the closing code tag from between-code?, and use this information to recurse on the s2 portion after that position in string->sxml-rec.

112