From fe68f009b151642ba21a0b1c15799b95524948db Mon Sep 17 00:00:00 2001 From: Ray Miller Date: Fri, 31 Jan 2025 16:27:39 +0000 Subject: [PATCH 1/2] First pass at srcset handling --- guile/broken-link-checker.scm | 25 ++++++++++++++++++++++--- 1 file changed, 22 insertions(+), 3 deletions(-) diff --git a/guile/broken-link-checker.scm b/guile/broken-link-checker.scm index 968b173..92fd98a 100755 --- a/guile/broken-link-checker.scm +++ b/guile/broken-link-checker.scm @@ -42,14 +42,33 @@ along with this program. If not, see . (// audio @ 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) "Extract links from an HTML document, discarding any tel: or mailto: links." (let ((x (html->sxml body))) (remove (lambda (s) (or (string-prefix? "tel:" s) (string-prefix? "mailto:" s))) (delete-duplicates - (map cadr - (concatenate - (map (lambda (f) (f x)) link-paths))))))) + (append + (map cadr + (concatenate + (map (lambda (f) (f x)) link-paths))) + (extract-srcset x)))))) (define (uri-without-fragment uri) "If uri has a fragment, return a new URI without the fragment." From cb177aa43fd1cf0e3632ade8f4fcf7efc51ca85f Mon Sep 17 00:00:00 2001 From: Ray Miller Date: Fri, 31 Jan 2025 16:41:59 +0000 Subject: [PATCH 2/2] Nicer approach to srcset --- guile/broken-link-checker.scm | 30 ++++++++++++++---------------- 1 file changed, 14 insertions(+), 16 deletions(-) diff --git a/guile/broken-link-checker.scm b/guile/broken-link-checker.scm index 92fd98a..be10b98 100755 --- a/guile/broken-link-checker.scm +++ b/guile/broken-link-checker.scm @@ -40,35 +40,33 @@ along with this program. If not, see . (// video @ src) (// video source @ src) (// audio @ src) - (// audio source @ src)))) - -(define srcset-paths (map sxpath - '((// picture source @ srcset) - (// img @ srcset)))) + (// audio source @ src) + (// 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." + (pk s) (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) "Extract links from an HTML document, discarding any tel: or mailto: links." (let ((x (html->sxml body))) (remove (lambda (s) (or (string-prefix? "tel:" s) (string-prefix? "mailto:" s))) (delete-duplicates - (append - (map cadr - (concatenate - (map (lambda (f) (f x)) link-paths))) - (extract-srcset x)))))) + (fold (lambda (f accum) + (fold (lambda (x accum) + (match-let (((attr val) x)) + (if (equal? attr 'srcset) + (append (parse-srcset val) accum) + (cons val accum)))) + accum + (f x))) + '() + link-paths))))) (define (uri-without-fragment uri) "If uri has a fragment, return a new URI without the fragment."