<commit_before>(in-package #:cl-markdown)

(defparameter *markup->html*
  (make-container 
   'simple-associative-container
   :test #'equal
   :initial-contents 
   '((header1)    (nil nil "h1")
     (header2)    (nil nil "h2")
     (header3)    (nil nil "h3")
     (header4)    (nil nil "h4")
     (header5)    (nil nil "h5")
     (header6)    (nil nil "h6")
     
     (bullet)     (("ul") ("li") nil)
     (code)       (("pre" "code") nil nil encode-pre)
     (number)     (("ol") ("li") nil)
     (quote)      (("blockquote") nil nil)
     (horizontal-rule) (nil nil "hr"))))

(defvar *magic-space-p* nil)

(defvar *magic-line-p* 0)

(defparameter *magic-space* #\Space)

(defparameter *magic-line* nil)

#+(or)
(setf *magic-space* #\| *magic-line* #\~)

(defgeneric render-to-html (stuff encoding-method)
  (:documentation ""))

(defmethod render ((document document) (style (eql :html)) stream)
  (declare (ignore stream))
  (setf *magic-space-p* nil 
	*magic-line-p* 0)
  (render-to-html document nil))

(defun html-block-markup (chunk)
  (first (markup-class-for-html chunk)))

(defun html-inner-block-markup (chunk)
  (second (markup-class-for-html chunk)))

(defmethod render-to-html ((chunk chunk) encoding-method)
  (bind (((&optional nil nil markup new-method) (markup-class-for-html chunk))
         (paragraph? (paragraph? chunk)))
    (encode-html chunk (or new-method encoding-method)
		 markup (when paragraph? "p"))))
  
;;?? same code as below
(defmethod encode-html ((stuff chunk) encoding-method &rest codes)
  (declare (dynamic-extent codes))
  (setf *magic-line-p* 0)
  (cond ((null codes) 
         (let ((code-p (member 'code (markup-class stuff))))
           (iterate-elements
            (lines stuff)
            (lambda (line)
	      (render-to-html line encoding-method)
	      (when code-p (incf *magic-line-p*))))
	   (fresh-line *output-stream*)))
        ((null (first codes))
         (apply #'encode-html stuff encoding-method (rest codes)))
        (t (format *output-stream* "<~a>" (first codes))
           (apply #'encode-html stuff encoding-method (rest codes))
           (format *output-stream* "</~a>" (first codes))
           (unless (length-1-list-p codes) 
             (terpri *output-stream*)))))


;;?? same code as above
(defmethod encode-html ((stuff list) encoding-method &rest codes)
  (declare (dynamic-extent codes))
  (cond ((null codes) 
         (iterate-elements
          stuff
          (lambda (line)
            (render-to-html line encoding-method))))
        ((null (first codes))
         (apply #'encode-html stuff encoding-method (rest codes)))
        (t (format *output-stream* "<~A>" (first codes))
           (apply #'encode-html stuff encoding-method (rest codes))
           (format *output-stream* "</~A>" (first codes))
           (unless (length-1-list-p codes) 
             (terpri *output-stream*)))))

(defmethod markup-class-for-html ((chunk chunk))
  (when (markup-class chunk)
    (let ((translation (item-at-1 *markup->html* (markup-class chunk))))
      (unless translation 
        (warn "No translation for '~A'" (markup-class chunk)))
      translation)))

(defmethod render-to-html ((chunk list) encoding-method)
  (render-span-to-html (first chunk) (rest chunk) encoding-method))

(defmethod render-to-html ((line string) encoding-method)
  (when *magic-space-p* 
    (setf *magic-space-p* nil)
    (princ *magic-space* *output-stream*))
  (when (> *magic-line-p* 0)
    (when *magic-line*
      (princ *magic-line* *output-stream*))
    (terpri *output-stream*))
  (format *output-stream* "~a"  
	  (funcall (or encoding-method 'encode-string-for-html) line))
  (setf *magic-space-p* t))

(defun output-html (string &rest codes)
  (declare (dynamic-extent codes))
  (cond ((null codes) (princ (first string) *output-stream*))
        (t (format *output-stream* "<~(~a~)>" (first codes))
           (apply #'output-html string (rest codes))
           (format *output-stream* "</~(~a~)>" (first codes)))))

(defmethod render-span-to-html ((code (eql 'strong)) body encoding-method)
  (declare (ignore encoding-method))
  (output-html body 'strong)
  (setf *magic-space-p* nil))

(defmethod render-span-to-html ((code (eql 'mail)) body encoding-method)
  (declare (ignore encoding-method))
  (let ((address (first body)))
    (output-link (format nil "mailto:~A" address) nil address)))

(defmethod render-span-to-html ((code (eql 'emphasis)) body encoding-method)
  (declare (ignore encoding-method))
  (output-html body 'em)
  (setf *magic-space-p* nil))

(defmethod render-span-to-html ((code (eql 'strong-em)) body encoding-method)
  (declare (ignore encoding-method))
  (output-html body 'strong 'em)
  (setf *magic-space-p* nil))

(defmethod render-span-to-html 
    ((code (eql 'escaped-character)) body encoding-method)
  (declare (ignore encoding-method))
  (output-html body))

(defmethod render-span-to-html ((code (eql 'code)) body encoding-method)
  (format *output-stream* "<code>")
  (setf *magic-space-p* nil)<commit_msg>Allow escaping of #\< and #\> too<commit_after>(in-package #:cl-markdown)

(defparameter *markup->html*
  (make-container 
   'simple-associative-container
   :test #'equal
   :initial-contents 
   '((header1)    (nil nil "h1")
     (header2)    (nil nil "h2")
     (header3)    (nil nil "h3")
     (header4)    (nil nil "h4")
     (header5)    (nil nil "h5")
     (header6)    (nil nil "h6")
     
     (bullet)     (("ul") ("li") nil)
     (code)       (("pre" "code") nil nil encode-pre)
     (number)     (("ol") ("li") nil)
     (quote)      (("blockquote") nil nil)
     (horizontal-rule) (nil nil "hr"))))

(defvar *magic-space-p* nil)

(defvar *magic-line-p* 0)

(defparameter *magic-space* #\Space)

(defparameter *magic-line* nil)

#+(or)
(setf *magic-space* #\| *magic-line* #\~)

(defgeneric render-to-html (stuff encoding-method)
  (:documentation ""))

(defmethod render ((document document) (style (eql :html)) stream)
  (declare (ignore stream))
  (setf *magic-space-p* nil 
	*magic-line-p* 0)
  (render-to-html document nil))

(defun html-block-markup (chunk)
  (first (markup-class-for-html chunk)))

(defun html-inner-block-markup (chunk)
  (second (markup-class-for-html chunk)))

(defmethod render-to-html ((chunk chunk) encoding-method)
  (bind (((&optional nil nil markup new-method) (markup-class-for-html chunk))
         (paragraph? (paragraph? chunk)))
    (encode-html chunk (or new-method encoding-method)
		 markup (when paragraph? "p"))))
  
;;?? same code as below
(defmethod encode-html ((stuff chunk) encoding-method &rest codes)
  (declare (dynamic-extent codes))
  (setf *magic-line-p* 0)
  (cond ((null codes) 
         (let ((code-p (member 'code (markup-class stuff))))
           (iterate-elements
            (lines stuff)
            (lambda (line)
	      (render-to-html line encoding-method)
	      (when code-p (incf *magic-line-p*))))
	   (fresh-line *output-stream*)))
        ((null (first codes))
         (apply #'encode-html stuff encoding-method (rest codes)))
        (t (format *output-stream* "<~a>" (first codes))
           (apply #'encode-html stuff encoding-method (rest codes))
           (format *output-stream* "</~a>" (first codes))
           (unless (length-1-list-p codes) 
             (terpri *output-stream*)))))


;;?? same code as above
(defmethod encode-html ((stuff list) encoding-method &rest codes)
  (declare (dynamic-extent codes))
  (cond ((null codes) 
         (iterate-elements
          stuff
          (lambda (line)
            (render-to-html line encoding-method))))
        ((null (first codes))
         (apply #'encode-html stuff encoding-method (rest codes)))
        (t (format *output-stream* "<~A>" (first codes))
           (apply #'encode-html stuff encoding-method (rest codes))
           (format *output-stream* "</~A>" (first codes))
           (unless (length-1-list-p codes) 
             (terpri *output-stream*)))))

(defmethod markup-class-for-html ((chunk chunk))
  (when (markup-class chunk)
    (let ((translation (item-at-1 *markup->html* (markup-class chunk))))
      (unless translation 
        (warn "No translation for '~A'" (markup-class chunk)))
      translation)))

(defmethod render-to-html ((chunk list) encoding-method)
  (render-span-to-html (first chunk) (rest chunk) encoding-method))

(defmethod render-to-html ((line string) encoding-method)
  (when *magic-space-p* 
    (setf *magic-space-p* nil)
    (princ *magic-space* *output-stream*))
  (when (> *magic-line-p* 0)
    (when *magic-line*
      (princ *magic-line* *output-stream*))
    (terpri *output-stream*))
  (format *output-stream* "~a"  
	  (funcall (or encoding-method 'encode-string-for-html) line))
  (setf *magic-space-p* t))

(defun output-html (string &rest codes)
  (declare (dynamic-extent codes))
  (cond ((null codes) (princ (first string) *output-stream*))
        (t (format *output-stream* "<~(~a~)>" (first codes))
           (apply #'output-html string (rest codes))
           (format *output-stream* "</~(~a~)>" (first codes)))))

(defmethod render-span-to-html ((code (eql 'strong)) body encoding-method)
  (declare (ignore encoding-method))
  (output-html body 'strong)
  (setf *magic-space-p* nil))

(defmethod render-span-to-html ((code (eql 'mail)) body encoding-method)
  (declare (ignore encoding-method))
  (let ((address (first body)))
    (output-link (format nil "mailto:~A" address) nil address)))

(defmethod render-span-to-html ((code (eql 'emphasis)) body encoding-method)
  (declare (ignore encoding-method))
  (output-html body 'em)
  (setf *magic-space-p* nil))

(defmethod render-span-to-html ((code (eql 'strong-em)) body encoding-method)
  (declare (ignore encoding-method))
  (output-html body 'strong 'em)
  (setf *magic-space-p* nil))

(defmethod render-span-to-html 
    ((code (eql 'escaped-character)) body encoding-method)
  (declare (ignore encoding-method))
  (let ((char (aref (first body) 0)))
    (cond ((char= #\< char) (princ "&lt;" *output-stream*))
	  ((char= #\> char) (princ "&gt;" *output-stream*))
	  (t (output-html body))))
  (setf *magic-space-p* nil))

(defmethod render-span-to-html ((code (eql 'code)) body encoding-method)
  (format *output-stream* "<code>")
  (setf *magic-space-p* nil)
{'fraction_non_alphanumeric': 0.17602959789699152, 'fraction_numerical': 0.003797098627202804, 'mean_word_length': 3.1722177091795287, 'pattern_counts': {'":': 0, '<': 19, '<?xml version=': 0, '>': 25, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2073527', 'n_tokens_mistral': 3591, 'n_tokens_neox': 3418, 'n_words': 928}