|
(define-parenscript matching-visible-text-url (rel-target link-strings) |
|
(defun find-rel-url (tag-name) |
|
(loop for e in (ps:chain document (get-elements-by-tag-name tag-name)) |
|
when (and |
|
(ps:chain e (has-attribute "rel")) |
|
(equal (ps:lisp rel-target) (ps:@ e rel))) |
|
return (ps:@ e href))) |
|
|
|
(defun element-drawable-p (element) |
|
(if (or (ps:chain element offset-width) |
|
(ps:chain element offset-height) |
|
(ps:chain element (get-client-rects) length)) |
|
t nil)) |
|
|
|
(defun element-visible-p (element) |
|
(let ((computed-style (ps:chain window (get-computed-style element nil)))) |
|
(if (or (equal (ps:chain computed-style (get-property-value "visibility")) |
|
"visible") |
|
(not (equal (ps:chain computed-style (get-property-value "display")) |
|
"none"))) |
|
t nil))) |
|
|
|
(defun element-text-matches-p (element) |
|
(let ((link-text (ps:chain element inner-text (to-lower-case))) |
|
(link-value (and (ps:chain element value) |
|
(ps:chain element value includes)))) |
|
(loop for s in (ps:lisp link-strings) |
|
when (or (not (= (ps:chain link-text (index-of s)) -1)) |
|
(and link-value |
|
(ps:chain link-value (includes s)))) |
|
return t))) |
|
|
|
(or (find-rel-url "link") |
|
(find-rel-url "a") |
|
(find-rel-url "area") |
|
(loop for e in (ps:chain document (get-elements-by-tag-name "a")) |
|
when (and (element-drawable-p e) |
|
(element-visible-p e) |
|
(element-text-matches-p e)) |
|
return (ps:@ e href)))) |
|
|
|
(define-command go-next () |
|
(with-result (x (matching-visible-text-url "next" ''("next" "more" "newer" ">" "›" "→" "»" "≫" ">>"))) |
|
(when (and x (not (equal "undefined" x))) |
|
(buffer-load x :buffer (current-buffer))))) |
|
|
|
(define-command go-prev () |
|
(with-result (x (matching-visible-text-url "prev" ''("prev" "previous" "back" "older" "<" "‹" "←" "«" "≪" "<<"))) |
|
(when (and x (not (equal "undefined" x))) |
|
(buffer-load x :buffer (current-buffer))))) |
