reddigg images %s

;;; reddigg-images-to-html.el --- gallery export for reddigg buffers -*- lexical-binding: t; -*- (require 'cl-lib) (require 'rx) (defconst reddigg-images--url-rx (rx (? "file:") (? "http" (? "s") "://") (+? (any alnum "._~:/?#@!$&'*+,;=%-")) "." (or "jpeg" "jpg" "gif" "png") (? "?" (* (not (any "]\n \""))))) "Regexp matching JPEG/GIF/PNG image URLs and `file:' links.") (defun reddigg-images--scan-buffer () "Scan current buffer for image links and reddit gallery links. Return an ordered list of (image . URL) and (gallery . POST-ID)." (let ((items nil) (case-fold-search t)) (save-excursion (goto-char (point-min)) (while (re-search-forward reddigg-images--url-rx nil t) (let ((u (match-string-no-properties 0))) (setq u (replace-regexp-in-string (rx bos "file:") "" u)) ;; only accept web or absolute-local URLs; reject other schemes ;; that the char class may have swallowed, e.g. eww:https://...png (when (string-match-p (rx bos (or "http://" "https://" "/")) u) ;; local absolute path -> file:// URL so the browser can load it (when (string-prefix-p "/" u) (setq u (concat "file://" u))) (push (cons (point) (cons 'image u)) items)))) (when (boundp 'reddigg-rss--gallery-link-rx) (goto-char (point-min)) (while (re-search-forward reddigg-rss--gallery-link-rx nil t) (push (cons (point) (cons 'gallery (match-string-no-properties 1))) items)))) (mapcar #'cdr (sort (nreverse items) #'car-less-than-car)))) (defun reddigg-images--urls (items galleries) "Flatten ITEMS into image URLs, in order and without duplicates. GALLERIES maps a gallery post id to its image URLs, nil when the lookup is unavailable." (let ((urls nil)) (pcase-dolist (`(,type . ,value) items) (pcase type ('image (cl-pushnew value urls :test #'string=)) ('gallery (dolist (u (and galleries (gethash value galleries))) (cl-pushnew u urls :test #'string=))))) (nreverse urls))) (defun reddigg-images--write-html (urls title) "Write an HTML gallery of URLS titled TITLE and open it in the browser. Return the file name." (let* ((stamp (format-time-string "%Y%m%d-%H%M%S")) (file (format "/tmp/reddigg-%s.html" stamp))) (with-temp-file file (insert "\n\n\n\n") (insert (format "reddigg images %s\n" stamp)) (insert "\n\n\n") (insert (format "

%s — %d images

\n" (replace-regexp-in-string (rx (any "<>&")) "" title) (length urls))) (insert "

\n") (let ((i 0)) (dolist (u urls) (insert (format " $\"\"$ \n" u i)) (setq i (1+ i)))) (insert "

\n") ;; lightbox overlay: full image + permalink in title bar (insert "

\n" "

" "

\n" "

$\"\"$

\n" "

\n") (insert "\n") (insert "\n\n")) (message "reddigg-images-to-html: %d images -> %s" (length urls) file) (browse-url (concat "file://" file)) file)) (defun reddigg-images-to-html () "Build a standalone HTML gallery from image links in the current buffer. Matches bare/http JPEG, GIF and PNG URLs and `file:' links. Reddit gallery links are resolved into their images when reddigg-rss is loaded; resolution is asynchronous, the browser opens when it finishes." (interactive) (let* ((items (reddigg-images--scan-buffer)) (title (buffer-name)) (ids (delete-dups (cl-loop for (type . value) in items when (eq type 'gallery) collect value)))) (cond ((null items) (message "reddigg-images-to-html: no images found") nil) ((and ids (fboundp 'reddigg-rss-resolve-buffer-galleries)) (message "reddigg-images-to-html: resolving %d galleries..." (length ids)) (reddigg-rss-resolve-buffer-galleries ids (lambda (galleries) (let ((urls (reddigg-images--urls items galleries))) (if urls (reddigg-images--write-html urls title) (message "reddigg-images-to-html: no images found")))))) (t (let ((urls (reddigg-images--urls items nil))) (if urls (reddigg-images--write-html urls title) (message "reddigg-images-to-html: no images found"))))))) (provide 'reddigg-images-to-html) ;;; reddigg-images-to-html.el ends here