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 @ src)
(// video source @ src) (// video source @ src)
(// audio @ src) (// audio @ src)
(// audio source @ src)))) (// audio source @ src)
(// picture source @ srcset)
(define srcset-paths (map sxpath (// img @ srcset))))
'((// picture source @ srcset)
(// img @ srcset))))
;; Special handling for srcset ;; Special handling for srcset
(define (parse-srcset s) (define (parse-srcset s)
"Parse out the list of URLs from an image srcset, discarding whitespace and the "Parse out the list of URLs from an image srcset, discarding whitespace and the
width/density descriptor." width/density descriptor."
(pk s)
(map (compose first (cut string-split <> #\space)) (map (compose first (cut string-split <> #\space))
(map string-trim-both (string-split s #\,)))) (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 (fold (lambda (f accum)
(map cadr (fold (lambda (x accum)
(concatenate (match-let (((attr val) x))
(map (lambda (f) (f x)) link-paths))) (if (equal? attr 'srcset)
(extract-srcset x)))))) (append (parse-srcset val) accum)
(cons val accum))))
accum
(f x)))
'()
link-paths)))))
(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."