Commit 74c37287 authored by Michael Raskin's avatar Michael Raskin

Syncing from Monotone at 20200213-002451. Last commit message was Add main-part-extraction support

parent c93192f7
......@@ -61,7 +61,10 @@
content-type)
(ignore-errors (cl-json:decode-json-from-string
content)))
(t (let* ((document (html5-parser:make-document))
(t (format *trace-output*
"Unrecongnised content-type: ~a~%"
content-type)
(let* ((document (html5-parser:make-document))
(pre (html5-parser:make-element document "pre" nil))
(text (html5-parser:make-text-node document content)))
(html5-parser:node-append-child pre text)
......
This diff is collapsed.
......@@ -234,6 +234,11 @@
(type (eql :element)) (tag (eql :sub)) element)
(format nil "{↓↓ ~a ↓↓}" (call-next-method)))
(defmethod html-element-to-text-dispatch
((protocol show-formatting-mixin)
(type (eql :element)) (tag (eql :li)) element)
(format nil "{>>> ~a <<<}" (call-next-method)))
(defclass recur-on-noscript-mixin (html-textifier-protocol) ())
(defmethod html-element-to-text-dispatch
......
......@@ -5,7 +5,7 @@ unset $(set | grep '^_.*NIX_LISP*' | cut -d = -f 1)
NIX_LISP_ASDF_PATHS="$(realpath "$(dirname "$0")")
$PWD"
dependencies="drakma cl_plus_ssl cl-html5-parser parenscript cl-ppcre cl-json css-selectors css-selectors-simple-tree babel $THOUGHTFUL_THERIDION_EXTRA_DEPENDENCIES"
dependencies="drakma cl_plus_ssl cl-html5-parser parenscript cl-ppcre cl-json css-selectors css-selectors-simple-tree babel cl-unicode $THOUGHTFUL_THERIDION_EXTRA_DEPENDENCIES"
test -n "$THOUGHTFUL_THERIDION_NIX_GC_PIN" && {
mkdir -p "$(dirname "$THOUGHTFUL_THERIDION_NIX_GC_PIN")"
......
......@@ -248,3 +248,9 @@
(html-element-to-text
(make-instance 'html-textifier-protocol-inspector)
(css-selectors:query1 "div.morelink > a:nth-last-child(2)" (parsed-content *fetcher*)))
(navigate *fetcher* "http://funcall.blogspot.com/2020/01/afraid-of-recursion.html")
(html-extract-main-content
(parsed-content *fetcher*)
(make-instance 'html-text-score-protocol)
(make-instance 'html-textifier-protocol-inspector))
......@@ -14,7 +14,7 @@
:babel
:css-selectors
:css-selectors-simple-tree
:cl-ppcre
:cl-ppcre :cl-unicode
:parenscript)
:components
......@@ -26,5 +26,6 @@
"date-parsing-experiments"))
(:file "html-textify" :depends-on ("basic-retrieve"))
(:file "html-forms" :depends-on ("package"))
(:file "util" :depends-on ("basic-retrieve" "html-textify"))
(:file "html-main-text" :depends-on ("package" "html-textify"))
(:file "util" :depends-on ("basic-retrieve" "html-textify" "html-main-text"))
(:file "walker-dsl" :depends-on ("package" "basic-retrieve"))))
......@@ -2,7 +2,8 @@
(defun save-web-page (url target basename &key
fetcher fetcher-parameters
drakma-args html-textifier-protocol)
drakma-args html-textifier-protocol
html-content-score-protocol)
(ensure-directories-exist (format nil "~a/" target))
(let* ((f (or fetcher
(apply 'make-instance 'http-fetcher fetcher-parameters)))
......@@ -18,7 +19,7 @@
(format out "~a~%" (current-content f)))
(with-open-file (out (format nil "~a/~a.html.txt" target basename)
:direction :output)
(format out "→[ ~a ]~%→[ ~a ]~%~a~%~{~%(~{~s~%~})~%~%~}~S~%#.~S~%~%~a~%"
(format out "→[ ~a ]~%→[ ~a ]~%~a~%~a~%~{~%(~{~s~%~})~%~%~}~S~%#.~S~%~%~a~%"
url (current-url f)
(or
(ignore-errors
......@@ -28,6 +29,16 @@
(make-instance 'html-textifier-protocol-inspector))
(css-selectors:query1 "head title" (parsed-content f))))
"")
(or
(ignore-errors
(html-extract-main-content
(parsed-content f)
(or html-content-score-protocol
(make-instance 'html-text-score-protocol))
(or
html-textifier-protocol
(make-instance 'html-textifier-protocol-inspector))))
"")
(when (parsed-content f)
(loop for form in (css-selectors:query
"form" (parsed-content f))
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment