改行をBRタグに置き換える
Posted feedbacks - Common Lisp
mc
#2916()
[
Common Lisp
]
今回の改行の処理の対応と、 前回のものが、属性のなかのタグの途中で改行が入った "<foo clear='<scr ipt>foo>'>foo</foo>" のようなものを上手く処理できていないことに気付いたので直し… …たつもりですが、私には問題が難し過ぎたようで、 何が何だが分からないものになり果てました…。 タグのエスケープ処理のため2種の文字を予約で消費してしまいます。 下記では、ここへの投稿のために"【"と"】"を使いました。 また、前回はライブラリが見付けられずAllegroのparse-htmlを 使用して作成しましたが、Clikiにポータブル版のpxmlutilsが ありました。 http://www.cliki.net/pxmlutils 今回はそれを導入してsbclで動作確認しています。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 | (use-package :net.html.parser)
(use-package :cl-ppcre)
(use-package :url-rewrite)
(defun html-filter-2 (str)
(regex-replace-all-lis
'(("】" . ">") ("【" . "<") ("\\n" . "<br />"))
(html-filter-1
(prop-filter-2 (pickup-tag (<>-to-escape (prop-filter-1 str)))))))
(defun regex-replace-all-lis (repl-alist str
&optional &key case-insensitive-mode)
(reduce
(lambda (res item)
(let ((scan (create-scanner
(car item)
:case-insensitive-mode case-insensitive-mode)))
(regex-replace-all scan res (cdr item))))
repl-alist :initial-value str))
(defun <>-to-escape (str)
(regex-replace-all-lis '((">" . "】")("<" . "【")) str))
(defun <>-to-ltgt (str)
(regex-replace-all-lis '((">" . ">")("<" . "<")) str))
(defun pickup-tag (str)
(regex-replace-all-lis
'(("【(a\\s*[^\\s】]*)】" . "<\\1>")
("【(/a\\s*)】" . "</a>")
("【(strong\\s*[^\\s】]*)】" . "<\\1>")
("【(/strong\\s*)】" . "</strong>")
("【(br\\s*[^\\s】]*)】" . "<br />"))
str))
(defun prop-filter-1 (str)
(prop-filter-* str "('[^']*')" #'url-encode))
(defun prop-filter-2 (str)
(prop-filter-* str "(【[^】]*】)" #'<>-to-ltgt))
(defun prop-filter-* (str scan-pat repl-func)
(let ((scan (create-scanner scan-pat :case-insensitive-mode t)))
(regex-replace-all scan str
(lambda (match &rest rest)
(declare (ignore rest))
(if (scan "[<>]" match)
(funcall repl-func match)
match))
:simple-calls t)))
(defun html-filter-1 (string)
(let ((form (sanitize-html (parse-html string))))
(apply #'concatenate 'string (build-html form))))
(defun sanitize-html (form)
(mapcar
(lambda (item)
(if (atom item)
item
(let ((keys `(,(car item) ,(and (consp (car item)) (caar item)))))
(cond ((member :a keys)
`(,(car item) ,@(sanitize-html (cdr item))))
((member :strong keys)
`(:strong ,@(sanitize-html (cdr item))))
((member :br keys) :br)
('T "")))))
form))
(defun build-html (form)
(if (atom form)
form
(cond ((and (atom (car form)) (eq :br (car form)))
`(,(br) ,@(build-html (cdr form))))
((consp (car form))
`(,(let* ((top (car form))
(keys `(,(car top) ,(and (consp (car top)) (caar top)))))
(cond ((member :a keys) (build-a top))
((member :strong keys) (build-strong top))
('T top)))
,@(build-html (cdr form))))
('T `(,(build-html (car form))
,@(build-html (cdr form)))))))
(defun br () "<br />")
(defun build-strong (form)
(format nil "<strong>~{~A~}</strong>" (build-html (cdr form))))
(defun build-a (form)
(let ((tag (car form))
(body (build-html (cdr form))))
(if (and (consp (car form))
(member (second tag) '(:href :name)))
(format nil "<a ~(~A~)='~A'>~{~A~}</a>"
(second tag)
(put-dotslash (third tag)) body)
(format nil "<a>~{~A~}</a>" (build-html (cdr form))))))
(defun put-dotslash (str)
(let ((s (create-scanner "^([Hh][Tt][Tt][Pp][Ss]*://|^/|\./)")))
(if (scan s str)
str
(concatenate 'string "./" str))))
(defun prop-maker (lst)
(do ((l lst (cddr l))
result)
((endp l) (nreverse result))
(push (format nil "~A=\"~A\""
(car l) (<>-to-ltgt (cadr l))) result)))
|
にしお
#3413()
Rating-2/2=-1.00
また、ユーザの入力注の<br>は<br/>に変換してください。
このお題はperezvonさんの提案を元にした三部作の二問目です。ご協力ありがとうございました。
[ reply ]