From fe68f009b151642ba21a0b1c15799b95524948db Mon Sep 17 00:00:00 2001 From: Ray Miller Date: Fri, 31 Jan 2025 16:27:39 +0000 Subject: [PATCH] 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."