<commit_before>
(in-package :smarkup)

(named-readtables:in-readtable quote-reader)

(defparameter *html-element-transformation*
  `((:example      . :pre)
    (:sidebarhead  . (:div :class "sidebarhead"))
    (:sidebar      . (:div :class "sidebar"))
    (:note         . (:div :class "note"))
    #+nil (:title        . (:div :class "title"))
    (:note-ref     . :sup)
    (:bullets      . :ul)
    (:list         . :ul)
    (:item         . :li)
    (:results      . (:code :class "results"))
    (:figure       . (:table :class "figure"))
    (:figure*      . (:table :class "figure"))
    (:subfigure    . (:div :class "subfigure"))
    (:newline     . :br)))

(defparameter *xhtml-header*
  #q{<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE html 
     PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
     "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">})

(defparameter *stream* nil)

(defun html-citation (tag body)
  (declare (ignore tag))
  `(:span
    ,@(loop for ref in body
         collect
         (let ((refnum (get-bib-order ref)))
           `((:a :href
                 ,(format nil "#ref~A" refnum))
             ,(format nil "[~A]" refnum))))))

(defun citation-string (cite)
  (let ((refnum (get-bib-order cite)))
    `((:a :name
          ,(format nil "ref~A" refnum))
      ,(format nil "~A. ~A"
               refnum
               (cite-text cite)))))

(defun html-bibliography (tag body)
  (declare (ignore tag body))
  `(:div
    (:h1 "References")
    ,@(loop for cite in (reverse *cite-keys*)
         collect `(:p ,(citation-string cite)))))
    
(defun htmlize-image (tag body)
  (declare (ignore tag))
  (destructuring-bind (src &key width types) body
    (declare (ignore width))
    (when types
      (let ((src2 (find-file-for-types src types)))
        (when src2 (setf src (enough-namestring src2)))))
    `((:img :src ,src))))

(defun htmlize-url (tag body)
  (declare (ignore tag))
  `(:a :href ,@body ,@body))

(defun htmlize-href (tag body)
  (declare (ignore tag))
  (destructuring-bind ((hreftag href) (texttag text)) body
    (declare (ignore hreftag texttag))
    `(:a :href ,href ,text)))

(defun htmlize-header (tag body)
  (destructuring-bind (heading &rest rest &key clearpage no-number &allow-other-keys) body
    (declare (ignore clearpage no-number))
    `(,tag ,@(cons heading (remove-from-plist rest :clearpage :no-number)))))

(defun transform-sexp (sexp)
  (if (and (listp sexp) (car sexp))
      (let ((xfrm (cdr (assoc (car sexp) *html-element-transformation*))))
        (cond ((null xfrm) sexp)
              ((and (symbolp xfrm) (fboundp xfrm))
               (funcall (symbol-function xfrm) (car sexp) (cdr sexp)))
              (t (setf (car sexp) xfrm)
                 sexp)))
      sexp))

  
;;;
;;; * input is a list of S-expressions, of the form:
;;;   (tag &rest content)
;;; * tag can be either a keyword (like :p)
;;;   or a list (like (:a :href "http://myurl.com"))

(defun keyword-to-string (keyword)
  (string-downcase (symbol-name keyword)))

(defun attributes-to-list (attr)
  (loop for (attr val) on attr by #'cddr
     collect (list (if (keywordp attr)
                       (keyword-to-string attr)
                       attr)
                   val)))

;;; return multiple-values tag, list of attrs
(defun parse-tag (tag)
  (let ((tag (transform-sexp tag)))
    (cond ((atom tag)
           (when (keywordp tag)
             (keyword-to-string tag)))
;;; need to check if (car tag) is a list. Handle three cases, atom, (list ...), ((list) list)
          ((and (listp tag) (atom (car tag)))
           (values (parse-tag (car tag))
                   (attributes-to-list (cdr tag))))
          (t (values (parse-tag (car tag))
                     (attributes-to-list (cdr tag)))))))




(eval-when (:compile-toplevel :load-toplevel :execute)

  (defun make-hash-table-from-alist (alist &key (test #'eql))
    (let ((h (make-hash-table :test test)))
      (loop for (x . y) in alist
         do (setf (gethash x h) y))
      h))

  (defparameter *xml-char-map*
    (make-hash-table-from-alist
     '((#\< . "&lt;")
       (#\> . "&gt;")
       (#\& . "&amp;")
       (#\No-Break_Space . "&#xa0;")
       (#\LEFT_DOUBLE_QUOTATION_MARK . "&#8220;")
       (#\RIGHT_DOUBLE_QUOTATION_MARK . "&#8221;")
       (#\EM_DASH . "&#8212;")
       (:eol . #\Space))))

  (defun get-xml-char (c)
    (let ((xc (gethash c *xml-char-map*)))
      (if xc xc c))))

(defun render-text (out text)
  (declare (optimize (debug 3)))
  (macrolet ((match-second-char (c1 c2 out-char)
                `(let ((n (peek-char nil in nil nil)))
                  (if (eql n ,c2)
                      (progn
                        (read-char in)
                        (princ ,(get-xml-char out-char) out))
                      (princ ,(get-xml-char c1) out)))))
    (cond ((stringp text)
           (with-input-from-string (in text)
             (loop for c = (read-char in nil nil) while c
                do 
                (cond ((eql c #\~)
                       (princ (get-xml-char #\No-Break_Space) out))
                      ((eql c #\.)
                       (match-second-char #\. #\\ #\Space))
                      ((eql c #\`)
                       (match-second-char #\` #\` #\LEFT_DOUBLE_QUOTATION_MARK))
                      ((eql c #\')
                       (match-second-char #\' #\' #\RIGHT_DOUBLE_QUOTATION_MARK))
                      ((eql c #\-)
                       (match-second-char #\- #\- #\EM_DASH))
                      (t (princ (get-xml-char c) out))))))
          (t (princ (get-xml-char text) out)))))

(defun render-content (content)
  (loop for s in content
     do (parse-element :xhtml s)))

(defparameter *indent-level* 0)

(defun render-element-tag (stream tag attributes)
  (format stream "<~A~{~^ ~{~A=~S~^ ~}~}/>" (string-downcase tag)
          (mapcar (lambda (x)
                    (list (string-downcase (car x))
                          (cdr x)))
                  (mapcar (lambda (attr)
                            (cons (string-downcase (car attr))
                                  (cdr attr)))
                          attributes))))

(defun render-element-open-tag (stream tag attributes)
  (format stream "<~A~{~^ ~{~A=~S~^ ~}~}>" (string-downcase tag)
          (mapcar (lambda (x)
                    (list (car x)
                          (cdr x)))
                  (mapcar (lambda (attr)
                            (cons (string-downcase (car attr))
                                  (cdr attr)))
                          attributes)))
  (incf *indent-level*))
<commit_msg>use special vars for special characters instead of SBCL-specific character literals<commit_after>
(in-package :smarkup)

(named-readtables:in-readtable quote-reader)

(defparameter *html-element-transformation*
  `((:example      . :pre)
    (:sidebarhead  . (:div :class "sidebarhead"))
    (:sidebar      . (:div :class "sidebar"))
    (:note         . (:div :class "note"))
    #+nil (:title        . (:div :class "title"))
    (:note-ref     . :sup)
    (:bullets      . :ul)
    (:list         . :ul)
    (:item         . :li)
    (:results      . (:code :class "results"))
    (:figure       . (:table :class "figure"))
    (:figure*      . (:table :class "figure"))
    (:subfigure    . (:div :class "subfigure"))
    (:newline     . :br)))

(defparameter *xhtml-header*
  #q{<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE html 
     PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
     "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">})

(defparameter *stream* nil)

(defun html-citation (tag body)
  (declare (ignore tag))
  `(:span
    ,@(loop for ref in body
         collect
         (let ((refnum (get-bib-order ref)))
           `((:a :href
                 ,(format nil "#ref~A" refnum))
             ,(format nil "[~A]" refnum))))))

(defun citation-string (cite)
  (let ((refnum (get-bib-order cite)))
    `((:a :name
          ,(format nil "ref~A" refnum))
      ,(format nil "~A. ~A"
               refnum
               (cite-text cite)))))

(defun html-bibliography (tag body)
  (declare (ignore tag body))
  `(:div
    (:h1 "References")
    ,@(loop for cite in (reverse *cite-keys*)
         collect `(:p ,(citation-string cite)))))
    
(defun htmlize-image (tag body)
  (declare (ignore tag))
  (destructuring-bind (src &key width types) body
    (declare (ignore width))
    (when types
      (let ((src2 (find-file-for-types src types)))
        (when src2 (setf src (enough-namestring src2)))))
    `((:img :src ,src))))

(defun htmlize-url (tag body)
  (declare (ignore tag))
  `(:a :href ,@body ,@body))

(defun htmlize-href (tag body)
  (declare (ignore tag))
  (destructuring-bind ((hreftag href) (texttag text)) body
    (declare (ignore hreftag texttag))
    `(:a :href ,href ,text)))

(defun htmlize-header (tag body)
  (destructuring-bind (heading &rest rest &key clearpage no-number &allow-other-keys) body
    (declare (ignore clearpage no-number))
    `(,tag ,@(cons heading (remove-from-plist rest :clearpage :no-number)))))

(defun transform-sexp (sexp)
  (if (and (listp sexp) (car sexp))
      (let ((xfrm (cdr (assoc (car sexp) *html-element-transformation*))))
        (cond ((null xfrm) sexp)
              ((and (symbolp xfrm) (fboundp xfrm))
               (funcall (symbol-function xfrm) (car sexp) (cdr sexp)))
              (t (setf (car sexp) xfrm)
                 sexp)))
      sexp))

  
;;;
;;; * input is a list of S-expressions, of the form:
;;;   (tag &rest content)
;;; * tag can be either a keyword (like :p)
;;;   or a list (like (:a :href "http://myurl.com"))

(defun keyword-to-string (keyword)
  (string-downcase (symbol-name keyword)))

(defun attributes-to-list (attr)
  (loop for (attr val) on attr by #'cddr
     collect (list (if (keywordp attr)
                       (keyword-to-string attr)
                       attr)
                   val)))

;;; return multiple-values tag, list of attrs
(defun parse-tag (tag)
  (let ((tag (transform-sexp tag)))
    (cond ((atom tag)
           (when (keywordp tag)
             (keyword-to-string tag)))
;;; need to check if (car tag) is a list. Handle three cases, atom, (list ...), ((list) list)
          ((and (listp tag) (atom (car tag)))
           (values (parse-tag (car tag))
                   (attributes-to-list (cdr tag))))
          (t (values (parse-tag (car tag))
                     (attributes-to-list (cdr tag)))))))




(eval-when (:compile-toplevel :load-toplevel :execute)

  (defun make-hash-table-from-alist (alist &key (test #'eql))
    (let ((h (make-hash-table :test test)))
      (loop for (x . y) in alist
         do (setf (gethash x h) y))
      h))

  (defparameter *xml-char-map*
    (make-hash-table-from-alist
     `((#\< . "&lt;")
       (#\> . "&gt;")
       (#\& . "&amp;")
       #+(or sbcl abcl) (,*no-break-space* . "&#xa0;")
       #+(or sbcl abcl) (,*left-double-quotation-mark* . "&#8220;")
       #+(or sbcl abcl) (,*right-double-quotation-mark* . "&#8221;")
       #+(or sbcl abcl) (,*em-dash* . "&#8212;")
       (:eol . #\Space))))

  (defun get-xml-char (c)
    (let ((xc (gethash c *xml-char-map*)))
      (if xc xc c))))

(defun render-text (out text)
  (macrolet ((match-second-char (c1 c2 out-char)
                `(let ((n (peek-char nil in nil nil)))
                  (if (eql n ,c2)
                      (progn
                        (read-char in)
                        (princ ,(get-xml-char out-char) out))
                      (princ ,(get-xml-char c1) out)))))
    (cond ((stringp text)
           (with-input-from-string (in text)
             (loop for c = (read-char in nil nil) while c
                do 
                (cond ((eql c #\~)
                       (princ (get-xml-char *no-break-space*) out))
                      ((eql c #\.)
                       (match-second-char #\. #\\ #\Space))
                      ((eql c #\`)
                       (match-second-char #\` #\` *left-double-quotation-mark*))
                      ((eql c #\')
                       (match-second-char #\' #\' *right-double-quotation-mark*))
                      ((eql c #\-)
                       (match-second-char #\- #\- *em-dash*))
                      (t (princ (get-xml-char c) out))))))
          (t (princ (get-xml-char text) out)))))

(defun render-content (content)
  (loop for s in content
     do (parse-element :xhtml s)))

(defparameter *indent-level* 0)

(defun render-element-tag (stream tag attributes)
  (format stream "<~A~{~^ ~{~A=~S~^ ~}~}/>" (string-downcase tag)
          (mapcar (lambda (x)
                    (list (string-downcase (car x))
                          (cdr x)))
                  (mapcar (lambda (attr)
                            (cons (string-downcase (car attr))
                                  (cdr attr)))
                          attributes))))

(defun render-element-open-tag (stream tag attributes)
  (format stream "<~A~{~^ ~{~A=~S~^ ~}~}>" (string-downcase tag)
          (mapcar (lambda (x)
                    (list (car x)
                          (cdr x)))
                  (mapcar (lambda (attr)
                            (cons (string-downcase (car attr))
                                  (cdr attr)))
                          attributes)))
  (incf *indent-level*))

{'fraction_non_alphanumeric': 0.17355743978389734, 'fraction_numerical': 0.004727245441584753, 'mean_word_length': 1.824925816023739, 'pattern_counts': {'":': 0, '<': 13, '<?xml version=': 2, '>': 13, 'https://': 0, 'lorem ipsum': 0, 'www.': 2, 'xml': 18}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 4, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3663560', 'n_tokens_mistral': 4633, 'n_tokens_neox': 4380, 'n_words': 1200}