ray/scripts
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Nicer approach to srcset

Browse source
This commit is contained in:
Ray Miller 2025-01-31 16:41:59 +00:00
parent fe68f009b1
commit cb177aa43f
1 changed files with 14 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

30
guile/broken-link-checker.scm
View file

@ -40,35 +40,33 @@ along with this program. If not, see <http://www.gnu.org/licenses/>.
(// 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."