diff --git a/guile/broken-link-checker.scm b/guile/broken-link-checker.scm index 968b173..be10b98 100755 --- a/guile/broken-link-checker.scm +++ b/guile/broken-link-checker.scm @@ -40,16 +40,33 @@ along with this program. If not, see . (// video @ src) (// video source @ src) (// audio @ src) - (// audio source @ src)))) + (// 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-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))))))) + (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."