Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Elfeed config
;;; elfeed configuration
(use-package elfeed
;;;; Keymaps
:general
(:keymaps '(shr-map)
"a" 'pocket-reader-shr-add-link)
(:keymaps '(elfeed-show-mode-map elfeed-search-mode-map)
"a" 'ap/elfeed-add-links-to-pocket
"b" 'ap/elfeed-search-browse-w3m
"B" 'ap/elfeed-search-browse-chrome
"e" 'ap/elfeed-search-excerpt-toggle-selected
"E" 'ap/elfeed-search-eww
"f" 'ap/elfeed-search-entry-toggle-star
"m" 'ap/elfeed-browse-random-starred
"o" 'ap/elfeed-search-browse-org
"Rd" 'ap/elfeed-search-mark-day-as-read
"Rs" 'ap/elfeed-search-mark-site-as-read
"ta" 'elfeed-search-tag-all
"tr" 'elfeed-search-untag-all
"v" 'ap/elfeed-search-view-hydra/body)
;;;; Config
:config
(setq elfeed-search-sort-function #'ap/elfeed-search-entry<
elfeed-sort-order 'ascending)
;;;;; Database auto-save
;; Save elfeed db automatically, because if Emacs crashes or is killed (which happens to me
;; occasionally, especially since I develop packages in a single instance), we'd lose the db
;; updates not saved.
(unless (cl-loop for timer in timer-idle-list
thereis (equal (aref timer 5) #'elfeed-db-save))
(run-with-idle-timer 300 'repeat #'elfeed-db-save))
;;;; Functions
(cl-defun ap/feed-for-url (url &key (prefer 'atom) (all nil))
"Return feed URL for web page at URL.
PREFER may be `atom' (the default) or `rss'. When ALL is
non-nil, all feed URLs of all types are returned; otherwise only
one feed URL of the preferred type is returned. When called
interactively, insert the URL at point."
(interactive (list (org-web-tools--get-first-url)))
(require 'esxml-query)
(require 'org-web-tools)
(cl-flet ((feed-p (type)
;; Return t if TYPE appears to be an RSS/ATOM feed
(string-match-p (rx "application/" (or "rss" "atom") "+xml")
type)))
(let* ((preferred-type (format "application/%s+xml" (symbol-name prefer)))
(html (org-web-tools--get-url url))
(dom (with-temp-buffer
(insert html)
(libxml-parse-html-region (point-min) (point-max))))
(potential-feeds (esxml-query-all "link[rel=alternate]" dom))
(return (if all
;; Return all URLs
(cl-loop for (tag attrs) in potential-feeds
when (feed-p (alist-get 'type attrs))
collect (url-expand-file-name (alist-get 'href attrs) url))
(or
;; Return the first URL of preferred type
(cl-loop for (tag attrs) in potential-feeds
when (equal preferred-type (alist-get 'type attrs))
return (url-expand-file-name (alist-get 'href attrs) url))
;; Return the first URL of non-preferred type
(cl-loop for (tag attrs) in potential-feeds
when (feed-p (alist-get 'type attrs))
return (url-expand-file-name (alist-get 'href attrs) url))))))
(if (called-interactively-p)
(insert (if (listp return)
(s-join " " return)
return))
return))))
;;;; elfeed-org
(use-package elfeed-org
:config
(elfeed-org)
(setq rmh-elfeed-org-files (list "~/.config/elfeed.org")))
;;;;; ap/elfeed-org
;; NOTE: IIUC I only need to run `ap/elfeed-org' when I change color properties in the file,
;; otherwise Elfeed will remember them and plain `elfeed-org' won't interfere with them.
(defun ap/elfeed-org ()
"Read feeds from ~/.config/elfeed.org.
This is like `elfeed-org', except it doesn't do everything it
does, but it does read properties from entries and apply them to
feeds' metadata. This function should probably be called after
already having called `elfeed-org'. In other words, this does
not necessarily replace `elfeed-org'."
(when-let* ((feeds (-non-nil (ap/elfeed-org--feeds-in (find-file-noselect "~/.config/elfeed.org")))))
(setq elfeed-feeds
(--map (cons (elfeed-feed-url it)
(elfeed-meta it :tags))
feeds))))
(cl-defstruct org-link
protocol path description)
(defun org-match-link (&optional s)
"Return an `org-link' struct if an Org link is matched in string S or at point.
Matches with `org-bracket-link-analytic-regexp'."
;; NOTE: HTTP paths will start with two slashes.
(cond (s (when (string-match org-bracket-link-analytic-regexp s)
(make-org-link :protocol (match-string-no-properties 2 s)
:path (match-string-no-properties 3 s)
:description (match-string-no-properties 5 s))))
(t (when (looking-at org-bracket-link-analytic-regexp)
(make-org-link :protocol (match-string-no-properties 2)
:path (match-string-no-properties 3)
:description (match-string-no-properties 5))))))
(defun ap/elfeed-org--feeds-in (buffer)
"Return list of feeds in Org BUFFER."
(with-current-buffer buffer
(org-with-wide-buffer
(let ((org-use-tag-inheritance t)
(org-use-property-inheritance t))
(goto-char (point-min))
(when (org-before-first-heading-p)
(outline-next-heading))
(cl-loop while (re-search-forward org-complex-heading-regexp nil t)
collect (save-excursion
(goto-char (match-beginning 0))
(let* ((heading (substring-no-properties (org-get-heading t t)))
url title tags meta)
(when (cond ((string-match (rx bos "http" (optional "s") "://") heading)
(setq url heading))
((when-let* ((link (org-match-link heading)))
(setq url (concat (org-link-protocol link) ":"
(org-link-path link))
title (org-link-description link)))))
(setq tags (->> (org-get-tags-at)
(--map (->> it substring-no-properties intern))
(delq 'elfeed))
meta (ap/elfeed-org--entry-properties))
(let ((feed (elfeed-db-get-feed url)))
(setf (elfeed-feed-meta feed)
(kvplist-merge (elfeed-feed-meta feed) meta))
(setf (elfeed-meta feed :title) title)
(setf (elfeed-meta feed :tags) tags)
feed)))))))))
(defcustom ap/elfeed-org-properties '("background" "foreground" "face")
"List of properties to read from entries, which will be applied to the feed's metadata."
:type '(repeat string))
(defun ap/elfeed-org--entry-properties ()
"Return plist of selected properties in current entry."
(cl-loop for property in ap/elfeed-org-properties
for value = (org-entry-get-with-inheritance property)
for keyword = (intern (concat ":" property))
append (list keyword value)))
;;;; elfeed-goodies
(use-package elfeed-goodies
:config
(defun ap/elfeed-goodies/entry-line-draw (entry)
"AP's version of this function. Prints ENTRY to the buffer."
(cl-flet ((add-faces (str &rest faces)
(dolist (face faces str)
(add-face-text-property 0 (length str)
face 'append str)))
(tags (entry)
(seq-difference (--map (substring-no-properties (symbol-name it))
(elfeed-entry-tags entry))
'("unread" "starred"))))
(let* (;; Choose color and faces first
;; See https://www.reddit.com/r/emacs/comments/7a976a/face_applied_to_result_of_symbolname_becomes/
(rainbow-identifiers-cie-l*a*b*-saturation 25)
;; Feed
(feed (elfeed-entry-feed entry))
(feed-title (when feed
(or (elfeed-meta feed :title) (elfeed-feed-title feed))))
(feed-url (elfeed-feed-url feed))
(feed-hash (rainbow-identifiers--hash-function feed-url))
(entry-face (rainbow-identifiers-cie-l*a*b*-choose-face feed-hash))
(title-faces (elfeed-search--faces (elfeed-entry-tags entry)))
(feed-width elfeed-goodies/feed-source-column-width)
(feed-face (ap/elfeed-search--entry-face entry))
(feed-column (elfeed-format-column feed-title feed-width :left))
(feed-column (apply #'add-faces feed-column feed-face title-faces))
;; Tags before title (so title can use the width of the tags column for this item)
(tags (tags entry))
(tags-str (s-join "," tags))
;; Use raw tag list to matchescheck for starred
(starred-p (member 'starred (elfeed-entry-tags entry)))
(tags-width (min (length tags-str)
elfeed-goodies/tag-column-width))
(tag-column (elfeed-format-column tags-str tags-width :right))
(tag-column (apply #'add-faces tag-column entry-face title-faces))
;; Title
(title (or (elfeed-meta entry :title) (elfeed-entry-title entry) ""))
(title-width (- (window-width) feed-width tags-width 4))
(title-column (elfeed-format-column (truncate-string-to-width title title-width nil nil 'ellipsis) title-width :left))
(title-column (apply #'add-faces title-column entry-face title-faces)))
(insert feed-column " "
(if starred-p
(propertize "*" 'face 'pocket-reader-favorite-star)
" ")
" "
(propertize title-column 'kbd-help title) " "
tag-column))))
(advice-add #'elfeed-goodies/entry-line-draw :override #'ap/elfeed-goodies/entry-line-draw)
(defun ap/elfeed-search-entry-toggle-star ()
"Toggle `starred' tag to current entry."
(interactive)
(let ((entry (elfeed-search-selected 'entry-at-point)))
(if (elfeed-tagged-p 'starred entry)
(elfeed-untag entry 'starred)
(elfeed-tag entry 'starred))
(elfeed-search-update-entry entry))
(forward-line))
(defun ap/elfeed-goodies/setup ()
"AP's version of this function."
(interactive)
(add-hook 'elfeed-show-mode-hook #'elfeed-goodies/show-mode-setup)
(add-hook 'elfeed-new-entry-hook #'elfeed-goodies/html-decode-title)
(when (boundp 'elfeed-new-entry-parse-hook)
(add-hook 'elfeed-new-entry-parse-hook #'elfeed-goodies/parse-author))
(setq ;; elfeed-search-header-function #'elfeed-goodies/search-header-draw
elfeed-search-print-entry-function #'elfeed-goodies/entry-line-draw
elfeed-show-entry-switch #'elfeed-goodies/switch-pane
elfeed-show-entry-delete #'elfeed-goodies/delete-pane
elfeed-show-refresh-function #'elfeed-goodies/show-refresh--plain)
(define-key elfeed-show-mode-map "n" #'elfeed-goodies/split-show-next)
(define-key elfeed-show-mode-map "p" #'elfeed-goodies/split-show-prev))
(elfeed-goodies/setup)
(advice-add #'elfeed-goodies/setup :override #'ap/elfeed-goodies/setup)
;;;;; Sorting
(defun ap/elfeed-search-entry< (a b)
"Return non-nil if A should be sorted before B."
(cl-flet* ((tags (it) (elfeed-entry-tags it))
(day (it) (time-to-days (seconds-to-time (elfeed-entry-date it))))
(compare-days (a b)
(let* ((a-day (day a))
(b-day (day b)))
(if (= a-day b-day)
;; Same day: compare tags, then domain, then timestamp
(cl-case (ap/elfeed-search-tags< a-tags b-tags)
('< t)
('> nil)
('= ;; Same tags; compare domain (invert since the default order is descending)
(cl-case (ap/elfeed-search-domain< a b)
('< t)
('> nil)
('= ;; Same site; compare timestamp
(< (elfeed-entry-date a) (elfeed-entry-date b))))))
;; Different day: compare day
(< a-day b-day)))))
(let* ((a-tags (tags a))
(b-tags (tags b))
(a-starred (member 'starred a-tags))
(b-starred (member 'starred b-tags))
(a-certain-tags (member 'matchescheck a-tags))
(b-certain-tags (member 'matchescheck b-tags)))
;; Inverting the values because we usually use descending order
(cond ((and a-starred b-starred) (compare-days a b))
(a-starred nil)
(b-starred t)
((and a-certain-tags b-certain-tags) nil)
(a-certain-tags nil)
(b-certain-tags t)
(t (compare-days a b))))))
(defun ap/elfeed-search-domain< (a b)
"Return the relationship of A's domain to B's.
If alphabetically less or greater than, return `<' or `>',
respectively. If the same, return `='."
(cl-flet ((domain (it) (pocket-reader--url-domain (elfeed-entry-link it))))
(let ((a-domain (domain a))
(b-domain (domain b)))
(cond ((string= a-domain b-domain) '=)
((string< a-domain b-domain) '<)
(t '>)))))
(defun ap/elfeed-search-tags< (a-tags b-tags)
"Return the relationship of A's tags to B's."
;; Convert list of symbols to comma-separated string of tags
(if (not (or a-tags b-tags))
;; No tags
'=
;; Some tags
(if (not (and a-tags b-tags))
;; One item has no tags
(if a-tags
'<
'>)
;; Both items have tags
(let ((a-length (length a-tags))
(b-length (length b-tags)))
(if (/= a-length b-length)
;; Different number of tags
(if (< a-length b-length)
'<
'>)
;; Same number of tags
(let ((a-string (s-join "" (mapcar #'symbol-name a-tags)))
(b-string (s-join "" (mapcar #'symbol-name b-tags))))
(cond ((string= a-string b-string) '=)
((string< a-string b-string) '<)
(t '>)))))))))
;;;; elfeed-search buffer
;;;;; Marking as read
(defun ap/elfeed-search-mark-group-as-read (predicate)
"Mark all non-starred entries as read in the group at point, grouped by PREDICATE."
(let* ((offset (- (line-number-at-pos) elfeed-search--offset))
(current-entry (nth offset elfeed-search-entries))
(value (funcall predicate current-entry))
(entries (--filter (and (equal value (funcall predicate it))
(not (member 'starred (elfeed-entry-tags it))))
elfeed-search-entries)))
(elfeed-untag entries 'unread)
(mapc #'elfeed-search-update-entry entries)))
(defun ap/elfeed-search-mark-site-as-read ()
"Mark all entries as read in the current site and day at point."
(interactive)
(ap/elfeed-search-mark-group-as-read (lambda (entry)
(list (time-to-days (seconds-to-time (elfeed-entry-date entry)))
(elfeed-entry-feed entry)))))
(defun ap/elfeed-search-mark-day-as-read ()
"Mark all entries as read in the day at point."
(interactive)
(ap/elfeed-search-mark-group-as-read (lambda (entry)
(time-to-days (seconds-to-time (elfeed-entry-date entry))))))
;;;;; Browsing commands
(cl-defun ap/elfeed-search-selected-map (fn)
"Map FN across selected entries in elfeed-search buffer using `mapcar'."
;; NOTE: I'm not sure of the best way to handle this. The issue is with the way elfeed-search
;; commands operate on selected entries. elfeed-search-selected returns a list of entries, and
;; other code can operate on those entries. But to modify the buffer, the offsets of each entry
;; in elfeed-search-entries must be determined, and depending on what you're doing, that ends up
;; calculating the offsets repeatedly. For example, to do something with selected entries and
;; update them in the search buffer gets the entries, then gets their offset to go to an entry's
;; line, and then uses that offset to get the entry again. There must be a better way.
(mapcar fn (elfeed-search-selected)))
(defun ap/elfeed-search-browse-entry (entry)
"Browse ENTRY with `browse-url' and mark as read.
If ENTRY is unread, it will also be unstarred. To override the
browser function, bind `browse-url-browser-function' around the
call to this."
(let ((url (elfeed-entry-link entry))
(tags (elfeed-entry-tags entry)))
;; Mark as read first, because apparently the elfeed functions don't work after `browse-url'
;; potentially changes the buffer.
(elfeed-untag entry 'unread)
(elfeed-search-update-entry entry)
(browse-url url)))
(defun ap/elfeed-search-browse-w3m ()
"Open selected items in w3m."
(interactive)
(let ((browse-url-browser-function #'w3m-browse-url))
(ap/elfeed-search-selected-map #'ap/elfeed-search-browse-entry)))
(defun ap/elfeed-search-browse-chrome ()
"Open selected items in EWW."
(interactive)
(let ((browse-url-browser-function #'browse-url-chrome))
(ap/elfeed-search-selected-map #'ap/elfeed-search-browse-entry)))
(defun ap/elfeed-search-browse-org ()
"Open selected items as Org."
(interactive)
(let ((browse-url-browser-function (lambda (url _)
(org-web-tools-read-url-as-org url))))
(ap/elfeed-search-selected-map #'ap/elfeed-search-browse-entry)))
(defun ap/elfeed-add-links-to-pocket ()
"Add selected entries in Elfeed search buffer to Pocket, with tags, and mark as unstarred and read in Elfeed."
(interactive)
(when-let* ((entries (elfeed-search-selected))
(groups (--group-by (elfeed-entry-tags it) entries)))
;; Add each group to Pocket
(cl-loop with added-urls
for group in groups
for tags = (substring-no-properties (s-join "," (mapcar #'symbol-name (remove 'unread (car group)))))
for links = (--map (elfeed-entry-link it) (cdr group))
when (pocket-lib-add-urls links :tags tags)
append links into added-urls
finally do (message "Added: %s" (s-join ", " added-urls)))
(apply #'elfeed-untag entries '(unread starred))
(mapc #'elfeed-search-update-entry entries)))
;;;;; Excerpt display
(defmacro ap/elfeed-search-at-entry (entry &rest body)
"Eval BODY with point at ENTRY."
(declare (indent defun))
`(when-let* ((n (cl-position ,entry elfeed-search-entries)))
(elfeed-goto-line (+ elfeed-search--offset n))
,@body))
(defun ap/elfeed-search-excerpt-toggle-selected (&optional hide-all)
"Toggle excerpts on selected entries.
With prefix, hide all excerpts."
(interactive (list current-prefix-arg))
(if hide-all
(ov-clear 'type 'excerpt)
(--each (elfeed-search-selected)
(ap/elfeed-search-at-entry it
(ap/elfeed-excerpt-toggle)))))
(defun ap/elfeed-excerpt-toggle ()
(interactive)
(or (ap/elfeed-excerpt-hide)
(ap/elfeed-excerpt-insert)))
(defun ap/elfeed-excerpt-hide ()
(interactive)
(when-let ((pos (1+ (line-end-position)))
(overlay (car (ov-in 'type 'excerpt pos pos))))
(delete-overlay overlay)
t))
(defun ap/elfeed-wrap-string (string length)
"Wrap STRING to LENGTH."
(if (<= (length string) length)
string
(s-trim (with-temp-buffer
(insert string)
(let ((fill-column length))
(fill-region (point-min) (point-max))
(buffer-string))))))
(defun ap/elfeed-excerpt-insert ()
"Show excerpt of current entry."
(interactive)
(when-let* ((pos (1+ (line-end-position)))
(width (window-text-width))
(entry (elfeed-search-selected 'ignore-region))
(ref (elfeed-entry-content entry))
(content (elfeed-deref ref))
(excerpt (--> content
(with-temp-buffer
(elfeed-insert-html it)
(buffer-string))
(ap/elfeed-wrap-string it width)
(concat it "\n")
(propertize it 'face '(:inherit (variable-pitch default))))))
(ov pos pos
'type 'excerpt
'after-string excerpt)
;; TODO: Only mark as read when multiple entries selected
(elfeed-untag entry 'unread)
(elfeed-search-update-entry entry)))
;;;;; Post-processing
(defun ap/elfeed-search-post-process ()
(ap/elfeed-search-add-separators))
(add-hook 'elfeed-search-update-hook #'ap/elfeed-search-post-process)
;;;;;; Date separators
(cl-defun ap/elfeed-search-add-separators (&key (min-group-size 2))
"Insert overlay spacers where the current date changes.
If no group has at least MIN-GROUP-SIZE items, no spacers will be
inserted. "
;; TODO: Use column-specific functions so that, e.g. date column could be grouped by month/year
(cl-labels ((insert-date (date)
(ov (line-beginning-position) (line-beginning-position)
'before-string (propertize (format "\n%s\n" date)
'face 'elfeed-search-date-face)
'type 'date-separator))
(entry-date (offset)
(when-let ((entry (nth offset elfeed-search-entries)))
(elfeed-search-format-date (elfeed-entry-date entry)))))
(ov-clear)
(save-excursion
(goto-char (point-min))
(cl-loop with largest-group-size = 1
with offset = (- 1 elfeed-search--offset) ; 1 is first line
with prev-data = (entry-date offset)
initially do (insert-date prev-data)
while (not (eobp))
do (progn
(forward-line 1)
(incf offset))
for current-data = (entry-date offset)
if (not (equal current-data prev-data))
do (when current-data
(insert-date current-data)
(setq prev-data current-data))
else do (incf largest-group-size)
finally do (when (< largest-group-size min-group-size)
(ov-clear))))))
;;;;;; Colorize entries
(defun ap/elfeed-search--entry-face (entry)
"Return face for ENTRY."
;; TODO: Make this customizeable per-site. I could make each entry resemble the site's colors.
(or (--> entry
(elfeed-entry-feed it)
(elfeed-feed-meta it)
(-let (((&plist :background background :foreground foreground) it)
(face nil))
(when (or background foreground)
(when background
(setq face (plist-put face :background background)))
(when foreground
(setq face (plist-put face :foreground foreground)))
face)))
(cdr (cl-assoc (elfeed-feed-url (elfeed-entry-feed entry)) ap/elfeed-feed-faces
:test (lambda (string regexp)
;; Argument order is reversed
(string-match regexp string))))
(->> entry
elfeed-entry-feed
elfeed-feed-url
rainbow-identifiers--hash-function
rainbow-identifiers-cie-l*a*b*-choose-face)))
;; NOTE: Probably don't need this anymore since I added `ap/elfeed-org', but it might still be useful.
(defcustom ap/elfeed-feed-faces nil
"Per-feed faces."
:type '(cons string face))
;;;;; Views
(cl-defun ap/elfeed-view-tag (str &key add toggle)
"Concat STR with `elfeed-search-filter'.
If ADD is non-nil, return current filter with STR added. If
TOGGLE is non-nil, return current filter with STR added or
removed from it."
(cond (add (concat elfeed-search-filter " " str))
(toggle (if (string-match (regexp-quote str) elfeed-search-filter)
(s-replace-regexp (rx-to-string `(seq (optional (1+ space)) ,str (optional (1+ space))))
"" elfeed-search-filter 'fixedcase 'literal)
(concat elfeed-search-filter " " str)))
(t (concat (default-value 'elfeed-search-filter) " " str))))
(defhydra ap/elfeed-search-view-hydra (:color blue :hint t)
"Set elfeed-search filter tags"
;; "
;; Set elfeed-search filter tags:
;; _d_efault _n_ews
;; _s_tarred (toggle) _p_olitics
;; _t_ech
;; "
("d" (elfeed-search-set-filter nil) "Default")
("n" (elfeed-search-set-filter (ap/elfeed-view-tag "+news")) "news")
("p" (elfeed-search-set-filter (ap/elfeed-view-tag "+politics")) "politics")
("s" (elfeed-search-set-filter (ap/elfeed-view-tag "-starred" :toggle t)) "unstarred (toggle)")
("t" (elfeed-search-set-filter (ap/elfeed-view-tag "+tech")) "tech"))
;;;; Entry hooks
;; FIXME: elfeed-new-entry-hook is being reset to nil when I run `elfeed'.
;;;;; Automatically apply tags
;;;;; Taggers
(define-arx url-rx
'((http (seq bos (group "http") "://") )
(https (seq bos (group "https") "://") )
(https? (seq bos (group "http" (optional "s")) "://") )
(protocol (seq bos (group (1+ (not (any ":")))) "://"))
(host (group (1+ (not (any "/")))))
(path (group "/" (1+ (not (any "?")))))
(query (seq "?" (group (1+ (not (any "#"))))))
(fragment (seq "#" (group (1+ anything))))))
;; FIXME: See https://github.com/skeeto/elfeed/issues/292
;;;;;; Reddit
;; For reddit.com/user feeds
(defun ap/elfeed/reddit.com/user--rewrite-title (entry)
(pcase-let* ((user (elfeed-meta entry :author))
(title (second (s-match (rx-to-string `(seq (eval user) (1+ space) "on" (1+ space) (group (1+ anything))))
(elfeed-entry-title entry))))
(sub (car (elfeed-meta entry :categories)))
(new-title (format$ "on /r/$sub/$title")))
(unless (s-starts-with? "on /r/" title)
;; Doesn't already have prefix
(setf (elfeed-meta entry :title) new-title))))
(add-hook 'elfeed-new-entry-hook
(elfeed-make-tagger :feed-url (url-rx https? "www.reddit.com/user/" (1+ anything) "/.rss")
:callback #'ap/elfeed/reddit.com/user--rewrite-title))
;;;;;; lobste.rs
(add-hook 'elfeed-new-entry-hook
(elfeed-make-tagger :feed-url (url-rx https? "lobste.rs")
:callback (defun ap/elfeed/lobste.rs--rewrite-link (entry)
"Replace link in lobste.rs entry with link to comments page."
(-let (((namespace . comments-link) (elfeed-entry-id entry)))
(when (and comments-link
(s-prefix-p "http" comments-link))
(setf (elfeed-entry-link entry) comments-link))))))
;;;;; Misc
;; Dev code
(defun ap/elfeed-delete-entries (pred)
"Delete entries from `elfeed-db-index' and `elfeed-db-entries' that PRED returns non-nil for.
PRED is called with one argument, the entry."
(let ((size-before (ht-size elfeed-db-entries))
size-after )
(cl-loop for key being the hash-keys of elfeed-db-entries
using (hash-values entry)
when (funcall pred entry)
do (progn
(avl-tree-delete elfeed-db-index (elfeed-entry-id entry))
(ht-remove elfeed-db-entries key)))
(a-list 'before size-before
'after (ht-size elfeed-db-entries))))
(defun ap/elfeed-browse-random-starred ()
"Open random starred entry in external browser."
(interactive)
;; Make sure first entry is starred, otherwise there aren't any and we'd loop infinitely.
(unless (member 'starred (elfeed-entry-tags (first elfeed-search-entries)))
(user-error "No starred entries in current view"))
(cl-flet ((choose-n (items)
(cl-random (length items))))
(let ((entry-num (cl-loop for n = (choose-n elfeed-search-entries)
for entry = (nth n elfeed-search-entries)
until (member 'starred (elfeed-entry-tags entry))
finally return n)))
(goto-line entry-num)
(ap/elfeed-search-chrome))))
;;;; ov functions
;; NOTE: Hopefully these overlay functions can be merged into ov.el. See
;; https://github.com/ShingoFukuyama/ov.el/issues/14
(cl-defun ov-in-prev (&optional point-or-prop prop-or-val (val 'any))
"Get the previous overlay satisfying a condition.
If POINT-OR-PROP is a symbol, get the previous overlay with this
property being non-nil.
If PROP-OR-VAL is non-nil, the property should have this value.
If POINT-OR-PROP is a number, get the previous overlay after this
point.
If PROP-OR-VAL and VAL are also specified, get the previous
overlay after POINT-OR-PROP having property PROP-OR-VAL set to
VAL (with VAL unspecified, only the presence of property is
tested)."
(cl-labels ((any (pos)
(car (overlays-in (previous-overlay-change pos) (previous-overlay-change pos))))
(property (pos property)
(save-excursion
(goto-char pos)
(cl-loop while (and (not (bobp))
(goto-char (previous-overlay-change (point))))
when (cl-loop for ov in (overlays-in (point) (point))
when (plist-get (ov-prop ov) property)
return ov)
return it)))
(property-value (pos property value)
(save-excursion
(goto-char pos)
(cl-loop while (and (not (bobp))
(goto-char (previous-overlay-change (point))))
when (cl-loop for ov in (overlays-in (point) (point))
for ov-value = (plist-get (ov-prop ov) property)
when (equal ov-value value)
return ov)
return it))))
(pcase point-or-prop
((pred numberp) (pcase prop-or-val
(`nil (any point-or-prop))
(_ (pcase val
('any (property point-or-prop prop-or-val))
(_ (property-value point-or-prop prop-or-val val))))))
(`nil (any (point)))
(_ (pcase prop-or-val
(`nil (property (point) point-or-prop))
(_ (pcase val
('any (property (point) point-or-prop))
(_ (property-value point-or-prop prop-or-val val)))))))))
(cl-defun ov-in-next (&optional point-or-prop prop-or-val (val 'any))
"Get the next overlay satisfying a condition.
If POINT-OR-PROP is a symbol, get the next overlay with this
property being non-nil.
If PROP-OR-VAL is non-nil, the property should have this value.
If POINT-OR-PROP is a number, get the next overlay after this
point.
If PROP-OR-VAL and VAL are also specified, get the next overlay
after POINT-OR-PROP having property PROP-OR-VAL set to VAL (with
VAL unspecified, only the presence of property is tested)."
(cl-labels ((any (pos)
(car (overlays-in (next-overlay-change pos) (next-overlay-change pos))))
(property (pos property)
(save-excursion
(goto-char pos)
(cl-loop while (and (not (bobp))
(goto-char (next-overlay-change (point))))
when (cl-loop for ov in (overlays-in (point) (point))
when (plist-get (ov-prop ov) property)
return ov)
return it)))
(property-value (pos property value)
(save-excursion
(goto-char pos)
(cl-loop while (and (not (bobp))
(goto-char (next-overlay-change (point))))
when (cl-loop for ov in (overlays-in (point) (point))
for ov-value = (plist-get (ov-prop ov) property)
when (equal ov-value value)
return ov)
return it))))
(pcase point-or-prop
((pred numberp) (pcase prop-or-val
(`nil (any point-or-prop))
(_ (pcase val
('any (property point-or-prop prop-or-val))
(_ (property-value point-or-prop prop-or-val val))))))
(`nil (any (point)))
(_ (pcase prop-or-val
(`nil (property (point) point-or-prop))
(_ (pcase val
('any (property (point) point-or-prop))
(_ (property-value point-or-prop prop-or-val val))))))))))
;;; Footer
(provide 'ap/elfeed)
@alphapapa
Copy link
Author

alphapapa commented Jul 6, 2021

@dorneau I forgot that I had put this here. How did you find it? :)

@dorneanu
Copy link

dorneanu commented Jul 7, 2021

I was searching for "elfeed pocket-reader customizations" :) But my Lisp skills are way to limited to understand this :D

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment