Elfeed config

elfeed-config.el

;;; 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)

Insane! :)

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

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