/elfeed-config.el
Created Sep 13, 2018
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 | |
| ;; 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) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment