First pass at srcset handling
This commit is contained in:
parent
8c4df89483
commit
fe68f009b1
1 changed files with 22 additions and 3 deletions
|
@ -42,14 +42,33 @@ along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
(// audio @ src)
|
(// audio @ src)
|
||||||
(// audio source @ src))))
|
(// audio source @ src))))
|
||||||
|
|
||||||
|
(define srcset-paths (map sxpath
|
||||||
|
'((// picture source @ srcset)
|
||||||
|
(// img @ srcset))))
|
||||||
|
|
||||||
|
;; Special handling for srcset
|
||||||
|
(define (parse-srcset s)
|
||||||
|
"Parse out the list of URLs from an image srcset, discarding whitespace and the
|
||||||
|
width/density descriptor."
|
||||||
|
(map (compose first (cut string-split <> #\space))
|
||||||
|
(map string-trim-both (string-split s #\,))))
|
||||||
|
|
||||||
|
(define (extract-srcset x)
|
||||||
|
(concatenate
|
||||||
|
(map (compose parse-srcset cadr)
|
||||||
|
(concatenate
|
||||||
|
(map (lambda (f) (f x)) srcset-paths)))))
|
||||||
|
|
||||||
(define (extract-links body)
|
(define (extract-links body)
|
||||||
"Extract links from an HTML document, discarding any tel: or mailto: links."
|
"Extract links from an HTML document, discarding any tel: or mailto: links."
|
||||||
(let ((x (html->sxml body)))
|
(let ((x (html->sxml body)))
|
||||||
(remove (lambda (s) (or (string-prefix? "tel:" s) (string-prefix? "mailto:" s)))
|
(remove (lambda (s) (or (string-prefix? "tel:" s) (string-prefix? "mailto:" s)))
|
||||||
(delete-duplicates
|
(delete-duplicates
|
||||||
|
(append
|
||||||
(map cadr
|
(map cadr
|
||||||
(concatenate
|
(concatenate
|
||||||
(map (lambda (f) (f x)) link-paths)))))))
|
(map (lambda (f) (f x)) link-paths)))
|
||||||
|
(extract-srcset x))))))
|
||||||
|
|
||||||
(define (uri-without-fragment uri)
|
(define (uri-without-fragment uri)
|
||||||
"If uri has a fragment, return a new URI without the fragment."
|
"If uri has a fragment, return a new URI without the fragment."
|
||||||
|
|
Loading…
Add table
Reference in a new issue