Function: UNESCAPE-AS-HTML

Source

(defun unescape-as-html (string)
  (with-output-to-string (unescaped)
    (loop
       for offset upfrom 0 below (length string)
       for char = (aref string offset)
       if (char= #\& char)
         do (progn
              (aif (position #\; string :start offset)
                   (let ((escape-tag (subseq string offset (1+ it))))
                     (aif (gethash escape-tag *html-entites*)
                          (progn
                            (princ it unescaped)
                            (incf offset (1- (length escape-tag))))
                          (if (char= #\# (aref escape-tag 1))
                              ;; special code, ignore
                              (restart-case
                                  (warn 'unknown-char-escape :what escape-tag)
                                (continue-delete ()
                                  :report "Continue processing, delete this char."
                                  (incf offset (1- (length escape-tag)))))
                              (restart-case
                                  (error 'unknown-html-entity :what escape-tag)
                                (continue-as-is ()
                                  :report "Continue processing, leaving the string as is."
                                  (write-char #\& unescaped))
                                (continue-delete ()
                                  :report "Continue processing, delete this entity."
                                  (incf offset (1- (length escape-tag))))))))
                   (restart-case
                       (error 'unterminated-html-entity
                              :what (subseq string offset
                                            (min (+ offset 20)
                                                 (length string))))
                     (continue-as-is ()
                       :report "Continue processing, leave the string as is."
                       (write-char #\& unescaped)))))
       else do (write-char char unescaped))))
Source Context