├── .gitignore ├── Makefile ├── NEWS.md ├── README.md ├── UNLICENSE ├── elfeed-csv.el ├── elfeed-curl.el ├── elfeed-db.el ├── elfeed-lib.el ├── elfeed-link.el ├── elfeed-log.el ├── elfeed-pkg.el ├── elfeed-search.el ├── elfeed-show.el ├── elfeed.el ├── tests ├── elfeed-curl-tests.el ├── elfeed-db-tests.el ├── elfeed-lib-tests.el ├── elfeed-search-tests.el ├── elfeed-tests.el └── xml-query-tests.el ├── web ├── elfeed-web-pkg.el ├── elfeed-web.el ├── elfeed.css ├── elfeed.js └── index.html └── xml-query.el /.gitignore: -------------------------------------------------------------------------------- 1 | *.elc 2 | *.tar 3 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | .POSIX: 2 | EMACS = emacs 3 | BATCH = $(EMACS) -batch -Q -L . -L tests 4 | VERSION = 3.4.2 5 | 6 | EL = elfeed-csv.el elfeed-curl.el elfeed-db.el elfeed-lib.el \ 7 | elfeed-log.el elfeed-show.el elfeed.el xml-query.el \ 8 | elfeed-search.el elfeed-link.el 9 | DOC = README.md NEWS.md UNLICENSE elfeed-pkg.el 10 | WEB = web/elfeed-web-pkg.el web/elfeed-web.el web/elfeed.css \ 11 | web/elfeed.js web/index.html 12 | TEST = tests/elfeed-db-tests.el tests/elfeed-lib-tests.el \ 13 | tests/elfeed-tests.el tests/elfeed-search-tests.el \ 14 | tests/elfeed-curl-tests.el tests/xml-query-tests.el 15 | 16 | compile: $(EL:.el=.elc) $(TEST:.el=.elc) 17 | 18 | check: test 19 | test: $(EL:.el=.elc) $(TEST:.el=.elc) 20 | $(BATCH) -l tests/elfeed-tests.elc -f ert-run-tests-batch 21 | 22 | package: elfeed-$(VERSION).tar elfeed-web-$(VERSION).tar 23 | 24 | clean: 25 | rm -f *.tar $(EL:.el=.elc) $(TEST:.el=.elc) 26 | 27 | virtual: compile 28 | (mkdir -p tmp-$$$$/.elfeed; \ 29 | cp ~/.elfeed/index tmp-$$$$/.elfeed/ 2>/dev/null || true; \ 30 | trap "rm -rf tmp-$$$$" INT EXIT; \ 31 | HOME=$$PWD/tmp-$$$$ $(EMACS) -L . -l elfeed.elc $(ARGS)) 32 | 33 | elfeed-$(VERSION).tar: $(EL) $(DOC) 34 | rm -rf elfeed-$(VERSION)/ 35 | mkdir elfeed-$(VERSION)/ 36 | cp $(EL) $(DOC) elfeed-$(VERSION)/ 37 | tar cf $@ elfeed-$(VERSION)/ 38 | rm -rf elfeed-$(VERSION)/ 39 | 40 | elfeed-web-$(VERSION).tar: $(WEB) 41 | rm -rf elfeed-web-$(VERSION)/ 42 | mkdir elfeed-web-$(VERSION)/ 43 | cp $(WEB) elfeed-web-$(VERSION)/ 44 | tar cf $@ elfeed-web-$(VERSION)/ 45 | rm -rf elfeed-web-$(VERSION)/ 46 | 47 | elfeed-csv.elc: elfeed-db.elc 48 | elfeed-curl.elc: elfeed-lib.elc elfeed-log.elc 49 | elfeed-db.elc: elfeed-lib.elc 50 | elfeed-show.elc: elfeed.elc elfeed-db.elc elfeed-lib.elc elfeed-search.elc 51 | elfeed-link.elc: elfeed.elc elfeed-search.elc elfeed-show.elc 52 | elfeed.elc: elfeed-lib.elc elfeed-log.elc elfeed-curl.elc elfeed-db.elc \ 53 | xml-query.elc 54 | elfeed-search.elc: elfeed.elc elfeed-db.elc elfeed-lib.elc 55 | tests/elfeed-curl-tests.elc: elfeed-lib.elc elfeed-curl.elc 56 | tests/elfeed-db-tests.elc: elfeed.elc elfeed-db.elc elfeed-lib.elc 57 | tests/elfeed-lib-tests.elc: elfeed-lib.elc 58 | tests/elfeed-tests.elc: elfeed.elc elfeed-lib.elc elfeed-curl.elc \ 59 | tests/xml-query-tests.elc tests/elfeed-db-tests.elc \ 60 | tests/elfeed-lib-tests.elc tests/elfeed-search-tests.elc \ 61 | tests/elfeed-curl-tests.elc 62 | tests/elfeed-search-tests.elc: elfeed-search.elc 63 | tests/xml-query-tests.elc: xml-query.elc 64 | 65 | .SUFFIXES: .el .elc 66 | 67 | .el.elc: 68 | $(BATCH) -f batch-byte-compile $< 69 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # Changes 2 | 3 | ## 3.4.2 (2024-07-29) 4 | 5 | * Fix `browse-url` usage (243add9e) 6 | 7 | * Deal with various warnings from recent Emacs releases 8 | 9 | ## 3.4.1 (2021-02-25) 10 | 11 | * Fix elfeed-search-last-entry and elfeed-search-first-entry 12 | 13 | ## 3.4.0 (2021-01-30) 14 | 15 | * New search filter: ~ excludes matching feeds 16 | 17 | * Support fetching feeds via file:// 18 | 19 | * Support fetching feeds via the Gopher protocol 20 | 21 | * "End of entries" no longer appears in elfeed-search 22 | 23 | * Support bookmarks in entries 24 | 25 | * New customizations: elfeed-show-entry-switch, elfeed-show-entry-delete 26 | 27 | * More extensive information from elfeed-curl-get-capabilities 28 | 29 | * New elfeed-show command: elfeed-kill-link-url-at-point (c) 30 | 31 | * Various other minor behavior improvements 32 | 33 | ## 3.3.0 (2019-11-23) 34 | 35 | * New option: `elfeed-search-remain-on-entry`. 36 | 37 | * More graceful handling of feed filters (=). 38 | 39 | * Fix minor time handling issue with Emacs >= 26.1 40 | 41 | * Load bookmarks before trying to use them. 42 | 43 | ## 3.2.0 (2019-08-24) 44 | 45 | * Support for absolute date/time expressions in filters. See README.md 46 | for documentation and examples. 47 | 48 | * curl's `--disable` is now default. To load your .curlrc file, use 49 | `--config` explicitly in `elfeed-curl-extra-arguments`. 50 | 51 | * Re-enable curl's HTTP/2 support. 52 | 53 | * Function `elfeed-next-link` was renamed to `elfeed-show-next-link`. 54 | 55 | * New search buffer bindings: <, >, h, c 56 | 57 | * Multiple authors are now parsed from entries. Reflecting this, the 58 | meta key for authors is now `:authors` instead of `:author`. The 59 | value is always a list of zero or more authors. 60 | 61 | * New variable: `elfeed-show-unique-buffers`. Allows for displaying 62 | multiple show buffers at the same time. 63 | 64 | * Various minor fixes and improvements. 65 | 66 | ## 3.1.0 (2018-08-29) 67 | 68 | * Add `elfeed-show-enclosure-filename-function` for controlling 69 | enclosure filenames. 70 | 71 | * Dynamically enable/disable --compressed curl option. On some systems 72 | curl is built without this option, so it causes errors when it is 73 | used. 74 | 75 | * Minor documentation fixes. 76 | 77 | ## 3.0.0 (2018-05-13) 78 | 79 | * Under Emacs 26, there is a new database index format (version 4). 80 | 81 | Emacs 26 introduces a new "record" type, and cl-defstruct objects used 82 | by Elfeed as its database format are now based on this type. This 83 | unfortunately changes (and breaks) Elfeed's index format. Prior to this 84 | release, Emacs 26 could not open an Emacs 24–25 index and vice versa. 85 | 86 | As of Elfeed 2.4.0, Elfeed running under Emacs 26 will automatically and 87 | quietly upgrade an Emacs 25 database index for Emacs 26. **THIS UPGRADE 88 | IS IRREVERSIBLE** and the database can no longer be used with Emacs 25. 89 | A one-time backup copy ("index.backup") of the original Emacs 25 index 90 | is created before performing the upgrade. If Emacs 25, whether running 91 | this or any prior Elfeed release, loads the new database format, it will 92 | see an empty database as if starting from scratch. 93 | 94 | ## 2.3.1 (2018-05-13) 95 | 96 | * The index is now saved when quitting the elfeed-search window ("q"). 97 | * `elfeed-link` is now autoloaded. 98 | 99 | ## 2.3.0 (2018-01-21) 100 | 101 | * New `=` syntax in search filters 102 | * Support for protocol-relative entry links (i.e. //example.com/foo/) 103 | * New `elfeed-add-feed` `:save` key argument 104 | * New plist-based parsed search filter format (breaking change) 105 | * New hook: `elfeed-search-update-hook` 106 | * New hook: `elfeed-db-unload-hook` 107 | * New variable: `elfeed-search-sort-function` 108 | * Connect curl with a pipe instead of a pty—a performance boost 109 | * Minor bug fixes 110 | 111 | ## 2.2.0 (2017-07-09) 112 | 113 | * Support for org links (`elfeed-link.el`) 114 | * Added `elfeed-db-unload` 115 | * New `elfeed-curl-retrieve` interface (breaking changes) 116 | * New hooks `elfeed-tag-hooks` and `elfeed-untag-hooks` 117 | 118 | ## 2.1.1 (2017-04-02) 119 | 120 | * Added `elfeed-show-entry-author` customization variable. 121 | * Added `elfeed-search-unparse-filter` 122 | 123 | ## 2.1.0 (2017-01-25) 124 | 125 | * New entry ID based only on domain, not whole feed 126 | * Byte-compiled search filters (`elfeed-search-compile-filter`) 127 | * Improved metadata persistence on entry updates 128 | * Gather `:author` from entries 129 | * Gather `:categories` from entries 130 | * New `elfeed-add-feed` interface (thanks Mark Oteiza) 131 | * New xml-query macros for faster feed parsing 132 | 133 | ## 2.0.1 (2016-10-30) 134 | 135 | * Added `elfeed-curl-extra-arguments` customization 136 | * Use `x-get-selection` instead of `x-get-selection-value` 137 | * More flexible date handling (including Atom 0.3 support) 138 | * Various elfeed-web fixes 139 | 140 | ## 2.0.0 (2016-08-26) 141 | 142 | * Elfeed now uses cURL when available (`elfeed-use-curl`) 143 | * Windows OS now supported when using cURL 144 | * Conditional GET (ETag, `If-Modified-Since`) when using cURL 145 | * Support for xml:base in Atom feeds 146 | * New options: `elfeed-set-max-connections`, `elfeed-set-timeout` 147 | * New feed metadata: :canonical-url, :etag, :last-modified 148 | * New variable: `elfeed-log-level` 149 | * New database export option: `elfeed-csv-export` 150 | * Additional validation for `elfeed-feeds` 151 | 152 | ## 1.4.1 (2016-05-25) 153 | 154 | * Major bug fix: disable local variables when loading the index 155 | * New command `elfeed-show-play-enclosure` (requires emms) 156 | * Yank now works on regions in the search buffer 157 | * Feed structs now have author field filled out 158 | * New command `elfeed-search-set-feed-title` 159 | * New command `elfeed-search-set-entry-title` 160 | * Smarter handling of invalid timestamps 161 | * Following links in show mode (`elfeed-show-visit`) takes a prefix arg 162 | 163 | ## 1.4.0 (2015-12-22) 164 | 165 | * New header built on Emacs' built-in buffer headers 166 | * New hook: `elfeed-new-entry-parse-hook` 167 | * Emacs' bookmark support (`bookmark-set`, `bookmark-jump`) 168 | * Emacs' desktop support (save/restore windows) 169 | * Custom faces in search listing via `elfeed-search-face-alist` 170 | * Dedicated log buffer, *elfeed-log* 171 | * Scoped updates with prefix argument to `elfeed-search-fetch` 172 | * Various bug fixes 173 | * Fixes to feed Unicode decoding 174 | 175 | ## 1.3.0 (2015-11-20) 176 | 177 | * `elfeed-search-face-alist` for custom entry faces 178 | * `display-local-help` (C-h .) support in search 179 | * Fixes to #n count filter 180 | 181 | ## 1.2.0 (2015-10-05) 182 | 183 | * Switched to url-queue (see `url-queue-timeout`) 184 | * New #n filter for limiting results to first n entries 185 | * Faster live filtering 186 | * `elfeed-version` 187 | * Enclosure downloading 188 | * Database size optimizations 189 | * Search listing is more responsive to updates 190 | * `elfeed-http-error-hooks`, `elfeed-parse-error-hooks` 191 | * Various bug fixes 192 | 193 | ## 1.1.2 (2014-11-04) 194 | 195 | * Fixed support for non-HTTP protocols 196 | * Add ! search syntax 197 | * Add elfeed-unjam 198 | * Combine regexp search terms by AND instead of OR 199 | * Link navigation keybindings (tab) 200 | * Add elfeed-show-truncate-long-urls 201 | * Add elfeed-search-filter customization 202 | * Various bug fixes 203 | 204 | ## 1.1.1 (2014-06-14) 205 | 206 | * Fix database corruption issue 207 | * Properly handle URLs from XML 208 | * Slightly better RSS date guessing 209 | * User interface tweaks 210 | * Add `elfeed-sort-order` 211 | * Use tab and backtab to move between links 212 | 213 | ## 1.1.0 (2014-01-27) 214 | 215 | * Autotagging support 216 | * Better database performance 217 | * Database packing 218 | * Arbitrary struct metadata 219 | * Added `elfeed-search-clipboard-type` 220 | * Update to cl-lib from cl 221 | * Lots of bug fixes 222 | 223 | ## 1.0.1 (2013-09-08) 224 | 225 | * Live filter editing 226 | * Support for RSS 1.0 227 | * OPML import/export 228 | * Fix multibyte support (thanks cellscape) 229 | * Fix date-change database corruption 230 | * Add n and p bindings to elfeed-search, like notmuch 231 | * Friendlier intro header 232 | * Automated builds 233 | * Lots of small bug fixes 234 | 235 | ## 1.0.0 (2013-09-02) 236 | 237 | * Initial release 238 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Elfeed Emacs Web Feed Reader 2 | 3 | Elfeed is an extensible web feed reader for Emacs, supporting both 4 | Atom and RSS. It requires Emacs 24.3 and is available for download 5 | from [MELPA](http://melpa.milkbox.net/) or 6 | [el-get](https://github.com/dimitri/el-get). Elfeed was inspired by 7 | [notmuch](http://notmuchmail.org/). 8 | 9 | For a longer overview, 10 | 11 | * [Introducing Elfeed, an Emacs Web Feed Reader](http://nullprogram.com/blog/2013/09/04/). 12 | * [Tips and Tricks](http://nullprogram.com/blog/2013/11/26/) 13 | * [Read your RSS feeds in Emacs with Elfeed 14 | ](http://pragmaticemacs.com/emacs/read-your-rss-feeds-in-emacs-with-elfeed/) 15 | * [Scoring Elfeed articles](http://kitchingroup.cheme.cmu.edu/blog/2017/01/05/Scoring-elfeed-articles/) 16 | * [Using Emacs 29](https://www.youtube.com/watch?v=pOFqzK1Ymr4), 17 | [30](https://www.youtube.com/watch?v=tjnK1rkO7RU), 18 | [31](https://www.youtube.com/watch?v=5zuSUbAHH8c) 19 | * [Take Elfeed everywhere: Mobile rss reading Emacs-style (for free/cheap)](http://babbagefiles.blogspot.com/2017/03/take-elfeed-everywhere-mobile-rss.html) 20 | * [Elfeed Rules!](https://noonker.github.io/posts/2020-04-22-elfeed/) ([reddit](https://old.reddit.com/r/emacs/comments/g6oowz/elfeed_rules/)) 21 | * [Elfeed with Tiny Tiny RSS](https://codingquark.com/emacs/2020/04/19/elfeed-protocol-ttrss.html) ([hn](https://news.ycombinator.com/item?id=22915200)) 22 | * [Open Emacs elfeed links in the background](http://xenodium.com/open-emacs-elfeed-links-in-background/) 23 | * [Using Emacs 72](https://cestlaz.github.io/post/using-emacs-72-customizing-elfeed/) 24 | * [Lazy Elfeed](https://karthinks.com/blog/lazy-elfeed/) 25 | * [Using Elfeed to View Videos](https://joshrollinswrites.com/help-desk-head-desk/20200611/) 26 | * [Manage podcasts in Emacs with Elfeed and Bongo](https://protesilaos.com/codelog/2020-09-11-emacs-elfeed-bongo/) 27 | * [... more ...](http://nullprogram.com/tags/elfeed/) 28 | * [... and more ...](http://pragmaticemacs.com/category/elfeed/) 29 | 30 | [![](http://i.imgur.com/kxgF5AH.png)](http://i.imgur.com/kxgF5AH.png) 31 | 32 | The database format is stable and is never expected to change. 33 | 34 | ## Prerequisites 35 | 36 | **It is *strongly* recommended you have cURL installed**, either in 37 | your PATH or configured via `elfeed-curl-program-name`. Elfeed will 38 | prefer it to Emacs' own URL-fetching mechanism, `url-retrieve`. It's 39 | also essential for running Elfeed on Windows, where `url-retrieve` is 40 | broken. Updates using cURL are significantly faster than the built-in 41 | method, both for you and the feed hosts. 42 | 43 | If this is giving you problems, fetching with cURL can be disabled by 44 | setting `elfeed-use-curl` to nil. 45 | 46 | ## Extensions 47 | 48 | These projects extend Elfeed with additional features: 49 | 50 | * [elfeed-org](https://github.com/remyhonig/elfeed-org) 51 | * [elfeed-goodies](https://github.com/algernon/elfeed-goodies) 52 | * [elfeed-protocol](https://github.com/fasheng/elfeed-protocol) 53 | * [elfeed-score](https://github.com/sp1ff/elfeed-score) 54 | * [Elfeed Android interface](https://github.com/areina/elfeed-cljsrn) 55 | ([Google Play](https://play.google.com/store/apps/details?id=com.elfeedcljsrn)) 56 | * [elfeed-dashboard](https://github.com/Manoj321/elfeed-dashboard) 57 | 58 | ## Getting Started 59 | 60 | Elfeed is broken into a multiple source files, so if you manually 61 | install it you will need to add the Elfeed package directory to your 62 | `load-path`. If installed via package.el or el-get, this will be done 63 | automatically. 64 | 65 | It is recommended that you make a global binding for `elfeed`. 66 | 67 | ```el 68 | (global-set-key (kbd "C-x w") 'elfeed) 69 | ``` 70 | 71 | Running the interactive function `elfeed` will pop up the 72 | `*elfeed-search*` buffer, which will display feed items. 73 | 74 | * g: refresh view of the feed listing 75 | * G: fetch feed updates from the servers 76 | * s: update the search filter (see tags) 77 | * c: clear the search filter 78 | 79 | This buffer will be empty until you add your feeds to the 80 | `elfeed-feeds` list and initiate an update with `M-x elfeed-update` 81 | (or G in the Elfeed buffer). This will populate the Elfeed 82 | database with entries. 83 | 84 | ```el 85 | ;; Somewhere in your .emacs file 86 | (setq elfeed-feeds 87 | '("http://nullprogram.com/feed/" 88 | "https://planet.emacslife.com/atom.xml")) 89 | ``` 90 | 91 | Another option for providing a feed list is with an OPML file. Running 92 | `M-x elfeed-load-opml` will fill `elfeed-feeds` with feeds listed in 93 | an OPML file. When `elfeed-load-opml` is called interactively, it will 94 | automatically save the feedlist to your customization file, so you 95 | will only need to do this once. 96 | 97 | If there are a lot of feeds, the initial update will take noticeably 98 | longer than normal operation because of the large amount of 99 | information being written the database. Future updates will only need 100 | to write new or changed data. If updating feeds slows down Emacs too 101 | much for you, reduce the number of concurrent fetches via 102 | `elfeed-set-max-connections`. 103 | 104 | If you're getting many "Queue timeout exceeded" errors, increase the 105 | fetch timeout via `elfeed-set-timeout`. 106 | 107 | ~~~el 108 | (setf url-queue-timeout 30) 109 | ~~~ 110 | 111 | From the search buffer there are a number of ways to interact with 112 | entries. Entries are selected by placing the point over an entry. 113 | Multiple entries are selected at once by using an active region. 114 | 115 | * RET: view selected entry in a buffer 116 | * b: open selected entries in your browser (`browse-url`) 117 | * y: copy selected entries URL to the clipboard 118 | * r: mark selected entries as read 119 | * u: mark selected entries as unread 120 | * +: add a specific tag to selected entries 121 | * -: remove a specific tag from selected entries 122 | 123 | ## Tags 124 | 125 | Elfeed maintains a list of arbitrary tags -- symbols attached to an 126 | entry. The tag `unread` is treated specially by default, with unread 127 | entries appearing in bold. 128 | 129 | ### Autotagging 130 | 131 | Tags can automatically be applied to entries discovered in specific 132 | feeds through extra syntax in `elfeed-feeds`. Normally this is a list 133 | of strings, but an item can also be a list, providing set of 134 | "autotags" for a feed's entries. 135 | 136 | ```el 137 | (setq elfeed-feeds 138 | '(("http://nullprogram.com/feed/" blog emacs) 139 | "http://www.50ply.com/atom.xml" ; no autotagging 140 | ("http://nedroid.com/feed/" webcomic))) 141 | ``` 142 | 143 | ### Filter Syntax 144 | 145 | To make tags useful, the Elfeed entry listing buffer can be filtered 146 | by tags. Use `elfeed-search-set-filter` (or s) to update 147 | the filter. Use `elfeed-search-clear-filter` to restore the default. 148 | 149 | Any component of the search string beginning with a `+` or 150 | a `-` is treated like a tag. `+` means the tag is required, `-` means 151 | the tag must not be present. 152 | 153 | A component beginning with a `@` indicates an age or a date range. An 154 | age is a relative time expression or an absolute date expression. 155 | Entries older than this age are filtered out. The age description 156 | accepts plain English, but cannot have spaces, so use dashes. For 157 | example, `"@2-years-old"`, `"@3-days-ago"` or `"@2019-06-24"`. A date 158 | range are two ages seperated by a `--`, e.g. 159 | `"@2019-06-20--2019-06-24"` or `"@5-days-ago--1-day-ago"`. The entry 160 | must be newer than the first expression but older than the second. The 161 | database is date-oriented, so **filters that include an age 162 | restriction are significantly more efficient.** 163 | 164 | A component beginning with a `!` is treated as an "inverse" regular 165 | expression. This means that any entry matching this regular expression 166 | will be filtered out. The regular expression begins *after* the `!` 167 | character. You can read this as "entry not matching `foo`". 168 | 169 | A component beginning with a `#` limits the total number of entries 170 | displayed to the number immediately following the symbol. For example, 171 | to limit the display to 20 entries: `#20`. 172 | 173 | A component beginning with a `=` is a regular expression matching the 174 | entry's feed (title or URL). Only entries belonging to a feed that 175 | matches at least one of the `=` expressions will be shown. 176 | 177 | A component beginning with a `~` is a regular expression matching the 178 | entry's feed (title or URL). Only entries belonging to a feed that 179 | matches none of the `~` expressions will be shown. 180 | 181 | All other components are treated as a regular expression, and only 182 | entries matching it (title or URL) will be shown. 183 | 184 | Here are some example filters. 185 | 186 | * `@6-months-ago +unread` 187 | 188 | Only show unread entries of the last six months. This is the default filter. 189 | 190 | * `linu[xs] @1-year-old` 191 | 192 | Only show entries about Linux or Linus from the last year. 193 | 194 | * `-unread +youtube #10` 195 | 196 | Only show the most recent 10 previously-read entries tagged as 197 | `youtube`. 198 | 199 | * `+unread !x?emacs` 200 | 201 | Only show unread entries not having `emacs` or `xemacs` in the title 202 | or link. 203 | 204 | * `+emacs =http://example.org/feed/` 205 | 206 | Only show entries tagged as `emacs` from a specific feed. 207 | 208 | #### Default Search Filter 209 | 210 | You can set your default search filter by changing the default value 211 | of `elfeed-search-filter`. It only changes buffer-locally when you're 212 | adjusting the filter within Elfeed. For example, some users prefer to 213 | have a space on the end for easier quick searching. 214 | 215 | (setq-default elfeed-search-filter "@1-week-ago +unread ") 216 | 217 | ### Tag Hooks 218 | 219 | The last example assumes you've tagged posts with `youtube`. You 220 | probably want to do this sort of thing automatically, either through 221 | the "autotags" feature mentioned above, or with the 222 | `elfeed-new-entry-hook`. Functions in this hook are called with new 223 | entries, allowing them to be manipulated, such as adding tags. 224 | 225 | ```el 226 | ;; Mark all YouTube entries 227 | (add-hook 'elfeed-new-entry-hook 228 | (elfeed-make-tagger :feed-url "youtube\\.com" 229 | :add '(video youtube))) 230 | ``` 231 | 232 | Avoiding tagging old entries as `unread`: 233 | 234 | ```el 235 | ;; Entries older than 2 weeks are marked as read 236 | (add-hook 'elfeed-new-entry-hook 237 | (elfeed-make-tagger :before "2 weeks ago" 238 | :remove 'unread)) 239 | ``` 240 | 241 | Or building your own subset feeds: 242 | 243 | ```el 244 | (add-hook 'elfeed-new-entry-hook 245 | (elfeed-make-tagger :feed-url "example\\.com" 246 | :entry-title '(not "something interesting") 247 | :add 'junk 248 | :remove 'unread)) 249 | ``` 250 | 251 | Use `M-x elfeed-apply-hooks-now` to apply `elfeed-new-entry-hook` to 252 | all existing entries. Otherwise hooks will only apply to new entries 253 | on discovery. 254 | 255 | ### Custom Tag Faces 256 | 257 | By default, entries marked `unread` will have bolded titles in the 258 | `*elfeed-search*` listing. You can customize how tags affect an 259 | entry's appearance by customizing `elfeed-search-face-alist`. For 260 | example, this configuration makes entries tagged `important` stand out 261 | in red. 262 | 263 | ~~~el 264 | (defface important-elfeed-entry 265 | '((t :foreground "#f77")) 266 | "Marks an important Elfeed entry.") 267 | 268 | (push '(important important-elfeed-entry) 269 | elfeed-search-face-alist) 270 | ~~~ 271 | 272 | All faces from all tags will be applied to the entry title. The faces 273 | will be ordered as they appear in `elfeed-search-face-alist`. 274 | 275 | ## Bookmarks 276 | 277 | Filters can be saved and restored using Emacs' built-in [bookmarks 278 | feature][bm]. While in the search buffer, use `M-x bookmark-set` to 279 | save the current filter, and `M-x bookmark-jump` to restore a saved 280 | filter. Emacs automatically persists bookmarks across sessions. 281 | 282 | [bm]: https://www.gnu.org/software/emacs/manual/html_node/emacs/Bookmarks.html 283 | 284 | ## Org-store-link and Org-capture 285 | 286 | When `org-store-link` is called from an Elfeed search or an Elfeed 287 | entry, a link to the serach or entry is stored in Org-mode format. 288 | 289 | This link can be inserted into an Org-mode document. If the link is 290 | openned, the search or entry will be shown in Elfeed. 291 | 292 | In addition to the link, `org-store-link` also store some additonnal 293 | properties. You can access them in an Org-capture template with the 294 | template expansion `%:keyword`. (`org-store-link` is automatically 295 | called when you do a capture.) 296 | 297 | List of available keywords, when link is stored from an Elfeed search: 298 | - `type` : Type of Org-mode link 299 | - `link` : Org-mode link to this search, also available 300 | with %a, %A, %l and %L 301 | - `description` : The search filter 302 | 303 | 304 | List of available keywords, when link is stored from an Elfeed entry: 305 | - `type` : Type of Org-mode link 306 | - `link` : Org-mode link to this entry, also available 307 | with %a, %A, %l and %L 308 | - `title` : Feed entry title 309 | - `description` : Feed entry description, same as title 310 | - `external-link` : Feed entry external link 311 | - `date` : Date time of the feed entry publication, in 312 | full ISO 8601 format 313 | - `date-timestamp` : Date time of the feed entry publication, in 314 | Org-mode active timestamp format 315 | - `date-inactive-timestamp` : Date time of the feed entry publication, in 316 | Org-mode inactive timestamp format 317 | - `authors` : List of feed entry authors names, joint by a 318 | comma 319 | - `tags` : List of feed entry tags, in Org-mode tags 320 | format 321 | - `content` : Content of the feed entry 322 | - `feed-title` : Title of the feed 323 | - `feed-external-link` : Feed external link 324 | - `feed-authors` : List of feed authors names, joint by a comma 325 | 326 | If `content` type is HTML, it is automatically embedded into an 327 | Org-mode HTML quote. 328 | 329 | 330 | ## Metadata Plist 331 | 332 | All feed and entry objects have plist where you can store your own 333 | arbitrary, [readable values][rd]. These values are automatically 334 | persisted in the database. This metadata is accessed using the 335 | polymorphic `elfeed-meta` function. It's setf-able. 336 | 337 | ~~~el 338 | (setf (elfeed-meta entry :rating) 4) 339 | (elfeed-meta entry :rating) 340 | ;; => 4 341 | 342 | (setf (elfeed-meta feed :title) "My Better Title") 343 | ~~~ 344 | 345 | Elfeed itself adds some entries to this plist, some for your use, some 346 | for its own use. Here are the properties that Elfeed uses: 347 | 348 | * `:authors` : A list of author plists (`:name`, `:uri`, `:email`). 349 | * `:canonical-url` : The final URL for the feed after all redirects. 350 | * `:categories` : The feed-supplied categories for this entry. 351 | * `:etag` : HTTP Etag header, for conditional GETs. 352 | * `:failures` : Number of times this feed has failed to update. 353 | * `:last-modified` : HTTP Last-Modified header, for conditional GETs. 354 | * `:title` : Overrides the feed-supplied title for display purposes, 355 | both for feeds and entries. See also `elfeed-search-set-feed-title` 356 | and `elfeed-search-set-entry-title`. 357 | 358 | This list will grow in time, so you might consider namespacing your 359 | own properties to avoid collisions (e.g. `:xyz/rating`), or simply not 360 | using keywords as keys. Elfeed will always use keywords without a 361 | slash. 362 | 363 | [rd]: http://nullprogram.com/blog/2013/12/30/ 364 | 365 | ## Hooks 366 | 367 | A number of hooks are available to customize the behavior of Elfeed at 368 | key points without resorting to advice. 369 | 370 | * `elfeed-new-entry-hook` : Called each time a new entry it added to 371 | the database, allowing for automating tagging and such. 372 | * `elfeed-new-entry-parse-hook` : Called with each new entry and the 373 | full XML structure from which it was parsed, allowing for additional 374 | information to be drawn from the original feed XML. 375 | * `elfeed-http-error-hooks` : Allows for special behavior when HTTP 376 | errors occur, beyond simply logging the error to `*elfeed-log*` . 377 | * `elfeed-parse-error-hooks` : Allows for special behavior when feed 378 | parsing fails, beyond logging. 379 | * `elfeed-db-update-hook` : Called any time the database has had a 380 | major modification. 381 | 382 | ## Viewing Entries 383 | 384 | Entries are viewed locally in Emacs by typing `RET` while over an 385 | entry in the search listing. The content will be displayed in a 386 | separate buffer using `elfeed-show-mode`, rendered using Emacs' 387 | built-in shr package. This requires an Emacs compiled with `libxml2` 388 | bindings, which provides the necessary HTML parser. 389 | 390 | Sometimes displaying images can slow down or even crash Emacs. Set 391 | `shr-inhibit-images` to disable images if this is a problem. 392 | 393 | ## Web Interface 394 | 395 | Elfeed includes a demonstration/toy web interface for remote network 396 | access. It's a single-page web application that follows the database 397 | live as new entries arrive. It's packaged separately as `elfeed-web`. 398 | To fire it up, run `M-x elfeed-web-start` and visit 399 | http://localhost:8080/elfeed/ (check your `httpd-port`) with a 400 | browser. See the `elfeed-web.el` header for endpoint documentation if 401 | you'd like to access the Elfeed database through the web API. 402 | 403 | It's rough and unfinished -- no keyboard shortcuts, read-only, no 404 | authentication, and a narrow entry viewer. This is basically Elfeed's 405 | "mobile" interface. Patches welcome. 406 | 407 | ## Platform Support 408 | 409 | Summary: Install cURL and most problems disappear for all platforms. 410 | 411 | I personally only use Elfeed on Linux, but it's occasionally tested on 412 | Windows. Unfortunately the Windows port of Emacs is a bit too unstable 413 | for parallel feed downloads with `url-retrieve`, not to mention the 414 | [tiny, hard-coded, 512 open descriptor limitation][files], so it 415 | limits itself to one feed at a time on this platform. 416 | 417 | [files]: http://msdn.microsoft.com/en-us/library/kdfaxaay%28vs.71%29.aspx 418 | 419 | If you fetch HTTPS feeds without cURL on *any* platform, it's 420 | essential that Emacs is built with the `--with-gnutls` option. 421 | Otherwise Emacs runs gnutls in an inferior process, which rarely works 422 | well. 423 | 424 | ## Database Management 425 | 426 | The database should keep itself under control without any manual 427 | intervention, but steps can be taken to minimize the database size if 428 | desired. The simplest option is to run the `elfeed-db-compact` 429 | command, which will pack the loose-file content database into a single 430 | compressed file. This function works well in `kill-emacs-hook`. 431 | 432 | Going further, a function could be added to `elfeed-new-entry-hook` to 433 | strip unwanted/unneeded content from select entries before being 434 | stored in the database. For example, for YouTube videos only the entry 435 | link is of interest and the regularly-changing entry content could be 436 | tossed to save time and storage. 437 | 438 | ## Status and Roadmap 439 | 440 | Elfeed is to the point where it can serve 100% of my own web feed 441 | needs. My personal selection of about 150 feeds has been acting as my 442 | test case as I optimize and add features. 443 | 444 | Some things I still might want to add: 445 | 446 | * Database synchronization between computers 447 | * Parallel feed fetching via separate Emacs subprocesses 448 | 449 | ## Motivation 450 | 451 | As far as I know, outside of Elfeed there does not exist an 452 | extensible, text-file configured, power-user web feed client that can 453 | handle a reasonable number of feeds. The existing clients I've tried 454 | are missing some important capability that limits its usefulness to 455 | me. 456 | -------------------------------------------------------------------------------- /UNLICENSE: -------------------------------------------------------------------------------- 1 | This is free and unencumbered software released into the public domain. 2 | 3 | Anyone is free to copy, modify, publish, use, compile, sell, or 4 | distribute this software, either in source code form or as a compiled 5 | binary, for any purpose, commercial or non-commercial, and by any 6 | means. 7 | 8 | In jurisdictions that recognize copyright laws, the author or authors 9 | of this software dedicate any and all copyright interest in the 10 | software to the public domain. We make this dedication for the benefit 11 | of the public at large and to the detriment of our heirs and 12 | successors. We intend this dedication to be an overt act of 13 | relinquishment in perpetuity of all present and future rights to this 14 | software under copyright law. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 19 | IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR 20 | OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, 21 | ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR 22 | OTHER DEALINGS IN THE SOFTWARE. 23 | 24 | For more information, please refer to 25 | -------------------------------------------------------------------------------- /elfeed-csv.el: -------------------------------------------------------------------------------- 1 | ;;; elfeed-csv.el --- export database to CSV files -*- lexical-binding: t; -*- 2 | 3 | ;;; Commentary: 4 | 5 | ;; The `elfeed-csv-export' docstring has a SQL schema recommendation. 6 | ;; Given these schemas, these CSV files are trivially imported into a 7 | ;; SQLite database using the sqlite3 command line program: 8 | 9 | ;; sqlite> .mode csv 10 | ;; sqlite> .import feeds.csv feeds 11 | ;; sqlite> .import entries.csv entries 12 | ;; sqlite> .import tags.csv tags 13 | 14 | ;; Note: nil values won't be imported as NULL, but as empty strings. 15 | 16 | ;; Here are a few interesting queries to make on your own data: 17 | 18 | ;; For each tag in your database, compute a histogram of posts with 19 | ;; 1-hour bins across the the day (0-23), in your local timezone. 20 | 21 | ;; SELECT tag, 22 | ;; cast(strftime('%H', date, 'unixepoch', 'localtime') AS INT) AS hour, 23 | ;; count(id) AS count 24 | ;; FROM entries 25 | ;; JOIN tags ON tags.entry = entries.id AND tags.feed = entries.feed 26 | ;; GROUP BY tag, hour; 27 | 28 | ;; Like above, but per week-day (0-6). 29 | 30 | ;; SELECT tag, 31 | ;; cast(strftime('%w', date, 'unixepoch', 'localtime') AS INT) AS day, 32 | ;; count(id) AS count 33 | ;; FROM entries 34 | ;; JOIN tags ON tags.entry = entries.id AND tags.feed = entries.feed 35 | ;; GROUP BY tag, day; 36 | 37 | ;; For each feed, compute the number of entries and last entry date. 38 | 39 | ;; SELECT feeds.title AS title, 40 | ;; count(url) AS entry_count, 41 | ;; datetime(max(date), 'unixepoch') AS last_entry_date 42 | ;; FROM feeds 43 | ;; JOIN entries ON feeds.url = entries.feed 44 | ;; GROUP BY url 45 | ;; ORDER BY max(date) DESC; 46 | 47 | ;; Compute a histogram of entry title lengths. 48 | 49 | ;; SELECT length(title) AS length, 50 | ;; count(*) AS count 51 | ;; FROM entries 52 | ;; GROUP BY length 53 | ;; ORDER BY length; 54 | 55 | ;; Again, but this time group by tag. 56 | 57 | ;; SELECT tag, 58 | ;; length(title) AS length, 59 | ;; count(*) AS count 60 | ;; FROM entries 61 | ;; JOIN tags ON tags.entry = entries.id AND tags.feed = entries.feed 62 | ;; GROUP BY tag, length 63 | ;; ORDER BY length; 64 | 65 | ;; What's the relationship between title length and time of day of an 66 | ;; entry? (Scatter plot this result.) 67 | 68 | ;; SELECT (date % (24*60*60)) / (24*60*60) AS day_time, 69 | ;; length(title) AS length 70 | ;; FROM entries 71 | ;; JOIN tags ON tags.entry = entries.id AND tags.feed = entries.feed; 72 | 73 | ;;; Code: 74 | 75 | (require 'cl-lib) 76 | (require 'elfeed-db) 77 | 78 | (defvar elfeed-csv-nil "" 79 | "The string representation to use for nil. 80 | Consider let-binding this around your `elfeed-csv-quote' call.") 81 | 82 | (defun elfeed-csv-quote (sexp) 83 | "Return CSV string representation of SEXP." 84 | (cond ((null sexp) 85 | elfeed-csv-nil) 86 | ((not (stringp sexp)) 87 | (elfeed-csv-quote (prin1-to-string sexp))) 88 | ((string-match-p "[\"\n,]" sexp) 89 | (concat "\"" (replace-regexp-in-string "\"" "\"\"" sexp) "\"")) 90 | (sexp))) 91 | 92 | (defun elfeed-csv-insert (seq) 93 | "Insert a row of CSV data to the current buffer." 94 | (cl-loop for value being the elements of seq 95 | for column upfrom 0 96 | when (> column 0) 97 | do (insert ",") 98 | do (insert (elfeed-csv-quote value)) 99 | finally (newline))) 100 | 101 | (cl-defun elfeed-csv-export (feeds-file entries-file tags-file &key headers-p) 102 | "Create separate CSV files for feeds, entries, and tags. 103 | 104 | These CSV files are intended for an analysis of an Elfeed 105 | database. They are suitable for importing as tables into a 106 | relational database such as SQLite. Here's the recommended SQL 107 | schema, reflecting the structure of the data. 108 | 109 | CREATE TABLE feeds ( 110 | url TEXT PRIMARY KEY, 111 | title TEXT, 112 | canonical_url TEXT, 113 | author TEXT 114 | ); 115 | 116 | CREATE TABLE entries ( 117 | id TEXT NOT NULL, 118 | feed TEXT NOT NULL REFERENCES feeds (url), 119 | title TEXT, 120 | link TEXT NOT NULL, 121 | date REAL NOT NULL, 122 | PRIMARY KEY (id, feed) 123 | ); 124 | 125 | CREATE TABLE tags ( 126 | entry TEXT NOT NULL, 127 | feed TEXT NOT NULL, 128 | tag TEXT NOT NULL, 129 | FOREIGN KEY (entry, feed) REFERENCES entries (id, feed) 130 | );" 131 | (let ((feeds-buffer (generate-new-buffer " *csv-feeds*")) 132 | (entries-buffer (generate-new-buffer " *csv-entries*")) 133 | (tags-buffer (generate-new-buffer " *csv-tags*")) 134 | (seen (make-hash-table :test 'eq))) 135 | ;; Write headers 136 | (when headers-p 137 | (with-current-buffer feeds-buffer 138 | (elfeed-csv-insert [url title canonical-url author])) 139 | (with-current-buffer entries-buffer 140 | (elfeed-csv-insert [id feed title link date])) 141 | (with-current-buffer tags-buffer 142 | (elfeed-csv-insert [entry feed tag]))) 143 | ;; Write data 144 | (with-elfeed-db-visit (entry feed) 145 | (unless (gethash feed seen) 146 | (setf (gethash feed seen) t) 147 | (let ((url (elfeed-feed-url feed)) 148 | (title (elfeed-feed-title feed)) 149 | (canonical-url (elfeed-meta feed :canonical-url)) 150 | (author (elfeed-feed-author feed))) 151 | (with-current-buffer feeds-buffer 152 | (elfeed-csv-insert (list url title canonical-url author))))) 153 | (let ((id (cdr (elfeed-entry-id entry))) 154 | (feed-id (elfeed-entry-feed-id entry)) 155 | (title (elfeed-entry-title entry)) 156 | (link (elfeed-entry-link entry)) 157 | (date (elfeed-entry-date entry))) 158 | (with-current-buffer entries-buffer 159 | (elfeed-csv-insert (list id feed-id title link date))) 160 | (with-current-buffer tags-buffer 161 | (dolist (tag (elfeed-entry-tags entry)) 162 | (elfeed-csv-insert (list id feed-id tag)))))) 163 | ;; Write files 164 | (with-current-buffer tags-buffer 165 | (write-region nil nil tags-file nil 0) 166 | (kill-buffer)) 167 | (with-current-buffer entries-buffer 168 | (write-region nil nil entries-file nil 0) 169 | (kill-buffer)) 170 | (with-current-buffer feeds-buffer 171 | (write-region nil nil feeds-file nil 0) 172 | (kill-buffer)))) 173 | 174 | (provide 'elfeed-csv) 175 | 176 | ;;; elfeed-csv.el ends here 177 | -------------------------------------------------------------------------------- /elfeed-curl.el: -------------------------------------------------------------------------------- 1 | ;;; elfeed-curl.el --- curl backend for Elfeed -*- lexical-binding: t; -*- 2 | 3 | ;;; Comments: 4 | 5 | ;; An alternative to `url-retrieve' and `url-queue' that fetches URLs 6 | ;; using the curl command line program. 7 | 8 | ;; The API is three functions: 9 | 10 | ;; * `elfeed-curl-retrieve' 11 | ;; * `elfeed-curl-retrieve-synchronously' 12 | ;; * `elfeed-curl-enqueue' 13 | 14 | ;; And has four buffer-local variables for use in callbacks: 15 | 16 | ;; * `elfeed-curl-headers' 17 | ;; * `elfeed-curl-status-code' 18 | ;; * `elfeed-curl-error-message' 19 | ;; * `elfeed-curl-location' 20 | 21 | ;; The buffer delivered to callbacks may contain multiple requests. It 22 | ;; will be narrowed to the specific content for the current request. 23 | ;; It's vitally important that callbacks do not kill the buffer 24 | ;; because it may be needed for other callbacks. It also means the 25 | ;; buffer won't necessarily be around when the callback returns. 26 | ;; Callbacks should also avoid editing the buffer, though this 27 | ;; generally shouldn't impact other requests. 28 | 29 | ;; Sometimes Elfeed asks curl to retrieve multiple requests and 30 | ;; deliver them concatenated. Due to the possibility of HTTP/1.0 being 31 | ;; involved — and other ambiguous-length protocols — there's no 32 | ;; perfectly unambiguous way to split the output. To work around this, 33 | ;; I use curl's --write-out to insert a randomly-generated token after 34 | ;; each request. It's highly unlikely (1 in ~1e38) that this token 35 | ;; will appear in content, so I can use it to identify the end of each 36 | ;; request. 37 | 38 | ;;; Code: 39 | 40 | (require 'url) 41 | (require 'cl-lib) 42 | (require 'elfeed-lib) 43 | (require 'elfeed-log) 44 | 45 | (defcustom elfeed-curl-program-name "curl" 46 | "Name/path by which to invoke the curl program." 47 | :group 'elfeed 48 | :type 'string) 49 | 50 | (defcustom elfeed-curl-max-connections 16 51 | "Maximum number of concurrent fetches." 52 | :group 'elfeed 53 | :type 'integer) 54 | 55 | (defcustom elfeed-curl-timeout 30 56 | "Maximum number of seconds a fetch is allowed to take once started." 57 | :group 'elfeed 58 | :type 'integer) 59 | 60 | (defcustom elfeed-curl-extra-arguments () 61 | "A list of additional arguments to pass to cURL. 62 | These extra arguments are appended after Elfeed's own arguments, 63 | and care must be taken to not interfere with Elfeed's needs. The 64 | guideline is to avoid arguments that change anything about cURL's 65 | output format." 66 | :group 'elfeed 67 | :type '(repeat string)) 68 | 69 | (defvar elfeed-curl-queue () 70 | "List of pending curl requests.") 71 | 72 | (defvar elfeed-curl-queue-active 0 73 | "Number of concurrent requests currently active.") 74 | 75 | (defvar-local elfeed-curl-headers nil 76 | "Alist of HTTP response headers.") 77 | 78 | (defvar-local elfeed-curl-status-code nil 79 | "Numeric HTTP response code, nil for non-HTTP protocols.") 80 | 81 | (defvar-local elfeed-curl-error-message nil 82 | "Human-friendly message describing the error.") 83 | 84 | (defvar-local elfeed-curl-location nil 85 | "Actual URL fetched (after any redirects).") 86 | 87 | (defvar-local elfeed-curl--regions () 88 | "List of markers bounding separate requests.") 89 | 90 | (defvar-local elfeed-curl--requests () 91 | "List of URL / callback pairs for the current buffer.") 92 | 93 | (defvar-local elfeed-curl--token nil 94 | "Unique token that splits requests.") 95 | 96 | (defvar-local elfeed-curl--refcount nil 97 | "Number of callbacks waiting on the current buffer.") 98 | 99 | (defvar elfeed-curl--error-codes 100 | '((1 . "Unsupported protocol.") 101 | (2 . "Failed to initialize.") 102 | (3 . "URL malformed. The syntax was not correct.") 103 | (4 . "A feature or option that was needed to perform the desired request was not enabled or was explicitly disabled at build-time.") 104 | (5 . "Couldn't resolve proxy. The given proxy host could not be resolved.") 105 | (6 . "Couldn't resolve host. The given remote host was not resolved.") 106 | (7 . "Failed to connect to host.") 107 | (8 . "FTP weird server reply. The server sent data curl couldn't parse.") 108 | (9 . "FTP access denied.") 109 | (11 . "FTP weird PASS reply.") 110 | (13 . "FTP weird PASV reply.") 111 | (14 . "FTP weird 227 format.") 112 | (15 . "FTP can't get host.") 113 | (16 . "A problem was detected in the HTTP2 framing layer.") 114 | (17 . "FTP couldn't set binary.") 115 | (18 . "Partial file. Only a part of the file was transferred.") 116 | (19 . "FTP couldn't download/access the given file, the RETR (or similar) command failed.") 117 | (21 . "FTP quote error. A quote command returned error from the server.") 118 | (22 . "HTTP page not retrieved.") 119 | (23 . "Write error.") 120 | (25 . "FTP couldn't STOR file.") 121 | (26 . "Read error. Various reading problems.") 122 | (27 . "Out of memory. A memory allocation request failed.") 123 | (28 . "Operation timeout.") 124 | (30 . "FTP PORT failed.") 125 | (31 . "FTP couldn't use REST.") 126 | (33 . "HTTP range error. The range \"command\" didn't work.") 127 | (34 . "HTTP post error. Internal post-request generation error.") 128 | (35 . "SSL connect error. The SSL handshaking failed.") 129 | (36 . "FTP bad download resume.") 130 | (37 . "FILE couldn't read file.") 131 | (38 . "LDAP bind operation failed.") 132 | (39 . "LDAP search failed.") 133 | (41 . "Function not found. A required LDAP function was not found.") 134 | (42 . "Aborted by callback.") 135 | (43 . "Internal error. A function was called with a bad parameter.") 136 | (45 . "Interface error. A specified outgoing interface could not be used.") 137 | (47 . "Too many redirects.") 138 | (48 . "Unknown option specified to libcurl.") 139 | (49 . "Malformed telnet option.") 140 | (51 . "The peer's SSL certificate or SSH MD5 fingerprint was not OK.") 141 | (52 . "The server didn't reply anything, which here is considered an error.") 142 | (53 . "SSL crypto engine not found.") 143 | (54 . "Cannot set SSL crypto engine as default.") 144 | (55 . "Failed sending network data.") 145 | (56 . "Failure in receiving network data.") 146 | (58 . "Problem with the local certificate.") 147 | (59 . "Couldn't use specified SSL cipher.") 148 | (60 . "Peer certificate cannot be authenticated with known CA certificates.") 149 | (61 . "Unrecognized transfer encoding.") 150 | (62 . "Invalid LDAP URL.") 151 | (63 . "Maximum file size exceeded.") 152 | (64 . "Requested FTP SSL level failed.") 153 | (65 . "Sending the data requires a rewind that failed.") 154 | (66 . "Failed to initialise SSL Engine.") 155 | (67 . "The user name, password, or similar was not accepted and curl failed to log in.") 156 | (68 . "File not found on TFTP server.") 157 | (69 . "Permission problem on TFTP server.") 158 | (70 . "Out of disk space on TFTP server.") 159 | (71 . "Illegal TFTP operation.") 160 | (72 . "Unknown TFTP transfer ID.") 161 | (73 . "File already exists (TFTP).") 162 | (74 . "No such user (TFTP).") 163 | (75 . "Character conversion failed.") 164 | (76 . "Character conversion functions required.") 165 | (77 . "Problem with reading the SSL CA cert (path? access rights?).") 166 | (78 . "The resource referenced in the URL does not exist.") 167 | (79 . "An unspecified error occurred during the SSH session.") 168 | (80 . "Failed to shut down the SSL connection.") 169 | (82 . "Could not load CRL file, missing or wrong format (added in 7.19.0).") 170 | (83 . "Issuer check failed (added in 7.19.0).") 171 | (84 . "The FTP PRET command failed") 172 | (85 . "RTSP: mismatch of CSeq numbers") 173 | (86 . "RTSP: mismatch of Session Identifiers") 174 | (87 . "unable to parse FTP file list") 175 | (88 . "FTP chunk callback reported error") 176 | (89 . "No connection available, the session will be queued") 177 | (90 . "SSL public key does not matched pinned public key"))) 178 | 179 | (defvar elfeed-curl--capabilities-cache 180 | (make-hash-table :test 'eq :weakness 'key) 181 | "Used to avoid invoking curl more than once for version info.") 182 | 183 | (defun elfeed-curl-get-capabilities () 184 | "Return capabilities plist for the curl at `elfeed-curl-program-name'. 185 | :version -- cURL's version string 186 | :compression -- non-nil if --compressed is supported 187 | :protocols -- symbol list of supported protocols 188 | :features -- string list of supported features" 189 | (let* ((cache elfeed-curl--capabilities-cache) 190 | (cache-value (gethash elfeed-curl-program-name cache))) 191 | (if cache-value 192 | cache-value 193 | (with-temp-buffer 194 | (call-process elfeed-curl-program-name nil t nil "--version") 195 | (let ((version 196 | (progn 197 | (goto-char (point-min)) 198 | (when (re-search-forward "[.0-9]+" nil t) 199 | (match-string 0)))) 200 | (protocols 201 | (progn 202 | (goto-char (point-min)) 203 | (when (re-search-forward "^Protocols: \\(.*\\)$" nil t) 204 | (mapcar #'intern (split-string (match-string 1)))))) 205 | (features 206 | (progn 207 | (goto-char (point-min)) 208 | (when (re-search-forward "^Features: \\(.*\\)$") 209 | (split-string (match-string 1)))))) 210 | (setf (gethash elfeed-curl-program-name cache) 211 | (list :version version 212 | :compression (not (null (member "libz" features))) 213 | :protocols protocols 214 | :features features))))))) 215 | 216 | (defun elfeed-curl-get-version () 217 | "Return the version of curl for `elfeed-curl-program-name'." 218 | (plist-get (elfeed-curl-get-capabilities) :version)) 219 | (make-obsolete 'elfeed-curl-get-version 'elfeed-curl-get-capabilities "3.0.1") 220 | 221 | (defun elfeed-curl--token () 222 | "Return a unique, random string that prints as a symbol without escapes. 223 | This token is used to split requests. The % is excluded since 224 | it's special to --write-out." 225 | (let* ((token (make-string 22 ?=)) 226 | (set "!$&*+-/0123456789:<>@ABCDEFGHIJKLMNOPQRSTUVWXYZ^_\ 227 | abcdefghijklmnopqrstuvwxyz|~")) 228 | (prog1 token ; workaround bug#16206 229 | (dotimes (i (- (length token) 2)) 230 | (setf (aref token (1+ i)) (aref set (cl-random (length set)))))))) 231 | 232 | (defun elfeed-curl--parse-write-out () 233 | "Parse curl's write-out (-w) messages into `elfeed-curl--regions'." 234 | (widen) 235 | (goto-char (point-max)) 236 | (setf elfeed-curl--regions ()) 237 | (while (> (point) (point-min)) 238 | (search-backward elfeed-curl--token) 239 | (goto-char (1- (point))) 240 | (let ((end (point))) 241 | (cl-destructuring-bind (_ . header) (read (current-buffer)) 242 | (goto-char end) 243 | ;; Find next sentinel token 244 | (if (search-backward elfeed-curl--token nil t) 245 | (search-forward ")" nil t) 246 | (goto-char (point-min))) 247 | (let* ((header-start (point)) 248 | (header-end (+ (point) header)) 249 | (content-start (+ (point) header)) 250 | (content-end end) 251 | (regions (list header-start header-end 252 | content-start content-end)) 253 | (markers (cl-loop for p in regions 254 | for marker = (make-marker) 255 | collect (set-marker marker p)))) 256 | (push markers elfeed-curl--regions)))))) 257 | 258 | (defun elfeed-curl--narrow (kind n) 259 | "Narrow to Nth region of KIND (:header, :content)." 260 | (let ((region (nth n elfeed-curl--regions))) 261 | (cl-destructuring-bind (h-start h-end c-start c-end) region 262 | (cl-ecase kind 263 | (:header (narrow-to-region h-start h-end)) 264 | (:content (narrow-to-region c-start c-end)))))) 265 | 266 | (defun elfeed-curl--parse-http-headers () 267 | "Parse the current HTTP response headers into buffer-locals. 268 | Sets `elfeed-curl-headers'and `elfeed-curl-status-code'. 269 | Use `elfeed-curl--narrow' to select a header." 270 | (when (> (- (point-max) (point-min)) 0) 271 | (goto-char (point-max)) 272 | (re-search-backward "HTTP/[.0-9]+ +\\([0-9]+\\)") 273 | (setf elfeed-curl-status-code (string-to-number (match-string 1))) 274 | (cl-loop initially (goto-char (point-max)) 275 | while (re-search-backward "^\\([^:]+\\): +\\([^\r\n]+\\)" nil t) 276 | for key = (downcase (match-string 1)) 277 | for value = (match-string 2) 278 | collect (cons key value) into headers 279 | finally (setf elfeed-curl-headers headers)))) 280 | 281 | (defun elfeed-curl--decode () 282 | "Try to decode the buffer based on the headers." 283 | (let ((content-type (cdr (assoc "Content-Type" elfeed-curl-headers)))) 284 | (if (and content-type (string-match "charset=\\(.+\\)" content-type)) 285 | (decode-coding-region (point-min) (point-max) 286 | (coding-system-from-name 287 | (match-string 1 content-type))) 288 | (decode-coding-region (point-min) (point-max) 'utf-8)))) 289 | 290 | (defun elfeed-curl--final-location (location headers) 291 | "Given start LOCATION and HEADERS, find the final location." 292 | (cl-loop for (key . value) in headers 293 | when (equal key "location") 294 | do (setf location (elfeed-update-location location value)) 295 | finally return location)) 296 | 297 | (defun elfeed-curl--args (url token &optional headers method data) 298 | "Build an argument list for curl for URL. 299 | URL can be a string or a list of URL strings." 300 | (let* ((args ()) 301 | (capabilities (elfeed-curl-get-capabilities))) 302 | (push "--disable" args) 303 | (when (plist-get capabilities :compression) 304 | (push "--compressed" args)) 305 | (push "--silent" args) 306 | (push "--location" args) 307 | (push (format "-w(%s . %%{size_header})" token) args) 308 | (push (format "-m%s" elfeed-curl-timeout) args) 309 | (push "-D-" args) 310 | (dolist (header headers) 311 | (cl-destructuring-bind (key . value) header 312 | (push (format "-H%s: %s" key value) args))) 313 | (when method (push (format "-X%s" method) args)) 314 | (when data (push (format "-d%s" data) args)) 315 | (setf args (nconc (reverse elfeed-curl-extra-arguments) args)) 316 | (if (listp url) 317 | (nconc (nreverse args) url) 318 | (nreverse (cons url args))))) 319 | 320 | (defun elfeed-curl--prepare-response (url n protocol) 321 | "Prepare response N for delivery to user." 322 | (elfeed-curl--narrow :header n) 323 | (when (eq protocol 'http) 324 | (elfeed-curl--parse-http-headers)) 325 | (setf elfeed-curl-location 326 | (elfeed-curl--final-location url elfeed-curl-headers)) 327 | (elfeed-curl--narrow :content n) 328 | (elfeed-curl--decode) 329 | (current-buffer)) 330 | 331 | (cl-defun elfeed-curl-retrieve-synchronously (url &key headers method data) 332 | "Retrieve the contents for URL and return a new buffer with them. 333 | 334 | HEADERS is an alist of additional headers to add to the HTTP request. 335 | METHOD is the HTTP method to use. 336 | DATA is the content to include in the request." 337 | (with-current-buffer (generate-new-buffer " *curl*") 338 | (setf elfeed-curl--token (elfeed-curl--token)) 339 | (let ((args (elfeed-curl--args url elfeed-curl--token headers method data)) 340 | (coding-system-for-read 'binary)) 341 | (apply #'call-process elfeed-curl-program-name nil t nil args)) 342 | (elfeed-curl--parse-write-out) 343 | (elfeed-curl--prepare-response url 0 (elfeed-curl--protocol-type url)))) 344 | 345 | (defun elfeed-curl--protocol-type (url) 346 | (let ((scheme (intern (or (url-type (url-generic-parse-url url)) "nil")))) 347 | (cl-case scheme 348 | ((https nil) 'http) 349 | (otherwise scheme)))) 350 | 351 | (defun elfeed-curl--call-callback (buffer n url cb) 352 | "Prepare the buffer for callback N and call it." 353 | (let ((result nil) 354 | (protocol (elfeed-curl--protocol-type url))) 355 | (with-current-buffer buffer 356 | (setf elfeed-curl-error-message "unable to parse curl response") 357 | (unwind-protect 358 | (progn 359 | (elfeed-curl--prepare-response url n protocol) 360 | (cond ((eq protocol 'file) 361 | ;; No status code is returned by curl for file:// urls 362 | (setf result t 363 | elfeed-curl-error-message nil)) 364 | ((eq protocol 'gopher) 365 | (setf result t 366 | elfeed-curl-error-message nil 367 | elfeed-curl-status-code nil)) 368 | ((and (>= elfeed-curl-status-code 400) 369 | (<= elfeed-curl-status-code 599)) 370 | (setf elfeed-curl-error-message 371 | (format "HTTP %d" elfeed-curl-status-code))) 372 | (t 373 | (setf result t 374 | elfeed-curl-error-message nil))) 375 | ;; Always call callback 376 | (unwind-protect 377 | (funcall cb result) 378 | ;; Always clean up 379 | (when (zerop (cl-decf elfeed-curl--refcount)) 380 | (kill-buffer)))))))) 381 | 382 | (defun elfeed-curl--fail-callback (buffer cb) 383 | "Inform the callback the request failed." 384 | (with-current-buffer buffer 385 | (unwind-protect 386 | (funcall cb nil) 387 | (when (zerop (cl-decf elfeed-curl--refcount)) 388 | (kill-buffer))))) 389 | 390 | (defun elfeed-curl--sentinel (process status) 391 | "Manage the end of a curl process' life." 392 | (let ((buffer (process-buffer process))) 393 | (with-current-buffer buffer 394 | ;; Fire off callbacks in separate interpreter turns so they can 395 | ;; each fail in isolation from each other. 396 | (if (equal status "finished\n") 397 | (cl-loop with handler = #'elfeed-curl--call-callback 398 | initially do (elfeed-curl--parse-write-out) 399 | for (url . cb) in elfeed-curl--requests 400 | for n upfrom 0 401 | do (run-at-time 0 nil handler buffer n url cb)) 402 | (if (string-match "exited abnormally with code \\([0-9]+\\)" status) 403 | (let* ((code (string-to-number (match-string 1 status))) 404 | (message (cdr (assoc code elfeed-curl--error-codes)))) 405 | (setf elfeed-curl-error-message 406 | (format "(%d) %s" code 407 | (or message "Unknown curl error!")))) 408 | (setf elfeed-curl-error-message status)) 409 | (cl-loop with handler = #'elfeed-curl--fail-callback 410 | for (_ . cb) in elfeed-curl--requests 411 | do (run-at-time 0 nil handler buffer cb)))))) 412 | 413 | (cl-defun elfeed-curl-retrieve (url cb &key headers method data) 414 | "Retrieve URL contents asynchronously, calling CB with one status argument. 415 | 416 | The callback must *not* kill the buffer! 417 | 418 | The destination buffer is set at the current buffer for the 419 | callback. 420 | 421 | HEADERS is an alist of additional headers to add to HTTP requests. 422 | METHOD is the HTTP method to use. 423 | DATA is the content to include in the request. 424 | 425 | URL can be a list of URLs, which will fetch them all in the same 426 | curl process. In this case, CB can also be either a list of the 427 | same length, or just a single function to be called once for each 428 | URL in the list. Headers will be common to all requests. A TCP or 429 | DNS failure in one will cause all to fail, but 4xx and 5xx 430 | results will not." 431 | (with-current-buffer (generate-new-buffer " *curl*") 432 | (setf elfeed-curl--token (elfeed-curl--token)) 433 | (let* ((coding-system-for-read 'binary) 434 | (process-connection-type nil) 435 | (args (elfeed-curl--args url elfeed-curl--token headers method data)) 436 | (process (apply #'start-process "elfeed-curl" (current-buffer) 437 | elfeed-curl-program-name args))) 438 | (prog1 process 439 | (if (listp url) 440 | (progn 441 | (when (functionp cb) 442 | (setf cb (make-list (length url) cb))) 443 | (setf elfeed-curl--requests (cl-mapcar #'cons url cb) 444 | elfeed-curl--refcount (length url))) 445 | (push (cons url cb) elfeed-curl--requests) 446 | (setf elfeed-curl--refcount 1)) 447 | (set-process-query-on-exit-flag process nil) 448 | (setf (process-sentinel process) #'elfeed-curl--sentinel))))) 449 | 450 | (defun elfeed-curl--request-key (url headers method data) 451 | "Try to fetch URLs with matching keys at the same time." 452 | (unless (listp url) 453 | (let* ((urlobj (url-generic-parse-url url))) 454 | (list (url-type urlobj) 455 | (url-host urlobj) 456 | (url-portspec urlobj) 457 | headers 458 | method 459 | data)))) 460 | 461 | (defun elfeed-curl--queue-consolidate (queue-in) 462 | "Group compatible requests together and return a new queue. 463 | Compatible means the requests have the same protocol, domain, 464 | port, headers, method, and body, allowing them to be used safely 465 | in the same curl invocation." 466 | (let ((table (make-hash-table :test 'equal)) 467 | (keys ()) 468 | (queue-out ())) 469 | (dolist (entry queue-in) 470 | (cl-destructuring-bind (url _ headers method data) entry 471 | (let* ((key (elfeed-curl--request-key url headers method data))) 472 | (push key keys) 473 | (push entry (gethash key table nil))))) 474 | (dolist (key (nreverse keys)) 475 | (let ((entry (gethash key table))) 476 | (when entry 477 | (let ((rotated (list (nreverse (cl-mapcar #'car entry)) 478 | (nreverse (cl-mapcar #'cadr entry)) 479 | (cl-caddar entry) 480 | (elt (car entry) 3) 481 | (elt (car entry) 4)))) 482 | (push rotated queue-out) 483 | (setf (gethash key table) nil))))) 484 | (nreverse queue-out))) 485 | 486 | (defun elfeed-curl--queue-wrap (cb) 487 | "Wrap the curl CB so that it operates the queue." 488 | (lambda (status) 489 | (cl-decf elfeed-curl-queue-active) 490 | (elfeed-curl--run-queue) 491 | (funcall cb status))) 492 | 493 | (defvar elfeed-curl--run-queue-queued nil 494 | "Non-nil if run-queue has already been queued for the next turn.") 495 | 496 | (defun elfeed-curl--run-queue () 497 | "Possibly fire off some new requests." 498 | (when elfeed-curl--run-queue-queued 499 | (setf elfeed-curl--run-queue-queued nil 500 | ;; Try to consolidate the new requests. 501 | elfeed-curl-queue 502 | (elfeed-curl--queue-consolidate elfeed-curl-queue))) 503 | (while (and (< elfeed-curl-queue-active elfeed-curl-max-connections) 504 | (> (length elfeed-curl-queue) 0)) 505 | (cl-destructuring-bind (url cb headers method data) (pop elfeed-curl-queue) 506 | (elfeed-log 'debug "retrieve %s" url) 507 | (cl-incf elfeed-curl-queue-active 1) 508 | (elfeed-curl-retrieve 509 | url 510 | (if (functionp cb) 511 | (elfeed-curl--queue-wrap cb) 512 | (cons (elfeed-curl--queue-wrap (car cb)) 513 | (cdr cb))) 514 | :headers headers 515 | :method method 516 | :data data)))) 517 | 518 | (cl-defun elfeed-curl-enqueue (url cb &key headers method data) 519 | "Just like `elfeed-curl-retrieve', but restricts concurrent fetches." 520 | (unless (or (stringp url) 521 | (and (listp url) (cl-every #'stringp url))) 522 | ;; Signal error synchronously instead of asynchronously in the timer 523 | (signal 'wrong-type-argument (list 'string-p-or-string-list-p url))) 524 | (let ((entry (list url cb headers method data))) 525 | (setf elfeed-curl-queue (nconc elfeed-curl-queue (list entry))) 526 | (unless elfeed-curl--run-queue-queued 527 | (run-at-time 0 nil #'elfeed-curl--run-queue) 528 | (setf elfeed-curl--run-queue-queued t)))) 529 | 530 | (provide 'elfeed-curl) 531 | 532 | ;;; elfeed-curl.el ends here 533 | -------------------------------------------------------------------------------- /elfeed-db.el: -------------------------------------------------------------------------------- 1 | ;;; elfeed-db.el --- database and model for elfeed -*- lexical-binding: t; -*- 2 | 3 | ;; This is free and unencumbered software released into the public domain. 4 | 5 | ;;; Commentary: 6 | 7 | ;; Elfeed is aware of two type of things: feeds and entries. All dates 8 | ;; are stored as floating point epoch seconds. 9 | 10 | ;; Feeds are keyed by their user-provided feed URL, which acts as the 11 | ;; feed identity regardless of any other stated identity. Feeds have a 12 | ;; list of entries. 13 | 14 | ;; Entries are keyed in order of preference by id (Atom), guid (RSS), 15 | ;; or link. To avoid circular references, entries refer to their 16 | ;; parent feeds by URL. 17 | 18 | ;; Feed content is stored in a content-addressable loose-file 19 | ;; database, very similar to an unpacked Git object database. Entries 20 | ;; have references to items in this database (elfeed-ref), keeping the 21 | ;; actual entry struct memory footprint small. Most importantly, this 22 | ;; keeps the core index small so that it can quickly be written as a 23 | ;; whole to the filesystem. The wire format is just the s-expression 24 | ;; print form of the top-level hash table. 25 | 26 | ;; The database can be compacted into a small number of compressed 27 | ;; files with the interactive function `elfeed-db-compact'. This could 28 | ;; be used as a kill-emacs hook. 29 | 30 | ;; An AVL tree containing all database entries ordered by date is 31 | ;; maintained as part of the database. We almost always want to look 32 | ;; at entries ordered by date and this step accomplished that very 33 | ;; efficiently with the AVL tree. This is the reasoning behind the 34 | ;; `with-elfeed-db-visit' interface. 35 | 36 | ;; Unfortunately there's a nasty bug (bug#15190) in the reader that 37 | ;; makes hash tables and `print-circle' incompatible. It's been fixed 38 | ;; in trunk, but many users will likely be stuck with this bug for the 39 | ;; next few years. This means the database format can't exploit 40 | ;; circular references. 41 | 42 | ;; Entry and feed objects can have arbitrary metadata attached, 43 | ;; automatically stored in the database. The setf-able `elfeed-meta' 44 | ;; function is used to access these. 45 | 46 | ;;; Code: 47 | 48 | (require 'cl-lib) 49 | (require 'avl-tree) 50 | (require 'elfeed-lib) 51 | 52 | (defcustom elfeed-db-directory "~/.elfeed" 53 | "Directory where elfeed will store its database." 54 | :group 'elfeed 55 | :type 'directory) 56 | 57 | (defvar elfeed-db nil 58 | "The core database for elfeed.") 59 | 60 | (defvar elfeed-db-feeds nil 61 | "Feeds hash table, part of `elfeed-db'.") 62 | 63 | (defvar elfeed-db-entries nil 64 | "Entries hash table, part of `elfeed-db'.") 65 | 66 | (defvar elfeed-db-index nil 67 | "Collection of all entries sorted by date, part of `elfeed-db'.") 68 | 69 | (defvar elfeed-db-version 70 | ;; If records are avaiable (Emacs 26), use the newer database format 71 | (if (functionp 'record) 72 | 4 73 | "0.0.3") 74 | "The database version this version of Elfeed expects to use.") 75 | 76 | (defvar elfeed-new-entry-hook () 77 | "Functions in this list are called with the new entry as its argument. 78 | This is a chance to add custom tags to new entries.") 79 | 80 | (defvar elfeed-db-update-hook () 81 | "Functions in this list are called with no arguments any time 82 | the :last-update time is updated.") 83 | 84 | (defvar elfeed-db-unload-hook () 85 | "Hook to run immediately after `elfeed-db-unload'.") 86 | 87 | ;; Data model: 88 | 89 | (cl-defstruct (elfeed-feed (:constructor elfeed-feed--create)) 90 | "A web feed, contains elfeed-entry structs." 91 | id url title author meta) 92 | 93 | (cl-defstruct (elfeed-entry (:constructor elfeed-entry--create)) 94 | "A single entry from a feed, normalized towards Atom." 95 | id title link date content content-type enclosures tags feed-id meta) 96 | 97 | (defun elfeed-entry-merge (a b) 98 | "Merge B into A, preserving A's tags. Return true if an actual 99 | update occurred, not counting content." 100 | (setf (elfeed-entry-tags b) (elfeed-entry-tags a) 101 | (elfeed-entry-content a) (elfeed-entry-content b)) 102 | (cl-loop for (key value) on (elfeed-entry-meta b) by #'cddr 103 | do (setf (elfeed-entry-meta a) 104 | (plist-put (elfeed-entry-meta a) key value))) 105 | (not 106 | (zerop 107 | (cl-loop for i from 1 below (1- (length a)) 108 | for part-a = (aref a i) 109 | for part-b = (aref b i) 110 | count (not (equal part-a part-b)) 111 | do (setf (aref a i) part-b))))) 112 | 113 | (defun elfeed-db-get-feed (id) 114 | "Get/create the feed for ID." 115 | (elfeed-db-ensure) 116 | (let ((feed (gethash id elfeed-db-feeds))) 117 | (or feed 118 | (setf (gethash id elfeed-db-feeds) 119 | (elfeed-feed--create :id id))))) 120 | 121 | (defun elfeed-db-get-entry (id) 122 | "Get the entry for ID." 123 | (elfeed-db-ensure) 124 | (gethash id elfeed-db-entries)) 125 | 126 | (defun elfeed-db-compare (a b) 127 | "Return true if entry A is newer than entry B." 128 | (let* ((entry-a (elfeed-db-get-entry a)) 129 | (entry-b (elfeed-db-get-entry b)) 130 | (date-a (elfeed-entry-date entry-a)) 131 | (date-b (elfeed-entry-date entry-b))) 132 | (if (= date-a date-b) 133 | (string< (prin1-to-string b) (prin1-to-string a)) 134 | (> date-a date-b)))) 135 | 136 | (defun elfeed-db-set-update-time () 137 | "Update the database last-update time." 138 | (setf elfeed-db (plist-put elfeed-db :last-update (float-time))) 139 | (run-hooks 'elfeed-db-update-hook)) 140 | 141 | (defun elfeed-db-add (entries) 142 | "Add ENTRIES to the database." 143 | (elfeed-db-ensure) 144 | (cl-loop for entry in entries 145 | for id = (elfeed-entry-id entry) 146 | for original = (gethash id elfeed-db-entries) 147 | for new-date = (elfeed-entry-date entry) 148 | for original-date = (and original (elfeed-entry-date original)) 149 | do (elfeed-deref-entry entry) 150 | when original count 151 | (if (= new-date original-date) 152 | (elfeed-entry-merge original entry) 153 | (avl-tree-delete elfeed-db-index id) 154 | (prog1 (elfeed-entry-merge original entry) 155 | (avl-tree-enter elfeed-db-index id))) 156 | into change-count 157 | else count 158 | (setf (gethash id elfeed-db-entries) entry) 159 | into change-count 160 | and do 161 | (progn 162 | (avl-tree-enter elfeed-db-index id) 163 | (cl-loop for hook in elfeed-new-entry-hook 164 | do (funcall hook entry))) 165 | finally 166 | (unless (zerop change-count) 167 | (elfeed-db-set-update-time))) 168 | :success) 169 | 170 | (defun elfeed-entry-feed (entry) 171 | "Get the feed struct for ENTRY." 172 | (elfeed-db-get-feed (elfeed-entry-feed-id entry))) 173 | 174 | (defun elfeed-normalize-tags (tags &rest more-tags) 175 | "Return the normalized tag list for TAGS." 176 | (let ((all (apply #'append tags (nconc more-tags (list ()))))) 177 | (cl-delete-duplicates (cl-sort all #'string< :key #'symbol-name)))) 178 | 179 | (defun elfeed-tag-1 (entry &rest tags) 180 | "Add TAGS to ENTRY." 181 | (let ((current (elfeed-entry-tags entry))) 182 | (setf (elfeed-entry-tags entry) 183 | (elfeed-normalize-tags (append tags current))))) 184 | 185 | (defun elfeed-untag-1 (entry &rest tags) 186 | "Remove TAGS from ENTRY." 187 | (setf (elfeed-entry-tags entry) 188 | (cl-loop for tag in (elfeed-entry-tags entry) 189 | unless (memq tag tags) collect tag))) 190 | 191 | (defun elfeed-tag (entry-or-entry-list &rest tags) 192 | "Add TAGS to ENTRY-OR-ENTRY-LIST and run `elfeed-tag-hooks'." 193 | (let* ((entries (if (elfeed-entry-p entry-or-entry-list) 194 | (list entry-or-entry-list) 195 | entry-or-entry-list))) 196 | (run-hook-with-args 'elfeed-tag-hooks entries tags) 197 | (cl-loop for entry in entries do (apply #'elfeed-tag-1 entry tags)))) 198 | 199 | (defun elfeed-untag (entry-or-entry-list &rest tags) 200 | "Remove TAGS from ENTRY-OR-ENTRY-LIST and run `elfeed-untag-hooks'." 201 | (let* ((entries (if (elfeed-entry-p entry-or-entry-list) 202 | (list entry-or-entry-list) 203 | entry-or-entry-list))) 204 | (run-hook-with-args 'elfeed-untag-hooks entries tags) 205 | (cl-loop for entry in entries do (apply #'elfeed-untag-1 entry tags)))) 206 | 207 | (defun elfeed-tagged-p (tag entry) 208 | "Return true if ENTRY is tagged by TAG." 209 | (memq tag (elfeed-entry-tags entry))) 210 | 211 | (defun elfeed-db-last-update () 212 | "Return the last database update time in (`float-time') seconds." 213 | (elfeed-db-ensure) 214 | (or (plist-get elfeed-db :last-update) 0)) 215 | 216 | (defmacro with-elfeed-db-visit (entry-and-feed &rest body) 217 | "Visit each entry in the database from newest to oldest. 218 | Use `elfeed-db-return' to exit early and optionally return data. 219 | 220 | (with-elfeed-db-visit (entry feed) 221 | (do-something entry) 222 | (when (some-date-criteria-p entry) 223 | (elfeed-db-return)))" 224 | (declare (indent defun)) 225 | `(catch 'elfeed-db-done 226 | (prog1 nil 227 | (elfeed-db-ensure) 228 | (avl-tree-mapc 229 | (lambda (id) 230 | (let* ((,(cl-first entry-and-feed) (elfeed-db-get-entry id)) 231 | (,(cl-second entry-and-feed) 232 | (elfeed-entry-feed ,(cl-first entry-and-feed)))) 233 | ,@body)) 234 | elfeed-db-index)))) 235 | 236 | (defun elfeed-feed-entries (feed-or-id) 237 | "Return a list of all entries for a particular feed. 238 | The FEED-OR-ID may be a feed struct or a feed ID (url)." 239 | (let ((feed-id (if (elfeed-feed-p feed-or-id) 240 | (elfeed-feed-id feed-or-id) 241 | feed-or-id))) 242 | (let ((entries)) 243 | (with-elfeed-db-visit (entry feed) 244 | (when (equal (elfeed-feed-id feed) feed-id) 245 | (push entry entries))) 246 | (nreverse entries)))) 247 | 248 | (defun elfeed-apply-hooks-now () 249 | "Apply `elfeed-new-entry-hook' to all entries in the database." 250 | (interactive) 251 | (with-elfeed-db-visit (entry _) 252 | (cl-loop for hook in elfeed-new-entry-hook 253 | do (funcall hook entry)))) 254 | 255 | (defmacro elfeed-db-return (&optional value) 256 | "Use this to exit early and return VALUE from `with-elfeed-db-visit'." 257 | `(throw 'elfeed-db-done ,value)) 258 | 259 | (defun elfeed-db-get-all-tags () 260 | "Return a list of all tags currently in the database." 261 | (let ((table (make-hash-table :test 'eq))) 262 | (with-elfeed-db-visit (e _) 263 | (dolist (tag (elfeed-entry-tags e)) 264 | (setf (gethash tag table) tag))) 265 | (let ((tags ())) 266 | (maphash (lambda (k _) (push k tags)) table) 267 | (cl-sort tags #'string< :key #'symbol-name)))) 268 | 269 | ;; Saving and Loading: 270 | 271 | (defun elfeed-db-save () 272 | "Write the database index to the filesystem." 273 | (elfeed-db-ensure) 274 | (setf elfeed-db (plist-put elfeed-db :version elfeed-db-version)) 275 | (mkdir elfeed-db-directory t) 276 | (let ((coding-system-for-write 'utf-8)) 277 | (with-temp-file (expand-file-name "index" elfeed-db-directory) 278 | (let ((standard-output (current-buffer)) 279 | (print-level nil) 280 | (print-length nil) 281 | (print-circle nil)) 282 | (princ (format ";;; Elfeed Database Index (version %s)\n\n" 283 | elfeed-db-version)) 284 | (when (eql elfeed-db-version 4) 285 | ;; Put empty dummy index in front 286 | (princ ";; Dummy index for backwards compatablity:\n") 287 | (prin1 (elfeed-db--dummy)) 288 | (princ "\n\n;; Real index:\n")) 289 | (prin1 elfeed-db) 290 | :success)))) 291 | 292 | (defun elfeed-db-save-safe () 293 | "Run `elfeed-db-save' without triggering any errors, for use as a safe hook." 294 | (ignore-errors (elfeed-db-save))) 295 | 296 | (defun elfeed-db-upgrade (db) 297 | "Upgrade the database from a previous format." 298 | (if (not (vectorp (plist-get db :index))) 299 | db ; Database is already in record format 300 | (let* ((new-db (elfeed-db--empty)) 301 | ;; Dynamically bind for other functions 302 | (elfeed-db-feeds (plist-get new-db :feeds)) 303 | (elfeed-db-entries (plist-get new-db :entries)) 304 | (elfeed-db-index (plist-get new-db :index))) 305 | ;; Fix up feeds 306 | (cl-loop with table = (plist-get new-db :feeds) 307 | for feed hash-values of (plist-get db :feeds) 308 | for id = (aref feed 1) 309 | for fixed = (elfeed-feed--create 310 | :id id 311 | :url (aref feed 2) 312 | :title (aref feed 3) 313 | :author (aref feed 4) 314 | :meta (aref feed 5)) 315 | do (setf (gethash id table) fixed)) 316 | ;; Fix up entries 317 | (cl-loop with table = (plist-get new-db :entries) 318 | with index = (plist-get new-db :index) 319 | for entry hash-values of (plist-get db :entries) 320 | for id = (aref entry 1) 321 | for content = (aref entry 5) 322 | for fixed = (elfeed-entry--create 323 | :id id 324 | :title (aref entry 2) 325 | :link (aref entry 3) 326 | :date (aref entry 4) 327 | :content (if (vectorp content) 328 | (elfeed-ref--create 329 | :id (aref content 1)) 330 | content) 331 | :content-type (aref entry 6) 332 | :enclosures (aref entry 7) 333 | :tags (aref entry 8) 334 | :feed-id (aref entry 9) 335 | :meta (aref entry 10)) 336 | do (setf (gethash id table) fixed) 337 | do (avl-tree-enter index id)) 338 | (plist-put new-db :last-update (plist-get db :last-update))))) 339 | 340 | (defun elfeed-db--empty () 341 | "Create an empty database object." 342 | `(:version ,elfeed-db-version 343 | :feeds ,(make-hash-table :test 'equal) 344 | :entries ,(make-hash-table :test 'equal) 345 | ;; Compiler may warn about this (bug#15327): 346 | :index ,(avl-tree-create #'elfeed-db-compare))) 347 | 348 | (defun elfeed-db--dummy () 349 | "Create an empty dummy database for Emacs 25 and earlier." 350 | (list :version "0.0.3" 351 | :feeds #s(hash-table size 65 352 | test equal 353 | rehash-size 1.5 354 | rehash-threshold 0.8 355 | data ()) 356 | :entries #s(hash-table size 65 357 | test equal 358 | rehash-size 1.5 359 | rehash-threshold 0.8 360 | data ()) 361 | :index [cl-struct-avl-tree- [nil nil nil 0] elfeed-db-compare])) 362 | 363 | ;; To cope with the incompatible struct changes in Emacs 26, Elfeed 364 | ;; uses version 4 of the database format when run under Emacs 26. This 365 | ;; version saves a dummy, empty index in front of the real database. A 366 | ;; user going from Emacs 26 to Emacs 25 will quietly load an empty 367 | ;; index since it's unreasonable to downgrade (would require rewriting 368 | ;; the Emacs reader from scratch). 369 | 370 | (defun elfeed-db-load () 371 | "Load the database index from the filesystem." 372 | (let ((index (expand-file-name "index" elfeed-db-directory)) 373 | (enable-local-variables nil)) ; don't set local variables from index! 374 | (if (not (file-exists-p index)) 375 | (setf elfeed-db (elfeed-db--empty)) 376 | ;; Override the default value for major-mode. There is no 377 | ;; preventing find-file-noselect from starting the default major 378 | ;; mode while also having it handle buffer conversion. Some 379 | ;; major modes crash Emacs when enabled in large buffers (e.g. 380 | ;; org-mode). This includes the Elfeed index, so we must not let 381 | ;; this happen. 382 | (cl-letf (((default-value 'major-mode) 'fundamental-mode)) 383 | (with-current-buffer (find-file-noselect index :nowarn) 384 | (goto-char (point-min)) 385 | (if (eql elfeed-db-version 4) 386 | ;; May need to skip over dummy database 387 | (let ((db-1 (read (current-buffer))) 388 | (db-2 (ignore-errors (read (current-buffer))))) 389 | (setf elfeed-db (or db-2 db-1))) 390 | ;; Just load first database 391 | (setf elfeed-db (read (current-buffer)))) 392 | (kill-buffer)))) 393 | ;; Perform an upgrade if necessary and possible 394 | (unless (equal (plist-get elfeed-db :version) elfeed-db-version) 395 | (ignore-errors 396 | (copy-file index (concat index ".backup"))) 397 | (message "Upgrading Elfeed index for Emacs 26 ...") 398 | (setf elfeed-db (elfeed-db-upgrade elfeed-db)) 399 | (message "Elfeed index upgrade complete.")) 400 | (setf elfeed-db-feeds (plist-get elfeed-db :feeds) 401 | elfeed-db-entries (plist-get elfeed-db :entries) 402 | elfeed-db-index (plist-get elfeed-db :index) 403 | ;; Internal function use required for security! 404 | (avl-tree--cmpfun elfeed-db-index) #'elfeed-db-compare))) 405 | 406 | (defun elfeed-db-unload () 407 | "Unload the database so that it can be operated on externally. 408 | 409 | Runs `elfeed-db-unload-hook' after unloading the database." 410 | (interactive) 411 | (elfeed-db-save) 412 | (setf elfeed-db nil 413 | elfeed-db-feeds nil 414 | elfeed-db-entries nil 415 | elfeed-db-index nil) 416 | (run-hooks 'elfeed-db-unload-hook)) 417 | 418 | (defun elfeed-db-ensure () 419 | "Ensure that the database has been loaded." 420 | (when (null elfeed-db) (elfeed-db-load))) 421 | 422 | (defun elfeed-db-size () 423 | "Return a count of the number of entries in the database." 424 | (let ((count-table (hash-table-count elfeed-db-entries)) 425 | (count-tree (avl-tree-size elfeed-db-index))) 426 | (if (= count-table count-tree) 427 | count-table 428 | (error "Elfeed database error: entry count mismatch.")))) 429 | 430 | ;; Metadata: 431 | 432 | (defun elfeed-meta--plist (thing) 433 | "Get the metadata plist for THING." 434 | (cl-typecase thing 435 | (elfeed-feed (elfeed-feed-meta thing)) 436 | (elfeed-entry (elfeed-entry-meta thing)) 437 | (otherwise (error "Don't know how to access metadata on %S" thing)))) 438 | 439 | (defun elfeed-meta--set-plist (thing plist) 440 | "Set the metadata plist on THING to PLIST." 441 | (cl-typecase thing 442 | (elfeed-feed (setf (elfeed-feed-meta thing) plist)) 443 | (elfeed-entry (setf (elfeed-entry-meta thing) plist)) 444 | (otherwise (error "Don't know how to access metadata on %S" thing)))) 445 | 446 | (defun elfeed-db--plist-fixup (plist) 447 | "Remove nil values from PLIST." 448 | (cl-loop for (k v) on plist by #'cddr 449 | when (not (null v)) 450 | collect k and collect v)) 451 | 452 | (defun elfeed-meta (thing key &optional default) 453 | "Access metadata for THING (entry, feed) under KEY." 454 | (or (plist-get (elfeed-meta--plist thing) key) 455 | default)) 456 | 457 | (defun elfeed-meta--put (thing key value) 458 | "Set metadata to VALUE on THING under KEY." 459 | (when (not (elfeed-readable-p value)) (error "New value must be readable.")) 460 | (let ((new-plist (plist-put (elfeed-meta--plist thing) key value))) 461 | (prog1 value 462 | (elfeed-meta--set-plist thing (elfeed-db--plist-fixup new-plist))))) 463 | 464 | (gv-define-setter elfeed-meta (value thing key &optional _default) 465 | `(elfeed-meta--put ,thing ,key ,value)) 466 | 467 | ;; Filesystem storage: 468 | 469 | (defvar elfeed-ref-archive nil 470 | "Index of archived/packed content.") 471 | 472 | (defvar elfeed-ref-cache nil 473 | "Temporary storage of the full archive content.") 474 | 475 | (cl-defstruct (elfeed-ref (:constructor elfeed-ref--create)) 476 | id) 477 | 478 | (defun elfeed-ref--file (ref) 479 | "Determine the storage filename for REF." 480 | (let* ((id (elfeed-ref-id ref)) 481 | (root (expand-file-name "data" elfeed-db-directory)) 482 | (subdir (expand-file-name (substring id 0 2) root))) 483 | (expand-file-name id subdir))) 484 | 485 | (cl-defun elfeed-ref-archive-filename (&optional (suffix "")) 486 | "Return the base filename of the archive files." 487 | (concat (expand-file-name "data/archive" elfeed-db-directory) suffix)) 488 | 489 | (defun elfeed-ref-archive-load () 490 | "Load the archived ref index." 491 | (let ((archive-index (elfeed-ref-archive-filename ".index"))) 492 | (if (file-exists-p archive-index) 493 | (with-temp-buffer 494 | (insert-file-contents archive-index) 495 | (setf elfeed-ref-archive (read (current-buffer)))) 496 | (setf elfeed-ref-archive :empty)))) 497 | 498 | (defun elfeed-ref-archive-ensure () 499 | "Ensure that the archive index is loaded." 500 | (when (null elfeed-ref-archive) (elfeed-ref-archive-load))) 501 | 502 | (defun elfeed-ref-exists-p (ref) 503 | "Return true if REF can be dereferenced." 504 | (elfeed-ref-archive-ensure) 505 | (or (and (hash-table-p elfeed-ref-archive) 506 | (not (null (gethash (elfeed-ref-id ref) elfeed-ref-archive)))) 507 | (file-exists-p (elfeed-ref--file ref)))) 508 | 509 | (defun elfeed-deref (ref) 510 | "Fetch the content behind the reference, or nil if non-existent." 511 | (elfeed-ref-archive-ensure) 512 | (if (not (elfeed-ref-p ref)) 513 | ref 514 | (let ((index (and (hash-table-p elfeed-ref-archive) 515 | (gethash (elfeed-ref-id ref) elfeed-ref-archive))) 516 | (archive-file (elfeed-ref-archive-filename ".gz")) 517 | (coding-system-for-read 'utf-8)) 518 | (if (and index (file-exists-p archive-file)) 519 | (progn 520 | (when (null elfeed-ref-cache) 521 | (with-temp-buffer 522 | (insert-file-contents archive-file) 523 | (setf elfeed-ref-cache (buffer-string))) 524 | ;; Clear cache on next turn. 525 | (run-at-time 0 nil (lambda () (setf elfeed-ref-cache nil)))) 526 | (substring elfeed-ref-cache (car index) (cdr index))) 527 | (let ((file (elfeed-ref--file ref))) 528 | (when (file-exists-p file) 529 | (with-temp-buffer 530 | (insert-file-contents file) 531 | (buffer-string)))))))) 532 | 533 | (defun elfeed-ref (content) 534 | "Create a reference to CONTENT, to be persistently stored." 535 | (if (elfeed-ref-p content) 536 | content 537 | (let* ((id (secure-hash 'sha1 (encode-coding-string content 'utf-8 t))) 538 | (ref (elfeed-ref--create :id id)) 539 | (file (elfeed-ref--file ref))) 540 | (prog1 ref 541 | (unless (elfeed-ref-exists-p ref) 542 | (mkdir (file-name-directory file) t) 543 | (let ((coding-system-for-write 'utf-8) 544 | ;; Content data loss is a tolerable risk. 545 | ;; Fsync will occur soon on index write anyway. 546 | (write-region-inhibit-fsync t)) 547 | (with-temp-file file 548 | (insert content)))))))) 549 | 550 | (defun elfeed-deref-entry (entry) 551 | "Move ENTRY's content to filesystem storage. Return the entry." 552 | (let ((content (elfeed-entry-content entry))) 553 | (prog1 entry 554 | (when (stringp content) 555 | (setf (elfeed-entry-content entry) (elfeed-ref content)))))) 556 | 557 | (defun elfeed-ref-delete (ref) 558 | "Remove the content behind REF from the database." 559 | (ignore-errors 560 | (delete-file (elfeed-ref--file ref)))) 561 | 562 | (defun elfeed-db-gc-empty-feeds () 563 | "Remove feeds with no entries from the database." 564 | (let ((seen (make-hash-table :test 'equal))) 565 | (with-elfeed-db-visit (entry feed) 566 | (setf (gethash (elfeed-feed-id feed) seen) feed)) 567 | (maphash (lambda (id _) 568 | (unless (gethash id seen) 569 | (remhash id elfeed-db-feeds))) 570 | elfeed-db-feeds))) 571 | 572 | (defun elfeed-db-gc (&optional stats-p) 573 | "Clean up unused content from the content database. 574 | If STATS is true, return the space cleared in bytes." 575 | (elfeed-db-gc-empty-feeds) 576 | (let* ((data (expand-file-name "data" elfeed-db-directory)) 577 | (dirs (directory-files data t "^[0-9a-z]\\{2\\}$")) 578 | (ids (cl-mapcan (lambda (d) (directory-files d nil nil t)) dirs)) 579 | (table (make-hash-table :test 'equal))) 580 | (dolist (id ids) 581 | (setf (gethash id table) nil)) 582 | (with-elfeed-db-visit (entry _) 583 | (let ((content (elfeed-entry-content entry))) 584 | (when (elfeed-ref-p content) 585 | (setf (gethash (elfeed-ref-id content) table) t)))) 586 | (cl-loop for id hash-keys of table using (hash-value used) 587 | for used-p = (or used (member id '("." ".."))) 588 | when (and (not used-p) stats-p) 589 | sum (let* ((ref (elfeed-ref--create :id id)) 590 | (file (elfeed-ref--file ref))) 591 | (* 1.0 (nth 7 (file-attributes file)))) 592 | unless used-p 593 | do (elfeed-ref-delete (elfeed-ref--create :id id)) 594 | finally (cl-loop for dir in dirs 595 | when (elfeed-directory-empty-p dir) 596 | do (delete-directory dir))))) 597 | 598 | (defun elfeed-db-pack () 599 | "Pack all content into a single archive for efficient storage." 600 | (let ((coding-system-for-write 'utf-8) 601 | (next-archive (make-hash-table :test 'equal)) 602 | (packed ())) 603 | (make-directory (expand-file-name "data" elfeed-db-directory) t) 604 | (with-temp-file (elfeed-ref-archive-filename ".gz") 605 | (with-elfeed-db-visit (entry _) 606 | (let ((ref (elfeed-entry-content entry)) 607 | (start (1- (point)))) 608 | (when (elfeed-ref-p ref) 609 | (let ((content (elfeed-deref ref))) 610 | (when content 611 | (push ref packed) 612 | (insert content) 613 | (setf (gethash (elfeed-ref-id ref) next-archive) 614 | (cons start (1- (point)))))))))) 615 | (with-temp-file (elfeed-ref-archive-filename ".index") 616 | (let ((standard-output (current-buffer)) 617 | (print-level nil) 618 | (print-length nil) 619 | (print-circle nil)) 620 | (prin1 next-archive))) 621 | (setf elfeed-ref-cache nil) 622 | (setf elfeed-ref-archive next-archive) 623 | (mapc #'elfeed-ref-delete packed) 624 | :success)) 625 | 626 | (defun elfeed-db-compact () 627 | "Minimize the Elfeed database storage size on the filesystem. 628 | This requires that auto-compression-mode can handle 629 | gzip-compressed files, so the gzip program must be in your PATH." 630 | (interactive) 631 | (unless (elfeed-gzip-supported-p) 632 | (error "aborting compaction: gzip auto-compression-mode unsupported")) 633 | (elfeed-db-pack) 634 | (elfeed-db-gc)) 635 | 636 | (defun elfeed-db-gc-safe () 637 | "Run `elfeed-db-gc' without triggering any errors, for use as a safe hook." 638 | (ignore-errors (elfeed-db-gc))) 639 | 640 | (unless noninteractive 641 | (add-hook 'kill-emacs-hook #'elfeed-db-gc-safe :append) 642 | (add-hook 'kill-emacs-hook #'elfeed-db-save-safe)) 643 | 644 | (provide 'elfeed-db) 645 | 646 | ;;; elfeed-db.el ends here 647 | -------------------------------------------------------------------------------- /elfeed-lib.el: -------------------------------------------------------------------------------- 1 | ;;; elfeed-lib.el --- misc functions for elfeed -*- lexical-binding: t; -*- 2 | 3 | ;; This is free and unencumbered software released into the public domain. 4 | 5 | ;;; Commentary: 6 | 7 | ;; These are general functions that aren't specific to web feeds. It's 8 | ;; a library of useful functions to Elfeed. 9 | 10 | ;;; Code: 11 | 12 | (require 'cl-lib) 13 | (require 'thingatpt) 14 | (require 'time-date) 15 | (require 'url-parse) 16 | (require 'url-util) 17 | (require 'xml) 18 | 19 | (defun elfeed-expose (function &rest args) 20 | "Return an interactive version of FUNCTION, \"exposing\" it to the user." 21 | (lambda () (interactive) (apply function args))) 22 | 23 | (defun elfeed-goto-line (n) 24 | "Like `goto-line' but for non-interactive use." 25 | (goto-char (point-min)) 26 | (forward-line (1- n))) 27 | 28 | (defun elfeed-kill-buffer () 29 | "Kill the current buffer." 30 | (interactive) 31 | (kill-buffer (current-buffer))) 32 | 33 | (defun elfeed-kill-line () 34 | "Clear out the current line without touching anything else." 35 | (beginning-of-line) 36 | (let ((start (point))) 37 | (end-of-line) 38 | (delete-region start (point)))) 39 | 40 | (defun elfeed-time-duration (time &optional now) 41 | "Turn a time expression into a number of seconds. Uses 42 | `timer-duration' but allows a bit more flair. 43 | 44 | If `now' is non-nil, use it as the current time (`float-time'). This 45 | is mostly useful for testing." 46 | (cond 47 | ((numberp time) time) 48 | ((let ((iso-time (elfeed-parse-simple-iso-8601 time))) 49 | (when iso-time (- (or now (float-time)) iso-time)))) 50 | ((string-match-p "[[:alpha:]]" time) 51 | (let* ((clean (replace-regexp-in-string "\\(ago\\|old\\|-\\)" " " time)) 52 | (duration (timer-duration clean))) 53 | ;; convert to float since float-time is used elsewhere 54 | (when duration (float duration)))))) 55 | 56 | (defun elfeed-looks-like-url-p (string) 57 | "Return true if STRING looks like it could be a URL." 58 | (and (stringp string) 59 | (not (string-match-p "[ \n\t\r]" string)) 60 | (not (null (url-type (url-generic-parse-url string)))))) 61 | 62 | (defun elfeed-format-column (string width &optional align) 63 | "Return STRING truncated or padded to WIDTH following ALIGNment. 64 | Align should be a keyword :left or :right." 65 | (if (<= width 0) 66 | "" 67 | (format (format "%%%s%d.%ds" (if (eq align :left) "-" "") width width) 68 | string))) 69 | 70 | (defun elfeed-clamp (min value max) 71 | "Clamp a value between two values." 72 | (min max (max min value))) 73 | 74 | (defun elfeed-valid-regexp-p (regexp) 75 | "Return t if REGEXP is a valid REGEXP." 76 | (ignore-errors 77 | (prog1 t 78 | (string-match-p regexp "")))) 79 | 80 | (defun elfeed-cleanup (name) 81 | "Trim trailing and leading spaces and collapse multiple spaces." 82 | (let ((trim (replace-regexp-in-string "[\f\n\r\t\v ]+" " " (or name "")))) 83 | (replace-regexp-in-string "^ +\\| +$" "" trim))) 84 | 85 | (defun elfeed-parse-simple-iso-8601 (string) 86 | "Attempt to parse STRING as a simply formatted ISO 8601 date. 87 | Examples: 2015-02-22, 2015-02, 20150222" 88 | (let* ((re (cl-flet ((re-numbers (num) (format "\\([0-9]\\{%s\\}\\)" num))) 89 | (format "^%s-?%s-?%s?\\(T%s:%s:?%s?\\)?" 90 | (re-numbers 4) 91 | (re-numbers 2) 92 | (re-numbers 2) 93 | (re-numbers 2) 94 | (re-numbers 2) 95 | (re-numbers 2)))) 96 | (matches (save-match-data 97 | (when (string-match re string) 98 | (cl-loop for i from 1 to 7 99 | collect (let ((match (match-string i string))) 100 | (and match (string-to-number match)))))))) 101 | (when matches 102 | (cl-multiple-value-bind (year month day _ hour min sec) matches 103 | (float-time (encode-time (or sec 0) (or min 0) (or hour 0) 104 | (or day 1) month year t)))))) 105 | 106 | (defun elfeed-new-date-for-entry (old-date new-date) 107 | "Decide entry date, given an existing date (nil for new) and a new date. 108 | Existing entries' dates are unchanged if the new date is not 109 | parseable. New entries with unparseable dates default to the 110 | current time." 111 | (or (elfeed-float-time new-date) 112 | old-date 113 | (float-time))) 114 | 115 | (defun elfeed-float-time (date) 116 | "Like `float-time' but accept anything reasonable for DATE. 117 | Defaults to nil if DATE could not be parsed. Date is allowed to 118 | be relative to now (`elfeed-time-duration')." 119 | (cl-typecase date 120 | (string 121 | (let ((iso-8601 (elfeed-parse-simple-iso-8601 date))) 122 | (if iso-8601 123 | iso-8601 124 | (let ((duration (elfeed-time-duration date))) 125 | (if duration 126 | (- (float-time) duration) 127 | (let ((time (ignore-errors (date-to-time date)))) 128 | ;; check if date-to-time failed, silently or otherwise 129 | (unless (or (null time) (equal time '(14445 17280))) 130 | (float-time time)))))))) 131 | (integer date) 132 | (otherwise nil))) 133 | 134 | (defun elfeed-xml-parse-region (&optional beg end buffer parse-dtd _parse-ns) 135 | "Decode (if needed) and parse XML file. Uses coding system from 136 | XML encoding declaration." 137 | (unless beg (setq beg (point-min))) 138 | (unless end (setq end (point-max))) 139 | (goto-char beg) 140 | (when (re-search-forward 141 | "<\\?xml.*?encoding=[\"']\\([^\"']+\\)[\"'].*?\\?>" nil t) 142 | (let ((coding-system (intern-soft (downcase (match-string 1))))) 143 | (when (ignore-errors (check-coding-system coding-system)) 144 | (let ((mark-beg (make-marker)) 145 | (mark-end (make-marker))) 146 | ;; Region changes with encoding, so use markers to track it. 147 | (set-marker mark-beg beg) 148 | (set-marker mark-end end) 149 | (set-buffer-multibyte t) 150 | (recode-region mark-beg mark-end coding-system 'raw-text) 151 | (setf beg (marker-position mark-beg) 152 | end (marker-position mark-end)))))) 153 | (let ((xml-default-ns ())) 154 | (xml-parse-region beg end buffer parse-dtd 'symbol-qnames))) 155 | 156 | (defun elfeed-xml-unparse (element) 157 | "Inverse of `elfeed-xml-parse-region', writing XML to the buffer." 158 | (cl-destructuring-bind (tag attrs . body) element 159 | (insert (format "<%s" tag)) 160 | (dolist (attr attrs) 161 | (cl-destructuring-bind (key . value) attr 162 | (insert (format " %s='%s'" key (xml-escape-string value))))) 163 | (if (null body) 164 | (insert "/>") 165 | (insert ">") 166 | (dolist (sub body) 167 | (if (stringp sub) 168 | (insert (xml-escape-string sub)) 169 | (elfeed-xml-unparse sub))) 170 | (insert (format "" tag))))) 171 | 172 | (defun elfeed-directory-empty-p (dir) 173 | "Return non-nil if DIR is empty." 174 | (null (cddr (directory-files dir)))) 175 | 176 | (defun elfeed-slurp (file &optional literally) 177 | "Return the contents of FILE as a string." 178 | (with-temp-buffer 179 | (if literally 180 | (insert-file-contents-literally file) 181 | (insert-file-contents file)) 182 | (buffer-string))) 183 | 184 | (cl-defun elfeed-spit (file string &key fsync append (encoding 'utf-8)) 185 | "Write STRING to FILE." 186 | (let ((coding-system-for-write encoding) 187 | (write-region-inhibit-fsync (not fsync))) 188 | (with-temp-buffer 189 | (insert string) 190 | (write-region nil nil file append 0)))) 191 | 192 | (defvar elfeed-gzip-supported-p--cache :unknown 193 | "To avoid running the relatively expensive test more than once.") 194 | 195 | (defun elfeed-gzip-supported-p () 196 | "Return non-nil if `auto-compression-mode' can handle gzip." 197 | (if (not (eq elfeed-gzip-supported-p--cache :unknown)) 198 | elfeed-gzip-supported-p--cache 199 | (setf elfeed-gzip-supported-p--cache 200 | (and (executable-find "gzip") 201 | (ignore-errors 202 | (save-window-excursion 203 | (let ((file (make-temp-file "gziptest" nil ".gz")) 204 | (data (cl-loop for i from 32 to 3200 205 | collect i into chars 206 | finally 207 | (return (apply #'string chars))))) 208 | (unwind-protect 209 | (progn 210 | (elfeed-spit file data) 211 | (and (string= data (elfeed-slurp file)) 212 | (not (string= data (elfeed-slurp file t))))) 213 | (delete-file file))))))))) 214 | 215 | (defun elfeed-libxml-supported-p () 216 | "Return non-nil if `libxml-parse-html-region' is available." 217 | (with-temp-buffer 218 | (insert "") 219 | (and (fboundp 'libxml-parse-html-region) 220 | (not (null (libxml-parse-html-region (point-min) (point-max))))))) 221 | 222 | (defun elfeed-keyword->symbol (keyword) 223 | "If a keyword, convert KEYWORD into a plain symbol (remove the colon)." 224 | (if (keywordp keyword) 225 | (intern (substring (symbol-name keyword) 1)) 226 | keyword)) 227 | 228 | (defun elfeed-resize-vector (vector length) 229 | "Return a copy of VECTOR set to size LENGTH." 230 | (let ((new-vector (make-vector length nil))) 231 | (prog1 new-vector ; don't use dotimes result (bug#16206) 232 | (dotimes (i (min (length new-vector) (length vector))) 233 | (setf (aref new-vector i) (aref vector i)))))) 234 | 235 | (defun elfeed-readable-p (value) 236 | "Return non-nil if VALUE can be serialized." 237 | (condition-case _ 238 | (prog1 t (read (prin1-to-string value))) 239 | (error nil))) 240 | 241 | (defun elfeed-strip-properties (string) 242 | "Return a copy of STRING with all properties removed. 243 | If STRING is nil, returns nil." 244 | (when string 245 | (let ((copy (copy-sequence string))) 246 | (prog1 copy 247 | (set-text-properties 0 (length copy) nil copy))))) 248 | 249 | (defun elfeed-clipboard-get () 250 | "Try to get a sensible value from the system clipboard. 251 | On systems running X, it will try to use the PRIMARY selection 252 | first, then fall back onto the standard clipboard like other 253 | systems." 254 | (elfeed-strip-properties 255 | (or (and (fboundp 'x-get-selection) 256 | (funcall 'x-get-selection)) 257 | (and (functionp interprogram-paste-function) 258 | (funcall interprogram-paste-function)) 259 | (and (fboundp 'w32-get-clipboard-data) 260 | (funcall 'w32-get-clipboard-data)) 261 | (ignore-errors 262 | (current-kill 0 :non-destructively))))) 263 | 264 | (defun elfeed-get-link-at-point () 265 | "Try to a link at point and return its URL." 266 | (or (get-text-property (point) 'shr-url) 267 | (and (fboundp 'eww-current-url) 268 | (funcall 'eww-current-url)) 269 | (get-text-property (point) :nt-link))) 270 | 271 | (defun elfeed-get-url-at-point () 272 | "Try to get a plain URL at point." 273 | (or (if (fboundp 'thing-at-point-url-at-point) 274 | (thing-at-point-url-at-point) 275 | (with-no-warnings (url-get-url-at-point))) 276 | (thing-at-point 'url))) 277 | 278 | (defun elfeed-move-to-first-empty-line () 279 | "Place point after first blank line, for use with `url-retrieve'. 280 | If no such line exists, point is left in place." 281 | (let ((start (point))) 282 | (goto-char (point-min)) 283 | (unless (search-forward-regexp "^$" nil t) 284 | (goto-char start)))) 285 | 286 | (defun elfeed--shuffle (seq) 287 | "Destructively shuffle SEQ." 288 | (let ((n (length seq))) 289 | (prog1 seq ; don't use dotimes result (bug#16206) 290 | (dotimes (i n) 291 | (cl-rotatef (elt seq i) (elt seq (+ i (cl-random (- n i))))))))) 292 | 293 | (defun elfeed-split-ranges-to-numbers (str n) 294 | "Convert STR containing enclosure numbers into a list of numbers. 295 | STR is a string; N is the highest possible number in the list. 296 | This includes expanding e.g. 3-5 into 3,4,5. If the letter 297 | \"a\" ('all')) is given, that is expanded to a list with numbers [1..n]." 298 | (let ((str-split (split-string str)) 299 | beg end list) 300 | (dolist (elem str-split list) 301 | ;; special number "a" converts into all enclosures 1-N. 302 | (when (equal elem "a") 303 | (setf elem (concat "1-" (int-to-string n)))) 304 | (if (string-match "\\([0-9]+\\)-\\([0-9]+\\)" elem) 305 | ;; we have found a range A-B, which needs converting 306 | ;; into the numbers A, A+1, A+2, ... B. 307 | (progn 308 | (setf beg (string-to-number (match-string 1 elem)) 309 | end (string-to-number (match-string 2 elem))) 310 | (while (<= beg end) 311 | (setf list (nconc list (list beg)) 312 | beg (1+ beg)))) 313 | ;; else just a number 314 | (push (string-to-number elem) list))))) 315 | 316 | (defun elfeed-remove-dot-segments (input) 317 | "Relative URL algorithm as described in RFC 3986 §5.2.4." 318 | (cl-loop 319 | with output = "" 320 | for s = input 321 | then (cond 322 | ((string-match-p "^\\.\\./" s) 323 | (substring s 3)) 324 | ((string-match-p "^\\./" s) 325 | (substring s 2)) 326 | ((string-match-p "^/\\./" s) 327 | (substring s 2)) 328 | ((string-match-p "^/\\.$" s) "/") 329 | ((string-match-p "^/\\.\\./" s) 330 | (setf output (replace-regexp-in-string "/?[^/]*$" "" output)) 331 | (substring s 3)) 332 | ((string-match-p "^/\\.\\.$" s) 333 | (setf output (replace-regexp-in-string "/?[^/]*$" "" output)) 334 | "/") 335 | ((string-match-p "^\\.\\.?$" s) 336 | "") 337 | ((string-match "^/?[^/]*" s) 338 | (setf output (concat output (match-string 0 s))) 339 | (replace-regexp-in-string "^/?[^/]*" "" s))) 340 | until (zerop (length s)) 341 | finally return output)) 342 | 343 | (defun elfeed-update-location (old-url new-url) 344 | "Return full URL for maybe-relative NEW-URL based on full OLD-URL." 345 | (if (null new-url) 346 | old-url 347 | (let ((old (url-generic-parse-url old-url)) 348 | (new (url-generic-parse-url new-url))) 349 | (cond 350 | ;; Is new URL absolute already? 351 | ((url-type new) new-url) 352 | ;; Empty is a special case (clear fragment) 353 | ((equal new-url "") 354 | (setf (url-target old) nil) 355 | (url-recreate-url old)) 356 | ;; Does it start with //? Append the old protocol. 357 | ((url-fullness new) (concat (url-type old) ":" new-url)) 358 | ;; Is it a relative path? 359 | ((not (string-match-p "^/" new-url)) 360 | (let* ((old-dir (or (file-name-directory (url-filename old)) "/")) 361 | (concat (concat old-dir new-url)) 362 | (new-file (elfeed-remove-dot-segments concat))) 363 | (setf (url-filename old) nil 364 | (url-target old) nil 365 | (url-attributes old) nil 366 | (url-filename old) new-file) 367 | (url-recreate-url old))) 368 | ;; Replace the relative part. 369 | ((progn 370 | (setf (url-filename old) (elfeed-remove-dot-segments new-url) 371 | (url-target old) nil 372 | (url-attributes old) nil) 373 | (url-recreate-url old))))))) 374 | 375 | (defun elfeed-url-to-namespace (url) 376 | "Compute an ID namespace from URL." 377 | (let* ((urlobj (url-generic-parse-url url)) 378 | (host (url-host urlobj))) 379 | (if (= 0 (length host)) 380 | url 381 | host))) 382 | 383 | (provide 'elfeed-lib) 384 | 385 | ;;; elfeed-lib.el ends here 386 | -------------------------------------------------------------------------------- /elfeed-link.el: -------------------------------------------------------------------------------- 1 | ;;; elfeed-link.el --- misc functions for elfeed -*- lexical-binding: t; -*- 2 | 3 | ;; This is free and unencumbered software released into the public domain. 4 | 5 | ;;; Commentary: 6 | 7 | ;; Code for integration with org-mode. 8 | 9 | ;; To use, add (require 'elfeed-link) somewhere in your configuration. 10 | 11 | ;;; Code: 12 | 13 | (require 'org) 14 | (require 'cl-lib) 15 | (require 'elfeed-db) 16 | (require 'elfeed-show) 17 | (require 'elfeed-search) 18 | 19 | ;;;###autoload 20 | (defun elfeed-link-store-link () 21 | "Store a link to an elfeed search or entry buffer. 22 | 23 | When storing a link to an entry, automatically extract all the 24 | entry metadata. These can be used in the capture templates as 25 | `%:keyword` expansion. 26 | 27 | List of available keywords, when store from an Elfeed search: 28 | - `type` : Type of Org-mode link 29 | - `link` : Org-mode link to this search, also available 30 | with %a, %A, %l and %L 31 | - `description` : The search filter 32 | 33 | 34 | List of available keywords, when store from an Elfeed entry: 35 | - `type` : Type of Org-mode link 36 | - `link` : Org-mode link to this entry, also available 37 | with %a, %A, %l and %L 38 | - `title` : Feed entry title 39 | - `description` : Feed entry description, same as title 40 | - `external-link` : Feed entry external link 41 | - `date` : Date time of the feed entry publication, in 42 | full ISO 8601 format 43 | - `date-timestamp` : Date time of the feed entry publication, in 44 | Org-mode active timestamp format 45 | - `date-inactive-timestamp` : Date time of the feed entry publication, in 46 | Org-mode inactive timestamp format 47 | - `authors` : List of feed entry authors names, joint by a 48 | comma 49 | - `tags` : List of feed entry tags, in Org-mode tags 50 | format 51 | - `content` : Content of the feed entry 52 | - `feed-title` : Title of the feed 53 | - `feed-external-link` : Feed external link 54 | - `feed-authors` : List of feed authors names, joint by a comma 55 | 56 | If `content` type is HTML, it is automatically embedded into an 57 | Org-mode HTML quote." 58 | (cond ((derived-mode-p 'elfeed-search-mode) 59 | (funcall (if (fboundp 'org-link-store-props) 60 | #'org-link-store-props 61 | (with-no-warnings #'org-store-link-props)) 62 | :type "elfeed" 63 | :link (format "elfeed:%s" elfeed-search-filter) 64 | :description elfeed-search-filter)) 65 | ((derived-mode-p 'elfeed-show-mode) 66 | (funcall (if (fboundp 'org-link-store-props) 67 | #'org-link-store-props 68 | (with-no-warnings #'org-store-link-props)) 69 | :type "elfeed" 70 | :link (format "elfeed:%s#%s" 71 | (car (elfeed-entry-id elfeed-show-entry)) 72 | (cdr (elfeed-entry-id elfeed-show-entry))) 73 | :description (elfeed-entry-title elfeed-show-entry) 74 | :title (elfeed-entry-title elfeed-show-entry) 75 | :external-link (elfeed-entry-link elfeed-show-entry) 76 | ;; Format date to full ISO 8601 format 77 | :date (format-time-string 78 | "%FT%T" 79 | (elfeed-entry-date elfeed-show-entry)) 80 | ;; Concatenate authors names 81 | :authors (mapconcat #'identity 82 | ;; Loop on each author and extract its name 83 | ;; Authors list get from Elfeed entry's meta 84 | (cl-loop for author 85 | in (plist-get (elfeed-entry-meta elfeed-show-entry) :authors) 86 | collect (plist-get author :name)) 87 | ", ") ;; Join names using a comma 88 | ;; Concatenate tags in Org-mode tags format 89 | :tags (format ":%s:" 90 | (mapconcat #'symbol-name 91 | (elfeed-entry-tags elfeed-show-entry) 92 | ":")) 93 | ;; Prepare support of different content type, only HTML for now 94 | :content (pcase (elfeed-entry-content-type elfeed-show-entry) 95 | (`html 96 | ;; Embed the text into Org-mode HTML quote 97 | (format 98 | "#+BEGIN_EXPORT html\n%s\n#+END_EXPORT" 99 | (elfeed-deref (elfeed-entry-content elfeed-show-entry))))) 100 | :feed-title (elfeed-feed-title (elfeed-entry-feed elfeed-show-entry)) 101 | :feed-external-link (elfeed-feed-url (elfeed-entry-feed elfeed-show-entry)) 102 | ;; Concatenate feed authors names 103 | :feed-authors (mapconcat #'identity 104 | ;; Loop on each feed author and extract its name 105 | ;; Authors list get from Elfeed feed 106 | (cl-loop for author 107 | in (elfeed-feed-author(elfeed-entry-feed elfeed-show-entry)) 108 | collect (plist-get author :name)) 109 | ", ") ;; Join names using a comma 110 | )))) 111 | 112 | ;;;###autoload 113 | (defun elfeed-link-open (filter-or-id) 114 | "Jump to an elfeed entry or search. 115 | 116 | Depending on what FILTER-OR-ID looks like, we jump to either 117 | search buffer or show a concrete entry." 118 | (if (string-match "\\([^#]+\\)#\\(.+\\)" filter-or-id) 119 | (elfeed-show-entry (elfeed-db-get-entry 120 | (cons (match-string 1 filter-or-id) 121 | (match-string 2 filter-or-id)))) 122 | (elfeed) 123 | (elfeed-search-set-filter filter-or-id))) 124 | 125 | ;;;###autoload 126 | (eval-after-load 'org 127 | `(funcall 128 | ;; The extra quote below is necessary because uncompiled closures 129 | ;; do not evaluate to themselves. The quote is harmless for 130 | ;; byte-compiled function objects. 131 | ',(lambda () 132 | (if (version< (org-version) "9.0") 133 | (with-no-warnings 134 | (org-add-link-type "elfeed" #'elfeed-link-open) 135 | (add-hook 'org-store-link-functions #'elfeed-link-store-link)) 136 | (with-no-warnings 137 | (org-link-set-parameters 138 | "elfeed" 139 | :follow #'elfeed-link-open 140 | :store #'elfeed-link-store-link)))))) 141 | 142 | (provide 'elfeed-link) 143 | 144 | ;;; elfeed-link.el ends here 145 | -------------------------------------------------------------------------------- /elfeed-log.el: -------------------------------------------------------------------------------- 1 | ;;; elfeed-log.el --- Elfeed's logging system -*- lexical-binding: t; -*- 2 | 3 | ;;; Commentary: 4 | 5 | ;;; Code: 6 | 7 | (require 'cl-lib) 8 | 9 | (defface elfeed-log-date-face 10 | '((t :inherit font-lock-type-face)) 11 | "Face for showing the date in the elfeed log buffer." 12 | :group 'elfeed) 13 | 14 | (defface elfeed-log-error-level-face 15 | '((t :foreground "red")) 16 | "Face for showing the `error' log level in the elfeed log buffer." 17 | :group 'elfeed) 18 | 19 | (defface elfeed-log-warn-level-face 20 | '((t :foreground "goldenrod")) 21 | "Face for showing the `warn' log level in the elfeed log buffer." 22 | :group 'elfeed) 23 | 24 | (defface elfeed-log-info-level-face 25 | '((t :foreground "deep sky blue")) 26 | "Face for showing the `info' log level in the elfeed log buffer." 27 | :group 'elfeed) 28 | 29 | (defface elfeed-log-debug-level-face 30 | '((t :foreground "magenta2")) 31 | "Face for showing the `debug' log level in the elfeed log buffer." 32 | :group 'elfeed) 33 | 34 | (defvar elfeed-log-buffer-name "*elfeed-log*" 35 | "Name of buffer used for logging Elfeed events.") 36 | 37 | (defvar elfeed-log-level 'info 38 | "Lowest type of messages to be logged.") 39 | 40 | (defun elfeed-log-buffer () 41 | "Returns the buffer for `elfeed-log', creating it as needed." 42 | (let ((buffer (get-buffer elfeed-log-buffer-name))) 43 | (if buffer 44 | buffer 45 | (with-current-buffer (generate-new-buffer elfeed-log-buffer-name) 46 | (special-mode) 47 | (current-buffer))))) 48 | 49 | (defun elfeed-log--level-number (level) 50 | "Return a relative level number for LEVEL." 51 | (cl-case level 52 | (debug -10) 53 | (info 0) 54 | (warn 10) 55 | (error 20) 56 | (otherwise -10))) 57 | 58 | (defun elfeed-log (level fmt &rest objects) 59 | "Write log message FMT at LEVEL to Elfeed's log buffer. 60 | 61 | LEVEL should be a symbol: debug, info, warn, error. 62 | FMT must be a string suitable for `format' given OBJECTS as arguments." 63 | (let ((log-buffer (elfeed-log-buffer)) 64 | (log-level-face (cl-case level 65 | (debug 'elfeed-log-debug-level-face) 66 | (info 'elfeed-log-info-level-face) 67 | (warn 'elfeed-log-warn-level-face) 68 | (error 'elfeed-log-error-level-face))) 69 | (inhibit-read-only t)) 70 | (when (>= (elfeed-log--level-number level) 71 | (elfeed-log--level-number elfeed-log-level)) 72 | (with-current-buffer log-buffer 73 | (goto-char (point-max)) 74 | (insert 75 | (format 76 | (concat "[" (propertize "%s" 'face 'elfeed-log-date-face) "] " 77 | "[" (propertize "%s" 'face log-level-face) "]: %s\n") 78 | (format-time-string "%Y-%m-%d %H:%M:%S") 79 | level 80 | (apply #'format fmt objects))))))) 81 | 82 | (provide 'elfeed-log) 83 | 84 | ;;; elfeed-log.el ends here 85 | -------------------------------------------------------------------------------- /elfeed-pkg.el: -------------------------------------------------------------------------------- 1 | (define-package "elfeed" "3.4.2" 2 | "an Emacs Atom/RSS feed reader" 3 | '((emacs "24.3"))) 4 | -------------------------------------------------------------------------------- /elfeed-show.el: -------------------------------------------------------------------------------- 1 | ;;; elfeed-show.el --- display feed entries -*- lexical-binding: t; -*- 2 | 3 | ;; This is free and unencumbered software released into the public domain. 4 | 5 | ;;; Code: 6 | 7 | (require 'cl-lib) 8 | (require 'shr) 9 | (require 'url-parse) 10 | (require 'browse-url) 11 | (require 'message) ; faces 12 | (require 'bookmark) 13 | (bookmark-maybe-load-default-file) 14 | 15 | (require 'elfeed) 16 | (require 'elfeed-db) 17 | (require 'elfeed-lib) 18 | (require 'elfeed-search) 19 | 20 | (defcustom elfeed-show-truncate-long-urls t 21 | "When non-nil, use an ellipsis to shorten very long displayed URLs." 22 | :group 'elfeed 23 | :type 'boolean) 24 | 25 | (defcustom elfeed-show-entry-author t 26 | "When non-nil, show the entry's author (if it's in the entry's metadata)." 27 | :group 'elfeed 28 | :type 'boolean) 29 | 30 | (defvar elfeed-show-entry nil 31 | "The entry being displayed in this buffer.") 32 | 33 | (defcustom elfeed-show-entry-switch #'switch-to-buffer 34 | "Function used to display the feed entry buffer." 35 | :group 'elfeed 36 | :type '(choice (function-item switch-to-buffer) 37 | (function-item pop-to-buffer) 38 | function)) 39 | 40 | (defcustom elfeed-show-entry-delete #'elfeed-kill-buffer 41 | "Function called when quitting from the elfeed-entry buffer. 42 | Called without arguments." 43 | :group 'elfeed 44 | :type '(choice (function-item elfeed-kill-buffer) 45 | (function-item delete-window) 46 | function)) 47 | 48 | (defvar elfeed-show-refresh-function #'elfeed-show-refresh--mail-style 49 | "Function called to refresh the `*elfeed-entry*' buffer.") 50 | 51 | (defvar elfeed-show-mode-map 52 | (let ((map (make-sparse-keymap))) 53 | (prog1 map 54 | (suppress-keymap map) 55 | (define-key map "h" #'describe-mode) 56 | (define-key map "d" #'elfeed-show-save-enclosure) 57 | (define-key map "q" #'elfeed-kill-buffer) 58 | (define-key map "g" #'elfeed-show-refresh) 59 | (define-key map "n" #'elfeed-show-next) 60 | (define-key map "p" #'elfeed-show-prev) 61 | (define-key map "s" #'elfeed-show-new-live-search) 62 | (define-key map "b" #'elfeed-show-visit) 63 | (define-key map "y" #'elfeed-show-yank) 64 | (define-key map "u" #'elfeed-show-tag--unread) 65 | (define-key map "+" #'elfeed-show-tag) 66 | (define-key map "-" #'elfeed-show-untag) 67 | (define-key map "<" #'beginning-of-buffer) 68 | (define-key map ">" #'end-of-buffer) 69 | (define-key map (kbd "SPC") #'scroll-up-command) 70 | (define-key map (kbd "DEL") #'scroll-down-command) 71 | (define-key map (kbd "TAB") #'elfeed-show-next-link) 72 | (define-key map "\e\t" #'shr-previous-link) 73 | (define-key map [backtab] #'shr-previous-link) 74 | (define-key map "c" #'elfeed-kill-link-url-at-point) 75 | (define-key map [mouse-2] #'shr-browse-url) 76 | (define-key map "A" #'elfeed-show-add-enclosure-to-playlist) 77 | (define-key map "P" #'elfeed-show-play-enclosure))) 78 | "Keymap for `elfeed-show-mode'.") 79 | 80 | (defun elfeed-show-mode () 81 | "Mode for displaying Elfeed feed entries. 82 | \\{elfeed-show-mode-map}" 83 | (interactive) 84 | (kill-all-local-variables) 85 | (use-local-map elfeed-show-mode-map) 86 | (setq major-mode 'elfeed-show-mode 87 | mode-name "elfeed-show" 88 | buffer-read-only t) 89 | (buffer-disable-undo) 90 | (make-local-variable 'elfeed-show-entry) 91 | (set (make-local-variable 'bookmark-make-record-function) 92 | #'elfeed-show-bookmark-make-record) 93 | (run-mode-hooks 'elfeed-show-mode-hook)) 94 | 95 | (defalias 'elfeed-show-tag--unread 96 | (elfeed-expose #'elfeed-show-tag 'unread) 97 | "Mark the current entry unread.") 98 | 99 | (defun elfeed-insert-html (html &optional base-url) 100 | "Converted HTML markup to a propertized string." 101 | (shr-insert-document 102 | (if (elfeed-libxml-supported-p) 103 | (with-temp-buffer 104 | ;; insert to work around libxml-parse-html-region bug 105 | (when base-url 106 | (insert (format "" base-url))) 107 | (insert html) 108 | (libxml-parse-html-region (point-min) (point-max) base-url)) 109 | '(i () "Elfeed: libxml2 functionality is unavailable")))) 110 | 111 | (cl-defun elfeed-insert-link (url &optional (content url)) 112 | "Insert a clickable hyperlink to URL titled CONTENT." 113 | (when (and elfeed-show-truncate-long-urls 114 | (integerp shr-width) 115 | (> (length content) (- shr-width 8))) 116 | (let ((len (- (/ shr-width 2) 10))) 117 | (setq content (format "%s[...]%s" 118 | (substring content 0 len) 119 | (substring content (- len)))))) 120 | (elfeed-insert-html (format "%s" url content))) 121 | 122 | (defun elfeed-compute-base (url) 123 | "Return the base URL for URL, useful for relative paths." 124 | (let ((obj (url-generic-parse-url url))) 125 | (setf (url-filename obj) nil) 126 | (setf (url-target obj) nil) 127 | (url-recreate-url obj))) 128 | 129 | (defun elfeed--show-format-author (author) 130 | "Format author plist for the header." 131 | (cl-destructuring-bind (&key name uri email &allow-other-keys) 132 | author 133 | (cond ((and name uri email) 134 | (format "%s <%s> (%s)" name email uri)) 135 | ((and name email) 136 | (format "%s <%s>" name email)) 137 | ((and name uri) 138 | (format "%s (%s)" name uri)) 139 | (name name) 140 | (email email) 141 | (uri uri) 142 | ("[unknown]")))) 143 | 144 | (defun elfeed-show-refresh--mail-style () 145 | "Update the buffer to match the selected entry, using a mail-style." 146 | (interactive) 147 | (let* ((inhibit-read-only t) 148 | (title (elfeed-entry-title elfeed-show-entry)) 149 | (date (seconds-to-time (elfeed-entry-date elfeed-show-entry))) 150 | (authors (elfeed-meta elfeed-show-entry :authors)) 151 | (link (elfeed-entry-link elfeed-show-entry)) 152 | (tags (elfeed-entry-tags elfeed-show-entry)) 153 | (tagsstr (mapconcat #'symbol-name tags ", ")) 154 | (nicedate (format-time-string "%a, %e %b %Y %T %Z" date)) 155 | (content (elfeed-deref (elfeed-entry-content elfeed-show-entry))) 156 | (type (elfeed-entry-content-type elfeed-show-entry)) 157 | (feed (elfeed-entry-feed elfeed-show-entry)) 158 | (feed-title (elfeed-feed-title feed)) 159 | (base (and feed (elfeed-compute-base (elfeed-feed-url feed))))) 160 | (erase-buffer) 161 | (insert (format (propertize "Title: %s\n" 'face 'message-header-name) 162 | (propertize title 'face 'message-header-subject))) 163 | (when elfeed-show-entry-author 164 | (dolist (author authors) 165 | (let ((formatted (elfeed--show-format-author author))) 166 | (insert 167 | (format (propertize "Author: %s\n" 'face 'message-header-name) 168 | (propertize formatted 'face 'message-header-to)))))) 169 | (insert (format (propertize "Date: %s\n" 'face 'message-header-name) 170 | (propertize nicedate 'face 'message-header-other))) 171 | (insert (format (propertize "Feed: %s\n" 'face 'message-header-name) 172 | (propertize feed-title 'face 'message-header-other))) 173 | (when tags 174 | (insert (format (propertize "Tags: %s\n" 'face 'message-header-name) 175 | (propertize tagsstr 'face 'message-header-other)))) 176 | (insert (propertize "Link: " 'face 'message-header-name)) 177 | (elfeed-insert-link link link) 178 | (insert "\n") 179 | (cl-loop for enclosure in (elfeed-entry-enclosures elfeed-show-entry) 180 | do (insert (propertize "Enclosure: " 'face 'message-header-name)) 181 | do (elfeed-insert-link (car enclosure)) 182 | do (insert "\n")) 183 | (insert "\n") 184 | (if content 185 | (if (eq type 'html) 186 | (elfeed-insert-html content base) 187 | (insert content)) 188 | (insert (propertize "(empty)\n" 'face 'italic))) 189 | (goto-char (point-min)))) 190 | 191 | (defun elfeed-show-refresh () 192 | "Update the buffer to match the selected entry." 193 | (interactive) 194 | (call-interactively elfeed-show-refresh-function)) 195 | 196 | (defcustom elfeed-show-unique-buffers nil 197 | "When non-nil, every entry buffer gets a unique name. 198 | This allows for displaying multiple show buffers at the same 199 | time." 200 | :group 'elfeed 201 | :type 'boolean) 202 | 203 | (defun elfeed-show--buffer-name (entry) 204 | "Return the appropriate buffer name for ENTRY. 205 | The result depends on the value of `elfeed-show-unique-buffers'." 206 | (if elfeed-show-unique-buffers 207 | (format "*elfeed-entry-<%s %s>*" 208 | (elfeed-entry-title entry) 209 | (format-time-string "%F" (elfeed-entry-date entry))) 210 | "*elfeed-entry*")) 211 | 212 | (defun elfeed-show-entry (entry) 213 | "Display ENTRY in the current buffer." 214 | (let ((buff (get-buffer-create (elfeed-show--buffer-name entry)))) 215 | (with-current-buffer buff 216 | (elfeed-show-mode) 217 | (setq elfeed-show-entry entry) 218 | (elfeed-show-refresh)) 219 | (funcall elfeed-show-entry-switch buff))) 220 | 221 | (defun elfeed-show-next () 222 | "Show the next item in the elfeed-search buffer." 223 | (interactive) 224 | (funcall elfeed-show-entry-delete) 225 | (with-current-buffer (elfeed-search-buffer) 226 | (when elfeed-search-remain-on-entry (forward-line 1)) 227 | (call-interactively #'elfeed-search-show-entry))) 228 | 229 | (defun elfeed-show-prev () 230 | "Show the previous item in the elfeed-search buffer." 231 | (interactive) 232 | (funcall elfeed-show-entry-delete) 233 | (with-current-buffer (elfeed-search-buffer) 234 | (when elfeed-search-remain-on-entry (forward-line 1)) 235 | (forward-line -2) 236 | (call-interactively #'elfeed-search-show-entry))) 237 | 238 | (defun elfeed-show-new-live-search () 239 | "Kill the current buffer, search again in *elfeed-search*." 240 | (interactive) 241 | (elfeed-kill-buffer) 242 | (elfeed) 243 | (elfeed-search-live-filter)) 244 | 245 | (defun elfeed-show-visit (&optional use-generic-p) 246 | "Visit the current entry in your browser using `browse-url'. 247 | If there is a prefix argument, visit the current entry in the 248 | browser defined by `browse-url-generic-program'." 249 | (interactive "P") 250 | (let ((link (elfeed-entry-link elfeed-show-entry))) 251 | (when link 252 | (message "Sent to browser: %s" link) 253 | (if use-generic-p 254 | (browse-url-generic link) 255 | (browse-url link))))) 256 | 257 | (defun elfeed-show-yank () 258 | "Copy the current entry link URL to the clipboard." 259 | (interactive) 260 | (let ((link (elfeed-entry-link elfeed-show-entry))) 261 | (when link 262 | (kill-new link) 263 | (if (fboundp 'gui-set-selection) 264 | (gui-set-selection 'PRIMARY link) 265 | (with-no-warnings 266 | (x-set-selection 'PRIMARY link))) 267 | (message "Yanked: %s" link)))) 268 | 269 | (defun elfeed-show-tag (&rest tags) 270 | "Add TAGS to the displayed entry." 271 | (interactive (list (intern (read-from-minibuffer "Tag: ")))) 272 | (let ((entry elfeed-show-entry)) 273 | (apply #'elfeed-tag entry tags) 274 | (with-current-buffer (elfeed-search-buffer) 275 | (elfeed-search-update-entry entry)) 276 | (elfeed-show-refresh))) 277 | 278 | (defun elfeed-show-untag (&rest tags) 279 | "Remove TAGS from the displayed entry." 280 | (interactive (let* ((tags (elfeed-entry-tags elfeed-show-entry)) 281 | (names (mapcar #'symbol-name tags)) 282 | (select (completing-read "Untag: " names nil :match))) 283 | (list (intern select)))) 284 | (let ((entry elfeed-show-entry)) 285 | (apply #'elfeed-untag entry tags) 286 | (with-current-buffer (elfeed-search-buffer) 287 | (elfeed-search-update-entry entry)) 288 | (elfeed-show-refresh))) 289 | 290 | ;; Enclosures: 291 | 292 | (defcustom elfeed-enclosure-default-dir (expand-file-name "~") 293 | "Default directory for saving enclosures. 294 | This can be either a string (a file system path), or a function 295 | that takes a filename and the mime-type as arguments, and returns 296 | the enclosure dir." 297 | :type 'directory 298 | :group 'elfeed 299 | :safe 'stringp) 300 | 301 | (defcustom elfeed-save-multiple-enclosures-without-asking nil 302 | "If non-nil, saving multiple enclosures asks once for a 303 | directory and saves all attachments in the chosen directory." 304 | :type 'boolean 305 | :group 'elfeed) 306 | 307 | (defvar elfeed-show-enclosure-filename-function 308 | #'elfeed-show-enclosure-filename-remote 309 | "Function called to generate the filename for an enclosure.") 310 | 311 | (defun elfeed--download-enclosure (url path) 312 | "Download asynchronously the enclosure from URL to PATH." 313 | (if (require 'async nil :noerror) 314 | (with-no-warnings 315 | (async-start 316 | (lambda () 317 | (url-copy-file url path t)) 318 | (lambda (_) 319 | (message (format "%s downloaded" url))))) 320 | (url-copy-file url path t))) 321 | 322 | (defun elfeed--get-enclosure-num (prompt entry &optional multi) 323 | "Ask the user with PROMPT for an enclosure number for ENTRY. 324 | The number is [1..n] for enclosures \[0..(n-1)] in the entry. If 325 | MULTI is nil, return the number for the enclosure; 326 | otherwise (MULTI is non-nil), accept ranges of enclosure numbers, 327 | as per `elfeed-split-ranges-to-numbers', and return the 328 | corresponding string." 329 | (let* ((count (length (elfeed-entry-enclosures entry))) 330 | def) 331 | (when (zerop count) 332 | (error "No enclosures to this entry")) 333 | (if (not multi) 334 | (if (= count 1) 335 | (read-number (format "%s: " prompt) 1) 336 | (read-number (format "%s (1-%d): " prompt count))) 337 | (progn 338 | (setq def (if (= count 1) "1" (format "1-%d" count))) 339 | (read-string (format "%s (default %s): " prompt def) 340 | nil nil def))))) 341 | 342 | (defun elfeed--request-enclosure-path (fname path) 343 | "Ask the user where to save FNAME (default is PATH/FNAME)." 344 | (let ((fpath (expand-file-name 345 | (read-file-name "Save as: " path nil nil fname) path))) 346 | (if (file-directory-p fpath) 347 | (expand-file-name fname fpath) 348 | fpath))) 349 | 350 | (defun elfeed--request-enclosures-dir (path) 351 | "Ask the user where to save multiple enclosures (default is PATH)." 352 | (let ((fpath (expand-file-name 353 | (read-directory-name 354 | (format "Save in directory: ") path nil nil nil) path))) 355 | (if (file-directory-p fpath) 356 | fpath))) 357 | 358 | (defun elfeed-show-enclosure-filename-remote (_entry url-enclosure) 359 | "Returns the remote filename as local filename for an enclosure." 360 | (file-name-nondirectory 361 | (url-unhex-string 362 | (car (url-path-and-query (url-generic-parse-url 363 | url-enclosure)))))) 364 | 365 | (defun elfeed-show-save-enclosure-single (&optional entry enclosure-index) 366 | "Save enclosure number ENCLOSURE-INDEX from ENTRY. 367 | If ENTRY is nil use the elfeed-show-entry variable. 368 | If ENCLOSURE-INDEX is nil ask for the enclosure number." 369 | (interactive) 370 | (let* ((path elfeed-enclosure-default-dir) 371 | (entry (or entry elfeed-show-entry)) 372 | (enclosure-index (or enclosure-index 373 | (elfeed--get-enclosure-num 374 | "Enclosure to save" entry))) 375 | (url-enclosure (car (elt (elfeed-entry-enclosures entry) 376 | (- enclosure-index 1)))) 377 | (fname 378 | (funcall elfeed-show-enclosure-filename-function 379 | entry url-enclosure)) 380 | (retry t) 381 | (fpath)) 382 | (while retry 383 | (setf fpath (elfeed--request-enclosure-path fname path) 384 | retry (and (file-exists-p fpath) 385 | (not (y-or-n-p (format "Overwrite '%s'?" fpath)))))) 386 | (elfeed--download-enclosure url-enclosure fpath))) 387 | 388 | (defun elfeed-show-save-enclosure-multi (&optional entry) 389 | "Offer to save multiple entry enclosures from the current entry. 390 | Default is to save all enclosures, [1..n], where n is the number of 391 | enclosures. You can type multiple values separated by space, e.g. 392 | 1 3-6 8 393 | will save enclosures 1,3,4,5,6 and 8. 394 | 395 | Furthermore, there is a shortcut \"a\" which so means all 396 | enclosures, but as this is the default, you may not need it." 397 | (interactive) 398 | (let* ((entry (or entry elfeed-show-entry)) 399 | (attachstr (elfeed--get-enclosure-num 400 | "Enclosure number range (or 'a' for 'all')" entry t)) 401 | (count (length (elfeed-entry-enclosures entry))) 402 | (attachnums (elfeed-split-ranges-to-numbers attachstr count)) 403 | (path elfeed-enclosure-default-dir) 404 | (fpath)) 405 | (if elfeed-save-multiple-enclosures-without-asking 406 | (let ((attachdir (elfeed--request-enclosures-dir path))) 407 | (dolist (enclosure-index attachnums) 408 | (let* ((url-enclosure 409 | (aref (elfeed-entry-enclosures entry) enclosure-index)) 410 | (fname 411 | (funcall elfeed-show-enclosure-filename-function 412 | entry url-enclosure)) 413 | (retry t)) 414 | (while retry 415 | (setf fpath (expand-file-name (concat attachdir fname) path) 416 | retry 417 | (and (file-exists-p fpath) 418 | (not (y-or-n-p (format "Overwrite '%s'?" fpath)))))) 419 | (elfeed--download-enclosure url-enclosure fpath)))) 420 | (dolist (enclosure-index attachnums) 421 | (elfeed-show-save-enclosure-single entry enclosure-index))))) 422 | 423 | (defun elfeed-show-save-enclosure (&optional multi) 424 | "Offer to save enclosure(s). 425 | If MULTI (prefix-argument) is nil, save a single one, otherwise, 426 | offer to save a range of enclosures." 427 | (interactive "P") 428 | (if multi 429 | (elfeed-show-save-enclosure-multi) 430 | (elfeed-show-save-enclosure-single))) 431 | 432 | (defun elfeed--enclosure-maybe-prompt-index (entry) 433 | "Prompt for an enclosure if there are multiple in ENTRY." 434 | (if (= 1 (length (elfeed-entry-enclosures entry))) 435 | 1 436 | (elfeed--get-enclosure-num "Enclosure to play" entry))) 437 | 438 | (defun elfeed-show-play-enclosure (enclosure-index) 439 | "Play enclosure number ENCLOSURE-INDEX from current entry using EMMS. 440 | Prompts for ENCLOSURE-INDEX when called interactively." 441 | (interactive (list (elfeed--enclosure-maybe-prompt-index elfeed-show-entry))) 442 | (elfeed-show-add-enclosure-to-playlist enclosure-index) 443 | (with-no-warnings 444 | (with-current-emms-playlist 445 | (save-excursion 446 | (emms-playlist-last) 447 | (emms-playlist-mode-play-current-track))))) 448 | 449 | (defun elfeed-show-add-enclosure-to-playlist (enclosure-index) 450 | "Add enclosure number ENCLOSURE-INDEX to current EMMS playlist. 451 | Prompts for ENCLOSURE-INDEX when called interactively." 452 | 453 | (interactive (list (elfeed--enclosure-maybe-prompt-index elfeed-show-entry))) 454 | (require 'emms) ;; optional 455 | (with-no-warnings ;; due to lazy (require ) 456 | (emms-add-url (car (elt (elfeed-entry-enclosures elfeed-show-entry) 457 | (- enclosure-index 1)))))) 458 | 459 | (defun elfeed-show-next-link () 460 | "Skip to the next link, exclusive of the Link header." 461 | (interactive) 462 | (let ((properties (text-properties-at (line-beginning-position)))) 463 | (when (memq 'message-header-name properties) 464 | (forward-paragraph)) 465 | (shr-next-link))) 466 | 467 | (defun elfeed-kill-link-url-at-point () 468 | "Get link URL at point and store in kill-ring." 469 | (interactive) 470 | (let ((url (or (elfeed-get-link-at-point) 471 | (elfeed-get-url-at-point)))) 472 | (if url 473 | (progn (kill-new url) (message url)) 474 | (call-interactively 'shr-copy-url)))) 475 | 476 | ;; Bookmarks 477 | 478 | ;;;###autoload 479 | (defun elfeed-show-bookmark-handler (record) 480 | "Show the bookmarked entry saved in the `RECORD'." 481 | (let* ((id (bookmark-prop-get record 'id)) 482 | (entry (elfeed-db-get-entry id)) 483 | (position (bookmark-get-position record))) 484 | (elfeed-show-entry entry) 485 | (goto-char position))) 486 | 487 | (defun elfeed-show-bookmark-make-record () 488 | "Save the current position and the entry into a bookmark." 489 | (let ((id (elfeed-entry-id elfeed-show-entry)) 490 | (position (point)) 491 | (title (elfeed-entry-title elfeed-show-entry))) 492 | `(,(format "elfeed entry \"%s\"" title) 493 | (id . ,id) 494 | (location . ,title) 495 | (position . ,position) 496 | (handler . elfeed-show-bookmark-handler)))) 497 | 498 | (provide 'elfeed-show) 499 | 500 | ;;; elfeed-show.el ends here 501 | -------------------------------------------------------------------------------- /tests/elfeed-curl-tests.el: -------------------------------------------------------------------------------- 1 | ;;; elfeed-curl-tests.el --- curl tests -*- lexical-binding: t; -*- 2 | 3 | (require 'ert) 4 | (require 'elfeed-lib) 5 | (require 'elfeed-curl) 6 | 7 | (ert-deftest elfeed-curl--protocol-type () 8 | (let ((table '((gopher . "gopher://sdf.org/1") 9 | (http . "http://feeds.bbci.co.uk/news/world/rss.xml") 10 | (http . "feeds.reuters.com/reuters/technologyNews") 11 | (http . "https://krebsonsecurity.com/feed/") 12 | (file . "file:///var/www/feed.xml")))) 13 | (cl-loop for (type . url) in table 14 | do (should (eq (elfeed-curl--protocol-type url) type))))) 15 | 16 | (provide 'elfeed-curl-tests) 17 | 18 | ;;; elfeed-curl-tests.el ends here 19 | -------------------------------------------------------------------------------- /tests/elfeed-db-tests.el: -------------------------------------------------------------------------------- 1 | ;;; elfeed-db-tests.el --- database tests -*- lexical-binding: t; -*- 2 | 3 | (require 'cl-lib) 4 | (require 'ert) 5 | (require 'url-parse) 6 | (require 'elfeed) 7 | (require 'elfeed-db) 8 | (require 'elfeed-lib) 9 | (require 'jka-compr) 10 | 11 | (defvar elfeed-test-random-state 12 | (if (functionp 'record) ; Emacs 26 or later? 13 | (record 'cl--random-state -1 30 267466518) 14 | (vector 'cl-random-state-tag -1 30 267466518)) 15 | "Use the same random state for each run.") 16 | 17 | (defun elfeed-random* (x) 18 | "Generate a random number from `elfeed-test-random-state'." 19 | (cl-random x elfeed-test-random-state)) 20 | 21 | (defun elfeed-test-generate-letter (&optional multibyte) 22 | "Generate a single character from a-z or unicode." 23 | (cl-flet ((control-p (char) 24 | (or (<= char #x001F) (and (>= char #x007F) (<= char #x009F))))) 25 | (if multibyte 26 | (cl-loop for char = (elfeed-random* (1+ #x10FF)) 27 | unless (control-p char) return char) 28 | (+ ?a (elfeed-random* 26))))) 29 | 30 | (cl-defun elfeed-test-random (n &optional (variance 1.0)) 31 | "Generate a random integer around N, minimum of 1." 32 | (max 1 (floor (+ n (- (elfeed-random* (* 1.0 variance n)) 33 | (* variance 0.5 n)))))) 34 | 35 | (cl-defun elfeed-test-generate-word (&optional multibyte (length 6)) 36 | "Generate a word around LENGTH letters long." 37 | (apply #'string 38 | (cl-loop repeat (elfeed-test-random length) 39 | collect (elfeed-test-generate-letter multibyte)))) 40 | 41 | (cl-defun elfeed-test-generate-title (&optional multibyte (length 8)) 42 | "Generate a title around LENGTH words long, capitalized." 43 | (mapconcat 44 | #'identity 45 | (cl-loop repeat (elfeed-test-random length) 46 | collect (elfeed-test-generate-word multibyte) into words 47 | finally (return (cons (capitalize (car words)) (cdr words)))) 48 | " ")) 49 | 50 | (defun elfeed-test-generate-url () 51 | "Generate a random URL." 52 | (let* ((tlds '(".com" ".net" ".org")) 53 | (tld (nth (elfeed-random* (length tlds)) tlds)) 54 | (path (downcase (elfeed-test-generate-title nil 3)))) 55 | (url-recreate-url 56 | (url-parse-make-urlobj 57 | "http" nil nil 58 | (concat (elfeed-test-generate-word nil 10) tld) 59 | nil 60 | (concat "/" (replace-regexp-in-string " " "/" path)) 61 | nil nil :full)))) 62 | 63 | (defmacro with-elfeed-test (&rest body) 64 | "Run BODY with a fresh, empty database that will be destroyed on exit." 65 | (declare (indent defun)) 66 | `(let* ((elfeed-db nil) 67 | (elfeed-db-feeds nil) 68 | (elfeed-db-entries nil) 69 | (elfeed-db-index nil) 70 | (elfeed-feeds nil) 71 | (temp-dir (make-temp-file "elfeed-test-" t)) 72 | (elfeed-db-directory temp-dir) 73 | (elfeed-new-entry-hook nil) 74 | (elfeed-db-update-hook nil) 75 | (elfeed-initial-tags '(unread))) 76 | (unwind-protect 77 | (progn ,@body) 78 | (delete-directory temp-dir :recursive)))) 79 | 80 | (defun elfeed-test-generate-feed () 81 | "Generate a random feed. Warning: run this in `with-elfeed-test'." 82 | (let* ((url (elfeed-test-generate-url)) 83 | (id url) 84 | (feed (elfeed-db-get-feed id))) 85 | (prog1 feed 86 | (push url elfeed-feeds) 87 | (setf (elfeed-feed-title feed) (elfeed-test-generate-title)) 88 | (setf (elfeed-feed-url feed) url)))) 89 | 90 | (cl-defun elfeed-test-generate-date (&optional (within "1 year")) 91 | "Generate an epoch time within WITHIN time before now." 92 | (let* ((duration (elfeed-time-duration within)) 93 | (min-time (- (float-time) duration))) 94 | (+ min-time (elfeed-random* duration)))) 95 | 96 | (cl-defun elfeed-test-generate-entry (feed &optional (within "1 year")) 97 | "Generate a random entry. Warning: run this in `with-elfeed-test'." 98 | (let* ((feed-id (elfeed-feed-id feed)) 99 | (namespace (elfeed-url-to-namespace feed-id)) 100 | (link (elfeed-test-generate-url))) 101 | (elfeed-entry--create 102 | :id (cons namespace link) 103 | :title (elfeed-test-generate-title) 104 | :link link 105 | :date (elfeed-test-generate-date within) 106 | :tags (list 'unread) 107 | :feed-id feed-id))) 108 | 109 | (ert-deftest elfeed-db-size () 110 | (let ((count 143)) 111 | (with-elfeed-test 112 | (let ((feed (elfeed-test-generate-feed))) 113 | (elfeed-db-add 114 | (cl-loop repeat count collect (elfeed-test-generate-entry feed)))) 115 | (should (= (elfeed-db-size) count))))) 116 | 117 | (ert-deftest elfeed-db-merge () 118 | (with-elfeed-test 119 | (let* ((feed (elfeed-test-generate-feed)) 120 | (entry (elfeed-test-generate-entry feed)) 121 | (update (copy-sequence entry))) 122 | (should (eq (elfeed-entry-merge entry update) nil)) 123 | (setf (elfeed-entry-title update) (elfeed-test-generate-title)) 124 | (should (eq (elfeed-entry-merge entry update) t))) 125 | (let ((a (elfeed-entry--create :tags '(a b c) :meta '(:a 1 :b 2))) 126 | (b (elfeed-entry--create :tags '(c d) :meta '(:b 3 :c 4)))) 127 | (elfeed-entry-merge a b) 128 | (should (equal (elfeed-entry-tags a) '(a b c))) 129 | (should (eql (plist-get (elfeed-entry-meta a) :a) 1)) 130 | (should (eql (plist-get (elfeed-entry-meta a) :b) 3)) 131 | (should (eql (plist-get (elfeed-entry-meta a) :c) 4))))) 132 | 133 | (ert-deftest elfeed-db-tag () 134 | (with-elfeed-test 135 | (let* ((feed (elfeed-test-generate-feed)) 136 | (entry (elfeed-test-generate-entry feed)) 137 | (tags (elfeed-normalize-tags '(foo bar baz)))) 138 | (apply #'elfeed-tag entry tags) 139 | (elfeed-untag entry 'unread) 140 | (should (equal (elfeed-entry-tags entry) tags)) 141 | (should (elfeed-tagged-p 'foo entry)) 142 | (should (elfeed-tagged-p 'bar entry)) 143 | (should (elfeed-tagged-p 'baz entry)) 144 | (should-not (elfeed-tagged-p 'unread entry))))) 145 | 146 | (ert-deftest elfeed-db-visit () 147 | (with-elfeed-test 148 | (cl-loop for feed in (cl-loop repeat 8 collect (elfeed-test-generate-feed)) 149 | do (elfeed-db-add 150 | (cl-loop repeat 10 collect (elfeed-test-generate-entry feed)))) 151 | (let ((entries nil) 152 | (feeds nil)) 153 | (with-elfeed-db-visit (entry feed) 154 | (push (elfeed-entry-date entry) entries) 155 | (cl-pushnew feed feeds :test #'equal)) 156 | ;; All entries should have appeared. 157 | (should (= (length entries) 80)) 158 | ;; All feeds should have appeared. 159 | (should (= (length feeds) 8)) 160 | ;; All entries should have appeared in date order 161 | (should (equal (sort (copy-sequence entries) #'<) entries)) 162 | entries))) 163 | 164 | (ert-deftest elfeed-db-dates () 165 | (with-elfeed-test 166 | (let* ((feed (elfeed-test-generate-feed)) 167 | (entries (cl-loop repeat 100 collect 168 | (elfeed-test-generate-entry feed))) 169 | (updated-p nil)) 170 | (elfeed-db-add entries) 171 | (add-hook 'elfeed-new-entry-hook 172 | (apply-partially #'error "No new entries expected!")) 173 | (add-hook 'elfeed-db-update-hook 174 | (lambda () (setf updated-p t))) 175 | (elfeed-db-add 176 | (cl-loop for entry in entries 177 | for update = (copy-sequence entry) 178 | do (setf (elfeed-entry-date update) (elfeed-test-generate-date)) 179 | collect update)) 180 | (should updated-p) 181 | (let ((collected nil) 182 | (sorted nil)) 183 | (with-elfeed-db-visit (entry _) 184 | (push (elfeed-entry-date entry) collected)) 185 | (setf sorted (sort (copy-sequence collected) #'<)) 186 | (should (equal collected sorted)))))) 187 | 188 | (ert-deftest elfeed-ref () 189 | (with-elfeed-test 190 | (let* ((content (cl-loop repeat 25 collect (elfeed-test-generate-title t))) 191 | (refs (mapcar #'elfeed-ref content)) 192 | (derefs (mapcar #'elfeed-deref refs))) 193 | (should (equal content derefs))) 194 | (let ((string "naïveté")) 195 | (should (string= string (elfeed-deref (elfeed-ref string))))))) 196 | 197 | (ert-deftest elfeed-ref-pack () 198 | (catch 'test-abort 199 | (with-elfeed-test 200 | (let ((jka-compr-verbose nil) 201 | (matcher "^[a-z0-9]\\{2\\}$") 202 | (feed (elfeed-test-generate-feed)) 203 | (data (expand-file-name "data" elfeed-db-directory))) 204 | (unless (elfeed-gzip-supported-p) 205 | (message "warning: gzip auto-compression unsupported, skipping") 206 | (throw 'test-abort nil)) 207 | (cl-flet ((make-entries (n) 208 | (cl-loop repeat n 209 | for entry = (elfeed-test-generate-entry feed) 210 | do (setf (elfeed-entry-title entry) 211 | (elfeed-test-generate-title :multibyte)) 212 | do (setf (elfeed-entry-content entry) 213 | (elfeed-entry-title entry)) 214 | collect entry))) 215 | (let ((entries-a (make-entries 20)) 216 | (entries-b (make-entries 20))) 217 | (elfeed-db-add entries-a) 218 | (should (directory-files data nil matcher)) 219 | (elfeed-db-pack) 220 | (elfeed-db-add entries-b) 221 | (elfeed-db-pack) 222 | (elfeed-db-gc) 223 | (should-not (directory-files data nil matcher)) 224 | (dolist (entry (append entries-a entries-b)) 225 | (let ((title (elfeed-entry-title entry)) 226 | (content (elfeed-deref (elfeed-entry-content entry)))) 227 | (should (string= title content)))))))))) 228 | 229 | (ert-deftest elfeed-db-meta () 230 | (with-elfeed-test 231 | (let* ((feed (elfeed-db-get-feed (elfeed-test-generate-url))) 232 | (entry (elfeed-test-generate-entry feed))) 233 | (should (null (elfeed-meta feed :status))) 234 | (should (null (elfeed-meta entry :rating))) 235 | (should (= (elfeed-meta entry :errors 10) 10)) 236 | (setf (elfeed-meta feed :status) 'down 237 | (elfeed-meta entry :rating) 4) 238 | (cl-incf (elfeed-meta entry :errors 0)) 239 | (should (equal 'down (elfeed-meta feed :status))) 240 | (should (equal 4 (elfeed-meta entry :rating))) 241 | (should (= (elfeed-meta entry :errors) 1)) 242 | (should-error (setf (elfeed-meta entry :rating) (current-buffer)))))) 243 | 244 | (ert-deftest elfeed-db-feed-entries () 245 | "Test `elfeed-feed-entries'." 246 | (with-elfeed-test 247 | (cl-flet ((tsort (x) (sort (mapcar #'elfeed-entry-title x) #'string<))) 248 | (let* ((feed-a (elfeed-test-generate-feed)) 249 | (feed-a-entries 250 | (cl-loop repeat 10 collect (elfeed-test-generate-entry feed-a))) 251 | (feed-b (elfeed-test-generate-feed)) 252 | (feed-b-id (elfeed-feed-id feed-b)) 253 | (feed-b-entries 254 | (cl-loop repeat 10 collect (elfeed-test-generate-entry feed-b)))) 255 | (elfeed-db-add feed-a-entries) 256 | (elfeed-db-add feed-b-entries) 257 | ;; Fetch the entries using `elfeed-feed-entries' 258 | (should (equal (tsort (elfeed-feed-entries feed-a)) 259 | (tsort feed-a-entries))) 260 | (should (equal (tsort (elfeed-feed-entries feed-b-id)) 261 | (tsort feed-b-entries))))))) 262 | 263 | (provide 'elfeed-db-tests) 264 | 265 | ;;; elfeed-db-tests.el ends here 266 | -------------------------------------------------------------------------------- /tests/elfeed-lib-tests.el: -------------------------------------------------------------------------------- 1 | ;;; elfeed-lib-tests.el --- library tests -*- lexical-binding: t; -*- 2 | 3 | (require 'ert) 4 | (require 'elfeed-lib) 5 | 6 | (ert-deftest elfeed-goto-line () 7 | (with-temp-buffer 8 | (insert "a\nbb\nccc\ndddd\n") 9 | (elfeed-goto-line 2) 10 | (should (looking-at "bb")) 11 | (elfeed-goto-line 4) 12 | (should (looking-at "dddd")))) 13 | 14 | (ert-deftest elfeed-kill-line () 15 | (with-temp-buffer 16 | (insert "a\nbb\nccc\ndddd\n") 17 | (elfeed-goto-line 3) 18 | (elfeed-kill-line) 19 | (should (equal (buffer-string) "a\nbb\n\ndddd\n")))) 20 | 21 | (ert-deftest elfeed-time-duration () 22 | (should (= (elfeed-time-duration "1 week ago") (* 1.0 7 24 60 60))) 23 | (should (= (elfeed-time-duration "3 years old") (* 3.0 365.25 24 60 60))) 24 | (should (= (elfeed-time-duration "1-day") (* 1.0 24 60 60))) 25 | (should (= (elfeed-time-duration "1hour") (* 1.0 60 60)))) 26 | 27 | (ert-deftest elfeed-time-duration-absolute () 28 | ;; fixed time for testing: assume U.S. eastern 29 | (let ((now (float-time (encode-time 0 20 13 24 6 2019 (* -1 4 60 60))))) 30 | ;; "2019-06-24T13:20:00-04:00" is "2019-06-24T17:20:00Z" so 17h 20mins is 31 | ;; the time difference: 32 | (should (= (+ (* 17 60 60) (* 20 60)) 33 | (elfeed-time-duration "2019-06-24" now))) 34 | (should (= (* 10 60) 35 | (elfeed-time-duration "2019-06-24T17:10" now))) 36 | (should (= (* 10 60) 37 | (elfeed-time-duration "2019-06-24T17:10:00" now))) 38 | (should (= (+ (* 9 60) 30) 39 | (elfeed-time-duration "2019-06-24T17:10:30" now))) 40 | (should (= (+ (* 9 60) 30) 41 | (elfeed-time-duration "2019-06-24T17:10:30Z" now))) 42 | (should (= (+ (* 9 60) 30) 43 | (elfeed-time-duration "2019-06-24T17:10:30+00:00" now))) 44 | (should (= (+ (* 9 60) 30) 45 | (elfeed-time-duration "20190624T17:10:30+00:00" now))))) 46 | 47 | (ert-deftest elfeed-format-column () 48 | (should (string= (elfeed-format-column "foo" 10 :right) " foo")) 49 | (should (string= (elfeed-format-column "foo" 10 :left) "foo ")) 50 | (should (string= (elfeed-format-column "foo" 2 :left) "fo")) 51 | (should (string= (elfeed-format-column "foo" 2 :right) "fo")) 52 | (should (string= (elfeed-format-column "foo" 0) "")) 53 | (should (string= (elfeed-format-column "foo" -1) ""))) 54 | 55 | (ert-deftest elfeed-clamp () 56 | (should (= (elfeed-clamp 0 3 4) 3)) 57 | (should (= (elfeed-clamp 2 9 4) 4)) 58 | (should (= (elfeed-clamp 2 0 4) 2)) 59 | (should (= (elfeed-clamp -6 3 0) 0))) 60 | 61 | (ert-deftest elfeed-valid-regexp-p () 62 | (should (elfeed-valid-regexp-p "")) 63 | (should (elfeed-valid-regexp-p "[abc]\\.")) 64 | (should-not (elfeed-valid-regexp-p "\\")) 65 | (should-not (elfeed-valid-regexp-p "[")) 66 | (should-not (elfeed-valid-regexp-p :foo))) 67 | 68 | (ert-deftest elfeed-looks-like-url-p () 69 | (should (elfeed-looks-like-url-p "http://nullprogram.com/")) 70 | (should (elfeed-looks-like-url-p "https://example.com/")) 71 | (should-not (elfeed-looks-like-url-p "example.com")) 72 | (should-not (elfeed-looks-like-url-p "foo bar")) 73 | (should-not (elfeed-looks-like-url-p nil))) 74 | 75 | (ert-deftest elfeed-cleanup () 76 | (should (string= (elfeed-cleanup " foo bar\n") "foo bar")) 77 | (should (string= (elfeed-cleanup "foo\nbar") "foo bar"))) 78 | 79 | (ert-deftest elfeed-float-time () 80 | (cl-macrolet ((test (time seconds) 81 | `(should (= (elfeed-float-time ,time) ,seconds)))) 82 | (test "1985-03-24" 480470400.0) 83 | (test "1985-03-24T03:23:42Z" 480482622.0) 84 | (test "Mon, 5 May 1986 15:16:09 GMT" 515690169.0) 85 | (test "2015-02-20" 1424390400.0) 86 | (test "20150220" 1424390400.0) 87 | (test "2015-02" 1422748800.0) 88 | (should (null (elfeed-float-time "notadate"))))) 89 | 90 | (ert-deftest elfeed-xml-parse-region () 91 | (with-temp-buffer 92 | (insert 93 | (encode-coding-string 94 | " 95 | Тест" 96 | 'windows-1251)) 97 | (let ((xml (elfeed-xml-parse-region))) 98 | (should (string= "Тест" (nth 2 (nth 0 xml)))))) 99 | (with-temp-buffer 100 | (insert 101 | (encode-coding-string 102 | " 103 | Тест" 104 | 'windows-1251)) 105 | (let ((xml (elfeed-xml-parse-region))) 106 | (should (string= "Тест" (nth 2 (nth 0 xml)))))) 107 | (with-temp-buffer 108 | (insert 109 | (concat 110 | "" 111 | (mapconcat (lambda (_) " ") (number-sequence 1 100000) "") 112 | "")) 113 | (elfeed-xml-parse-region)) 114 | (with-temp-buffer 115 | (set-buffer-multibyte nil) 116 | (insert "" 117 | "\xb0\xd9\xb6\xc8\xbf\xc6\xbc\xbc" 118 | "\xbd\xb9\xb5\xe3\xd0\xc2\xce\xc5") 119 | (should (equal (elfeed-xml-parse-region) '((x nil "百度科技焦点新闻")))))) 120 | 121 | (ert-deftest elfeed-directory-empty-p () 122 | (let ((empty (make-temp-file "empty" t)) 123 | (full (make-temp-file "full" t))) 124 | (unwind-protect 125 | (progn 126 | (with-temp-file (expand-file-name "foo" full)) 127 | (should (elfeed-directory-empty-p empty)) 128 | (should-not (elfeed-directory-empty-p full))) 129 | (delete-directory empty :recursive) 130 | (delete-directory full :recursive)))) 131 | 132 | (ert-deftest elfeed-slurp-spit () 133 | (let ((file (make-temp-file "spit")) 134 | (data (string 40 400 4000 40000))) 135 | (unwind-protect 136 | (progn 137 | (elfeed-spit file data) 138 | (should (string= (elfeed-slurp file) data)) 139 | (elfeed-spit file data :append t) 140 | (should (string= (elfeed-slurp file) (concat data data)))) 141 | (delete-file file)))) 142 | 143 | (ert-deftest elfeed-keyword->symbol () 144 | (should (eq (elfeed-keyword->symbol :foo) 'foo)) 145 | (should (eq (elfeed-keyword->symbol 'foo) 'foo))) 146 | 147 | (ert-deftest elfeed-resize-vector () 148 | (should (equal [nil nil] (elfeed-resize-vector [] 2))) 149 | (should (equal [1 2] (elfeed-resize-vector [1 2 3 4] 2))) 150 | (should (equal [9 8 7 nil] (elfeed-resize-vector [9 8 7] 4)))) 151 | 152 | (ert-deftest elfeed-readable-p () 153 | (should (elfeed-readable-p t)) 154 | (should (elfeed-readable-p nil)) 155 | (should-not (elfeed-readable-p (current-buffer))) 156 | (should (elfeed-readable-p 101)) 157 | (should-not (elfeed-readable-p (make-marker))) 158 | (should (elfeed-readable-p "foobar")) 159 | (should (elfeed-readable-p (make-hash-table))) 160 | (should-not (elfeed-readable-p (symbol-function '+)))) 161 | 162 | (ert-deftest elfeed-move-to-first-empty-line () 163 | (with-temp-buffer 164 | (insert "aaaaa\nbbbb\n\ncccccc") 165 | (elfeed-move-to-first-empty-line) 166 | (should (= (point) 12))) 167 | (with-temp-buffer 168 | (insert "aaaaa\nbbbb\ncccccc") 169 | (goto-char 5) 170 | (elfeed-move-to-first-empty-line) 171 | (should (= (point) 5)))) 172 | 173 | (ert-deftest elfeed-update-location () 174 | (cl-macrolet ((t (o n e) 175 | `(should (equal (elfeed-update-location ,o ,n) ,e)))) 176 | (t "http://foo.example/" "/foo" "http://foo.example/foo") 177 | (t "ftp://foo.example/" "//bar.com/ok" "ftp://bar.com/ok") 178 | (t "https://foo.example/a/b/c" "d" "https://foo.example/a/b/d") 179 | (t "http://foo.example/a/b/c" "/x/x" "http://foo.example/x/x") 180 | (t "http://foo.example/a/b/c" nil "http://foo.example/a/b/c") 181 | (t "http://foo.example/a/b/c#foo" "" "http://foo.example/a/b/c") 182 | (t "http://foo.example/a/b/" "../c" "http://foo.example/a/c") 183 | (t "http://foo.example/a/b/" ".././c" "http://foo.example/a/c") 184 | (t "http://foo.example/a/b/" "../c/../../d" "http://foo.example/d"))) 185 | 186 | (provide 'elfeed-lib-tests) 187 | 188 | ;;; elfeed-lib-tests.el ends here 189 | -------------------------------------------------------------------------------- /tests/elfeed-search-tests.el: -------------------------------------------------------------------------------- 1 | ;;; elfeed-search-tests.el --- search tests -*- lexical-binding: t; -*- 2 | 3 | (require 'ert) 4 | (require 'elfeed-search) 5 | 6 | (defmacro test-search-parse-filter-duration (filter after-days &optional before-days) 7 | (let ((day (* 24 60 60))) 8 | `(should (equal ',(cl-concatenate 'list 9 | (when before-days 10 | (list :before (float (* day before-days)))) 11 | (list :after (float (* day after-days)))) 12 | (elfeed-search-parse-filter ,filter))))) 13 | 14 | (ert-deftest elfeed-parse-filter-time-durations () 15 | (let ((test-time (encode-time 0 0 0 24 6 2019 t)) 16 | (orig-float-time (symbol-function 'float-time))) 17 | (cl-letf (((symbol-function 'float-time) 18 | (lambda (&optional time) 19 | (funcall orig-float-time (or time test-time))))) 20 | (test-search-parse-filter-duration "@5-days-ago--3-days-ago" 5 3) 21 | (test-search-parse-filter-duration "@3-days-ago--5-days-ago" 5 3) 22 | (test-search-parse-filter-duration "@2019-06-01" 23) 23 | (test-search-parse-filter-duration "@2019-06-20--2019-06-01" 23 4) 24 | (test-search-parse-filter-duration "@2019-06-01--2019-06-20" 23 4) 25 | (test-search-parse-filter-duration "@2019-06-01--4-days-ago" 23 4) 26 | (test-search-parse-filter-duration "@4-days-ago--2019-06-01" 23 4)))) 27 | 28 | (defun run-date-filter (filter entry-datetime test-datetime) 29 | "Test if time FILTER passes ENTRY-DATETIME against TEST-DATETIME." 30 | (let* ((test-secs (elfeed-parse-simple-iso-8601 test-datetime)) 31 | (test-time (seconds-to-time test-secs)) 32 | (entry-secs (elfeed-parse-simple-iso-8601 entry-datetime)) 33 | (entry-time (seconds-to-time entry-secs)) 34 | (orig-float-time (symbol-function 'float-time)) 35 | (entry (elfeed-entry--create 36 | :title "test-entry" 37 | :date (float-time entry-time)))) 38 | (cl-letf (((symbol-function 'current-time) 39 | (lambda () test-time)) 40 | ((symbol-function 'float-time) 41 | (lambda (&optional time) 42 | (funcall orig-float-time (or time test-time))))) 43 | (catch 'elfeed-db-done 44 | (let* ((parsed (elfeed-search-parse-filter filter)) 45 | (filter (elfeed-search-compile-filter parsed))) 46 | (funcall filter entry nil 0)))))) 47 | 48 | (ert-deftest elfeed-search-compile-filter () 49 | (should-not (run-date-filter "@1-days-ago" 50 | "2019-06-23" "2019-06-25")) 51 | (should (run-date-filter "@3-days-ago" 52 | "2019-06-23" "2019-06-25")) 53 | (should-not (run-date-filter "@30-days-ago--10-days-ago" 54 | "2019-06-23" "2019-06-25")) 55 | (should (run-date-filter "@2019-06-01" 56 | "2019-06-23" "2019-06-25")) 57 | (should-not (run-date-filter "@2019-06-01--2019-06-20" 58 | "2019-06-23" "2019-06-25"))) 59 | 60 | (ert-deftest elfeed-search-unparse-filter () 61 | (should (string-equal "@5-minutes-ago" (elfeed-search-unparse-filter '(:after 300)))) 62 | (should (string-equal "@5-minutes-ago--1-minute-ago" (elfeed-search-unparse-filter '(:after 300 :before 60))))) 63 | 64 | (provide 'elfeed-search-tests) 65 | 66 | ;;; elfeed-search-tests.el ends here 67 | -------------------------------------------------------------------------------- /tests/elfeed-tests.el: -------------------------------------------------------------------------------- 1 | ;;; elfeed-tests.el --- tests for elfeed -*- lexical-binding: t; -*- 2 | 3 | ;; emacs -batch -Q -L .. -L . -l elfeed-tests.el -f ert-run-tests-batch 4 | 5 | (require 'ert) 6 | (require 'elfeed) 7 | (require 'elfeed-lib) 8 | (require 'xml-query-tests) 9 | (require 'elfeed-db-tests) 10 | (require 'elfeed-lib-tests) 11 | (require 'elfeed-search-tests) 12 | (require 'elfeed-curl-tests) 13 | 14 | (defvar elfeed-test-rss 15 | " 16 | 17 | 18 | RSS Title 19 | This is an example of an RSS feed 20 | http://www.example.com/main.html 21 | Mon, 06 Sep 2014 00:01:00 +0000 22 | Mon, 05 Sep 2014 16:20:00 +0000 23 | 1800 24 | 25 | 26 | Example entry 1 27 | Interesting description 1. 28 | 29 | 30 | 31 | john.doe@example.com (John Doe) 32 | 84815091-a6a3-35d4-7f04-80a6610dc85c 33 | Mon, 06 Sep 2009 16:20:00 +0000 34 | example-entry 35 | Example One 36 | 37 | 38 | 39 | Example entry 2 40 | Interesting description 2. 41 | http://www.wikipedia.org/ 42 | Jane Doe <jane.doe@example.com> 43 | Baby Doe <baby.doe@example.com> 44 | 5059196a-7f8e-3678-ecfe-dad84511d76f 45 | Mon, 2 Sep 2013 20:25:07 GMT 46 | example-entry 47 | Example Two 48 | 49 | 50 | 51 | ") 52 | 53 | (defvar elfeed-test-atom 54 | " 55 | 56 | Example Feed 57 | A subtitle. 58 | 59 | 60 | urn:uuid:60a76c80-d399-11d9-b91C-0003939e0af6 61 | 2003-12-13T18:30:02Z 62 | 63 | John Doe (feed) 64 | johndoe@example.com 65 | 66 | 67 | Jane Doe (feed) 68 | janedoe@example.com 69 | 70 | 71 | 72 | Atom-Powered Robots Run Amok 73 | 74 | 76 | 77 | urn:uuid:1225c695-cfb8-4ebb-aaaa-80da344efa6a 78 | 2003-12-13T18:30:02Z 79 | 80 | 81 | Some text. 82 | 83 | John Doe 84 | johndoe@example.com 85 | 86 | 87 | 88 | 89 | It's Raining Cats and Dogs 90 | 91 | 93 | 94 | urn:uuid:1b91e3d7-2dac-3916-27a3-8d31566f2d09 95 | 2004-12-13T18:30:02Z 96 | 97 | 98 | Some text. 99 | 100 | John Doe 101 | johndoe@example.com 102 | 103 | 104 | Jane Doe 105 | janedoe@example.com 106 | 107 | Foo Bar 108 | 109 | ") 110 | 111 | (defvar elfeed-test-rss1.0 112 | " 113 | 116 | 117 | XML.com 118 | http://xml.com/pub 119 | 120 | XML.com features a rich mix of information and services 121 | for the XML community. 122 | 123 | 124 | 125 | 126 | 127 | 128 | 129 | 130 | 131 | 132 | Processing Inclusions with XSLT 133 | http://xml.com/pub/2000/08/09/xslt/xslt.html 134 | 135 | Processing document inclusions with general XML tools can be 136 | problematic. This article proposes a way of preserving inclusion 137 | information through SAX-based processing. 138 | 139 | 140 | 141 | Putting RDF to Work 142 | http://xml.com/pub/2000/08/09/rdfdb/index.html 143 | 144 | Tool and API support for the Resource Description Framework 145 | is slowly coming of age. Edd Dumbill takes a look at RDFDB, 146 | one of the most exciting new RDF toolkits. 147 | 148 | 149 | ") 150 | 151 | (defvar elfeed-test-xml-base 152 | " 153 | 154 | xml:base test 155 | xml:base is complicated 156 | 157 | 158 | urn:uuid:1edeb49c-1f0a-3de3-9a37-9802ef5c0add 159 | 2015-12-13T18:30:02Z 160 | 161 | xml:base 162 | xml@base.example.com 163 | 164 | 165 | 166 | Entry 0 167 | 168 | urn:uuid:b42c623a-fbf0-31c8-3d54-1a56ee88e6a4 169 | 2015-12-13T18:30:02Z 170 | Content 0 171 | 172 | 173 | 174 | Entry 1 175 | 176 | urn:uuid:bdc21cd1-ceac-3439-ea05-3a1d34796dd2 177 | 2016-12-13T18:30:02Z 178 | Content 1 179 | 180 | 181 | 182 | Entry 1 183 | 184 | urn:uuid:bdc21cd1-ceac-3439-ea05-3a1d34796dd2 185 | 2016-12-13T18:30:02Z 186 | Content 1 187 | 188 | ") 189 | 190 | (defvar elfeed-test-opml 191 | " 192 | 193 | 194 | Web Feeds 195 | 196 | 197 | 198 | 199 | 200 | 201 | 202 | 203 | 204 | 205 | 206 | 207 | 208 | ") 209 | 210 | (ert-deftest elfeed-feed-type () 211 | (with-temp-buffer 212 | (insert elfeed-test-rss) 213 | (should (eq (elfeed-feed-type (elfeed-xml-parse-region)) :rss))) 214 | (with-temp-buffer 215 | (insert elfeed-test-atom) 216 | (should (eq (elfeed-feed-type (elfeed-xml-parse-region)) :atom))) 217 | (with-temp-buffer 218 | (insert elfeed-test-rss1.0) 219 | (should (eq (elfeed-feed-type (elfeed-xml-parse-region)) :rss1.0)))) 220 | 221 | (ert-deftest elfeed-entries-from-x () 222 | (with-elfeed-test 223 | (with-temp-buffer 224 | (insert elfeed-test-rss) 225 | (goto-char (point-min)) 226 | (let* ((url (elfeed-test-generate-url)) 227 | (namespace (elfeed-url-to-namespace url)) 228 | (xml (elfeed-xml-parse-region))) 229 | (cl-destructuring-bind (a b) (elfeed-entries-from-rss url xml) 230 | (should (string= (elfeed-feed-title (elfeed-db-get-feed url)) 231 | "RSS Title")) 232 | (should (string= (elfeed-entry-title a) "Example entry 1")) 233 | (should (string= (elfeed-entry-link a) "http://nullprogram.com/")) 234 | (should (= (elfeed-entry-date a) 1252254000.0)) 235 | (should (equal (elfeed-entry-id a) 236 | (cons namespace 237 | "84815091-a6a3-35d4-7f04-80a6610dc85c"))) 238 | (should (string= (plist-get (nth 0 (elfeed-meta a :authors)) :name) 239 | "John Doe")) 240 | (should (string= (plist-get (nth 0 (elfeed-meta a :authors)) :email) 241 | "john.doe@example.com")) 242 | (should (string= (elfeed-entry-title b) "Example entry 2")) 243 | (should (= (elfeed-entry-date b) 1378153507.0)) 244 | (should (equal (elfeed-entry-id b) 245 | (cons namespace 246 | "5059196a-7f8e-3678-ecfe-dad84511d76f"))) 247 | (should (string= (plist-get (nth 0 (elfeed-meta b :authors)) :name) 248 | "Jane Doe ")) 249 | (should (string= (plist-get (nth 1 (elfeed-meta b :authors)) :name) 250 | "Baby Doe ")) 251 | (should (member "example-entry" (elfeed-meta b :categories))) 252 | (should (member "Example Two" (elfeed-meta b :categories)))))) 253 | (with-temp-buffer 254 | (insert elfeed-test-atom) 255 | (goto-char (point-min)) 256 | (let* ((url (elfeed-test-generate-url)) 257 | (namespace (elfeed-url-to-namespace url)) 258 | (xml (elfeed-xml-parse-region)) 259 | (feed (elfeed-db-get-feed url))) 260 | (cl-destructuring-bind (a b) (elfeed-entries-from-atom url xml) 261 | ;; Authors 262 | (should (string= (plist-get (nth 0 (elfeed-feed-author feed)) :name) 263 | "John Doe (feed)")) 264 | (should (string= (plist-get (nth 0 (elfeed-feed-author feed)) :email) 265 | "johndoe@example.com")) 266 | (should (string= (plist-get (nth 1 (elfeed-feed-author feed)) :name) 267 | "Jane Doe (feed)")) 268 | (should (string= (plist-get (nth 1 (elfeed-feed-author feed)) :email) 269 | "janedoe@example.com")) 270 | ;; Titles 271 | (should (string= (elfeed-feed-title (elfeed-db-get-feed url)) 272 | "Example Feed")) 273 | (should (string= (elfeed-entry-title a) 274 | "Atom-Powered Robots Run Amok")) 275 | ;; Entry A 276 | (should (string= (elfeed-entry-link a) 277 | "http://example.org/2003/atom03.html")) 278 | (should (= (elfeed-entry-date a) 1071340202.0)) 279 | (should 280 | (equal (elfeed-entry-id a) 281 | (cons namespace 282 | "urn:uuid:1225c695-cfb8-4ebb-aaaa-80da344efa6a"))) 283 | (should (member "example" (elfeed-meta a :categories))) 284 | (should (member "cat-1" (elfeed-meta a :categories))) 285 | ;; Entry B 286 | (should (string= (elfeed-entry-title b) 287 | "It's Raining Cats and Dogs")) 288 | (should (string= (elfeed-entry-link b) 289 | "http://example.org/2004/12/13/atom03.html")) 290 | (should (= (elfeed-entry-date b) 1102962602.0)) 291 | (should (string= (plist-get (nth 0 (elfeed-meta b :authors)) :name) 292 | "John Doe")) 293 | (should (string= (plist-get (nth 0 (elfeed-meta b :authors)) :email) 294 | "johndoe@example.com")) 295 | (should (string= (plist-get (nth 1 (elfeed-meta b :authors)) :name) 296 | "Jane Doe")) 297 | (should (string= (plist-get (nth 1 (elfeed-meta b :authors)) :email) 298 | "janedoe@example.com")) 299 | (should (member "example" (elfeed-meta b :categories))) 300 | (should (member "cat-2" (elfeed-meta b :categories))) 301 | (should 302 | (equal (elfeed-entry-id b) 303 | (cons namespace 304 | "urn:uuid:1b91e3d7-2dac-3916-27a3-8d31566f2d09")))))) 305 | (with-temp-buffer 306 | (insert elfeed-test-rss1.0) 307 | (goto-char (point-min)) 308 | (let* ((url (elfeed-test-generate-url)) 309 | (namespace (elfeed-url-to-namespace url)) 310 | (xml (elfeed-xml-parse-region))) 311 | (cl-destructuring-bind (a b) (elfeed-entries-from-rss1.0 url xml) 312 | (should (string= (elfeed-feed-title (elfeed-db-get-feed url)) 313 | "XML.com")) 314 | (should (string= (elfeed-entry-title a) 315 | "Processing Inclusions with XSLT")) 316 | (should 317 | (equal (elfeed-entry-id a) 318 | (cons namespace 319 | "http://xml.com/pub/2000/08/09/xslt/xslt.html"))) 320 | (should (string= (elfeed-entry-title b) 321 | "Putting RDF to Work")) 322 | (should 323 | (equal (elfeed-entry-id b) 324 | (cons namespace 325 | "http://xml.com/pub/2000/08/09/rdfdb/index.html")))))))) 326 | 327 | (ert-deftest elfeed-protocol-relative-url () 328 | (with-elfeed-test 329 | (with-temp-buffer 330 | (insert elfeed-test-rss) 331 | (goto-char (point-min)) 332 | (while (search-forward "http://" nil t) 333 | (replace-match "//" nil t)) 334 | (goto-char (point-min)) 335 | (let ((xml (elfeed-xml-parse-region))) 336 | (cl-destructuring-bind (a b) 337 | (elfeed-entries-from-rss "http://example.com/" xml) 338 | (should (equal (elfeed-entry-link a) 339 | "http://nullprogram.com/")) 340 | (should (equal (elfeed-entry-link b) 341 | "http://www.wikipedia.org/"))) 342 | (cl-destructuring-bind (a b) 343 | (elfeed-entries-from-rss "https://example.com/" xml) 344 | (should (equal (elfeed-entry-link a) 345 | "https://nullprogram.com/")) 346 | (should (equal (elfeed-entry-link b) 347 | "https://www.wikipedia.org/"))))) 348 | (with-temp-buffer 349 | (insert elfeed-test-atom) 350 | (goto-char (point-min)) 351 | (while (search-forward "base=\"http://" nil t) 352 | (replace-match "base=\"//" nil t)) 353 | (goto-char (point-min)) 354 | (let ((xml (elfeed-xml-parse-region))) 355 | (cl-destructuring-bind (a b) 356 | (elfeed-entries-from-atom "http://example.com/" xml) 357 | (should (equal (elfeed-entry-link a) 358 | ;; inherited protocol-relative from xml:base 359 | "http://example.org/2003/atom03.html")) 360 | (should (equal (elfeed-entry-link b) 361 | "http://example.org/2004/12/13/atom03.html"))) 362 | (cl-destructuring-bind (a b) 363 | (elfeed-entries-from-atom "https://example.com/" xml) 364 | (should (equal (elfeed-entry-link a) 365 | ;; inherited protocol-relative from xml:base 366 | "https://example.org/2003/atom03.html")) 367 | (should (equal (elfeed-entry-link b) 368 | "http://example.org/2004/12/13/atom03.html"))))))) 369 | 370 | (ert-deftest elfeed-xml-base () 371 | (with-elfeed-test 372 | (with-temp-buffer 373 | (insert elfeed-test-xml-base) 374 | (goto-char (point-min)) 375 | (let* ((url "http://bar.example.org/") 376 | (xml (elfeed-xml-parse-region)) 377 | (_feed (elfeed-db-get-feed url))) 378 | (cl-destructuring-bind (a b c) (elfeed-entries-from-atom url xml) 379 | (should (string= 380 | (elfeed-entry-link a) 381 | "http://foo.example.org/entry0/content0.html")) 382 | (should (string= 383 | (elfeed-entry-link b) 384 | "http://foo.example.org/entry1/content1.html")) 385 | (should (string= 386 | (elfeed-entry-link c) 387 | "https://entry2.example.com/entry2/content2.html"))))))) 388 | 389 | (ert-deftest elfeed-tagger () 390 | (with-elfeed-test 391 | (let* ((feed (elfeed-test-generate-feed)) 392 | (tagger (elfeed-make-tagger :after "1 year ago" 393 | :entry-title "foobar" 394 | :feed-title '(not "exclude")))) 395 | (setf (elfeed-feed-title feed) "exclude this") 396 | (should-not 397 | (funcall tagger (elfeed-entry--create 398 | :title "welcome to foobar: enjoy your stay" 399 | :date (elfeed-float-time "6 months ago") 400 | :feed-id (elfeed-feed-id feed)))) 401 | (setf (elfeed-feed-title feed) "now include this") 402 | (should 403 | (funcall tagger (elfeed-entry--create 404 | :title "welcome to foobar: enjoy your stay" 405 | :date (elfeed-float-time "6 months ago") 406 | :feed-id (elfeed-feed-id feed)))) 407 | ;; May fail if this test takes more than 2 months to run! 408 | (should-not 409 | (funcall tagger (elfeed-entry--create 410 | :title "welcome to foobar: enjoy your stay" 411 | :date (elfeed-float-time "14 months ago") 412 | :feed-id (elfeed-feed-id feed)))) 413 | (should-not 414 | (funcall tagger (elfeed-entry--create 415 | :title "welcome to barfoo: enjoy your stay" 416 | :date (elfeed-float-time "1 month ago") 417 | :feed-id (elfeed-feed-id feed))))))) 418 | 419 | (ert-deftest elfeed-opml () 420 | (let ((elfeed-feeds nil) 421 | (file (make-temp-file "feedlist"))) 422 | (unwind-protect 423 | (progn 424 | (with-temp-file file 425 | (insert elfeed-test-opml)) 426 | (elfeed-load-opml file) 427 | (setq elfeed-feeds (sort elfeed-feeds #'string<)) 428 | (should (equal elfeed-feeds 429 | '("http://boring.example.com/rss/" 430 | "http://example.com/feed/" 431 | "http://foo.example.com/atom.xml" 432 | "http://funny.example.com/feed/")))) 433 | (ignore-errors (delete-file file)))) 434 | (with-elfeed-test 435 | (let* ((outfile (make-temp-file "opml")) 436 | (feeds (cl-loop repeat 10 collect (elfeed-test-generate-url))) 437 | (elfeed-feeds feeds)) 438 | (unwind-protect 439 | (progn 440 | (cl-loop for url in elfeed-feeds 441 | for feed = (elfeed-db-get-feed url) 442 | for title = (elfeed-test-generate-title) 443 | do (setf (elfeed-feed-title feed) title)) 444 | (elfeed-export-opml outfile) 445 | (setf elfeed-feeds nil) 446 | (elfeed-load-opml outfile) 447 | (setf elfeed-feeds (sort elfeed-feeds #'string<)) 448 | (setf feeds (sort feeds #'string<)) 449 | (should (equal elfeed-feeds feeds))) 450 | (ignore-errors (delete-file outfile)))))) 451 | 452 | (ert-deftest elfeed-autotags () 453 | (let ((elfeed-feeds '("foo" ("bar" :tag-a tag-b) "baz" ("qux")))) 454 | (should (equal (elfeed-feed-list) '("foo" "bar" "baz" "qux"))) 455 | (should (equal (elfeed-feed-autotags "foo") '())) 456 | (should (equal (elfeed-feed-autotags "qux") '())) 457 | (should (equal (elfeed-feed-autotags "bar") '(tag-a tag-b))) 458 | (should (equal (elfeed-feed-autotags (elfeed-feed--create :url "bar")) 459 | '(tag-a tag-b)))) 460 | (with-elfeed-test 461 | (with-temp-buffer 462 | (insert elfeed-test-atom) 463 | (goto-char (point-min)) 464 | (let* ((elfeed-feeds '("http://bar/" ("http://foo/" tag-a :tag-b))) 465 | (xml (elfeed-xml-parse-region)) 466 | (entry (cl-first (elfeed-entries-from-atom "http://foo/" xml)))) 467 | (should (equal (elfeed-entry-tags entry) 468 | (elfeed-normalize-tags '(unread tag-a tag-b)))))))) 469 | 470 | (provide 'elfeed-tests) 471 | 472 | ;;; elfeed-tests.el ends here 473 | -------------------------------------------------------------------------------- /tests/xml-query-tests.el: -------------------------------------------------------------------------------- 1 | ;;; xml-query-tests.el -- tests for xml-query 2 | 3 | (require 'ert) 4 | (require 'xml-query) 5 | 6 | (ert-deftest xml-query () 7 | (let ((xml '((foo ((xmlns . "example/xml")) 8 | (bar ((href . "example.com")) "FOO" (p ()) "BAR") 9 | (baz () "FOOBAZ"))))) 10 | (should (string= (xml-query '(foo :xmlns) xml) "example/xml")) 11 | (should (string= (xml-query* (foo :xmlns) xml) "example/xml")) 12 | (should (string= (xml-query '(foo bar :href) xml) "example.com")) 13 | (should (string= (xml-query* (foo bar :href) xml) "example.com")) 14 | (should (string= (xml-query '(foo baz *) xml) "FOOBAZ")) 15 | (should (string= (xml-query* (foo baz *) xml) "FOOBAZ")) 16 | (should (string= (xml-query '(foo bar *) xml) "FOO")) 17 | (should (string= (xml-query* (foo bar *) xml) "FOO")) 18 | (should (equal (xml-query-all '(foo bar *) xml) '("FOO" "BAR"))) 19 | (should (equal (xml-query-all* (foo bar *) xml) '("FOO" "BAR"))) 20 | (should (equal (xml-query-all '(foo baz *) xml) '("FOOBAZ"))) 21 | (should (equal (xml-query-all* (foo baz *) xml) '("FOOBAZ"))) 22 | (should (equal (xml-query-all '(foo (baz bar) *) xml) 23 | '("FOOBAZ" "FOO" "BAR"))))) 24 | 25 | (provide 'xml-query-tests) 26 | 27 | ;;; xml-query-tests.el ends here 28 | -------------------------------------------------------------------------------- /web/elfeed-web-pkg.el: -------------------------------------------------------------------------------- 1 | (define-package "elfeed-web" "3.4.2" 2 | "web interface to Elfeed" 3 | '((simple-httpd "1.5.1") (elfeed "3.2.0") (emacs "24.3"))) 4 | -------------------------------------------------------------------------------- /web/elfeed-web.el: -------------------------------------------------------------------------------- 1 | ;;; elfeed-web.el --- web interface to Elfeed -*- lexical-binding: t; -*- 2 | 3 | ;; This is free and unencumbered software released into the public domain. 4 | 5 | ;; Author: Christopher Wellons 6 | ;; URL: https://github.com/skeeto/elfeed 7 | 8 | ;;; Commentary: 9 | 10 | ;; This is a very early work in progress. The long-term goal is to 11 | ;; provide a web interface view of the database with optional remote 12 | ;; tag updating. An AngularJS client accesses the database over a few 13 | ;; RESTful endpoints with JSON for serialization. 14 | 15 | ;; The IDs provided by RSS and Atom are completely arbitrary. To avoid 16 | ;; ugly encoding issues they're normalized into short, unique, 17 | ;; alphanumeric codes called webids. Both feeds and entries fall into 18 | ;; the same webid namespace so they share a single endpoint. 19 | 20 | ;; Endpoints: 21 | 22 | ;; /elfeed/ 23 | ;; Serves the static HTML, JS, and CSS content. 24 | 25 | ;; /elfeed/content/ 26 | ;; Serves content from the content database (`elfeed-deref'). 27 | 28 | ;; /elfeed/things/ 29 | ;; Serve up an elfeed-feed or elfeed-entry in JSON format. 30 | 31 | ;; /elfeed/search 32 | ;; Accepts a q parameter which is an filter string to be parsed 33 | ;; and handled by `elfeed-search-parse-filter'. 34 | 35 | ;; /elfeed/tags 36 | ;; Accepts a PUT request to modify the tags of zero or more 37 | ;; entries based on a JSON entry passed as the content. 38 | 39 | ;; /elfeed/update 40 | ;; Accepts a time parameter. If time < `elfeed-db-last-update', 41 | ;; respond with time. Otherwise don't respond until database 42 | ;; updates (long poll). 43 | 44 | ;;; Code: 45 | 46 | (require 'cl-lib) 47 | (require 'json) 48 | (require 'simple-httpd) 49 | (require 'elfeed-db) 50 | (require 'elfeed-search) 51 | 52 | (defcustom elfeed-web-enabled nil 53 | "If true, serve a web interface Elfeed with simple-httpd." 54 | :group 'elfeed 55 | :type 'boolean) 56 | 57 | (defvar elfeed-web-limit 512 58 | "Maximum number of entries to serve at once.") 59 | 60 | (defvar elfeed-web-data-root (file-name-directory load-file-name) 61 | "Location of the static Elfeed web data files.") 62 | 63 | (defvar elfeed-web-webid-map (make-hash-table :test 'equal) 64 | "Track the mapping between entries and IDs.") 65 | 66 | (defvar elfeed-web-webid-seed 67 | (let ((items (list (random) (float-time) (emacs-pid) (system-name)))) 68 | (secure-hash 'sha1 (format "%S" items))) 69 | "Used to make webids less predictable.") 70 | 71 | (defun elfeed-web-make-webid (thing) 72 | "Compute a unique web ID for THING." 73 | (let* ((thing-id (prin1-to-string (aref thing 1))) 74 | (keyed (concat thing-id elfeed-web-webid-seed)) 75 | (hash (base64-encode-string (secure-hash 'sha1 keyed nil nil t))) 76 | (no-slash (replace-regexp-in-string "/" "-" hash)) 77 | (no-plus (replace-regexp-in-string "\\+" "_" no-slash)) 78 | (webid (substring no-plus 0 8))) 79 | (setf (gethash webid elfeed-web-webid-map) thing) 80 | webid)) 81 | 82 | (defun elfeed-web-lookup (webid) 83 | "Lookup a thing by its WEBID." 84 | (let ((thing (gethash webid elfeed-web-webid-map))) 85 | (if thing 86 | thing 87 | (or (with-elfeed-db-visit (entry _) 88 | (when (string= webid (elfeed-web-make-webid entry)) 89 | (setf (gethash webid elfeed-web-webid-map) 90 | (elfeed-db-return entry)))) 91 | (cl-loop for feed hash-values of elfeed-db-feeds 92 | when (string= (elfeed-web-make-webid feed) webid) 93 | return (setf (gethash webid elfeed-web-webid-map) feed)))))) 94 | 95 | (defun elfeed-web-for-json (thing) 96 | "Prepare THING for JSON serialization." 97 | (cl-etypecase thing 98 | (elfeed-entry 99 | (list :webid (elfeed-web-make-webid thing) 100 | :title (elfeed-entry-title thing) 101 | :link (elfeed-entry-link thing) 102 | :date (* 1000 (elfeed-entry-date thing)) 103 | :content (let ((content (elfeed-entry-content thing))) 104 | (and content (elfeed-ref-id content))) 105 | :contentType (elfeed-entry-content-type thing) 106 | :enclosures (or (mapcar #'car (elfeed-entry-enclosures thing)) []) 107 | :tags (or (elfeed-entry-tags thing) []) 108 | :feed (elfeed-web-for-json (elfeed-entry-feed thing)))) 109 | (elfeed-feed 110 | (list :webid (elfeed-web-make-webid thing) 111 | :url (elfeed-feed-url thing) 112 | :title (elfeed-feed-title thing) 113 | :author (elfeed-feed-author thing))))) 114 | 115 | (defmacro with-elfeed-web (&rest body) 116 | "Only execute BODY if `elfeed-web-enabled' is true." 117 | (declare (indent 0)) 118 | `(if (not elfeed-web-enabled) 119 | (progn 120 | (princ (json-encode '(:error 403))) 121 | (httpd-send-header t "application/json" 403)) 122 | ,@body)) 123 | 124 | (defservlet* elfeed/things/:webid application/json () 125 | "Return a requested thing (entry or feed)." 126 | (with-elfeed-web 127 | (princ (json-encode (elfeed-web-for-json (elfeed-web-lookup webid)))))) 128 | 129 | (defservlet* elfeed/content/:ref text/html () 130 | "Serve content-addressable content at REF." 131 | (with-elfeed-web 132 | (let ((content (elfeed-deref (elfeed-ref--create :id ref)))) 133 | (if content 134 | (princ content) 135 | (princ (json-encode '(:error 404))) 136 | (httpd-send-header t "application/json" 404))))) 137 | 138 | (defservlet* elfeed/search application/json (q) 139 | "Perform a search operation with Q and return the results." 140 | (with-elfeed-web 141 | (let* ((results ()) 142 | (modified-q (format "#%d %s" elfeed-web-limit q)) 143 | (filter (elfeed-search-parse-filter modified-q)) 144 | (count 0)) 145 | (with-elfeed-db-visit (entry feed) 146 | (when (elfeed-search-filter filter entry feed count) 147 | (push entry results) 148 | (cl-incf count))) 149 | (princ 150 | (json-encode 151 | (cl-coerce 152 | (mapcar #'elfeed-web-for-json (nreverse results)) 'vector)))))) 153 | 154 | (defvar elfeed-web-waiting () 155 | "Clients waiting for an update.") 156 | 157 | (defservlet* elfeed/update application/json (time) 158 | "Return the current :last-update time for the database. If a 159 | time parameter is provided don't respond until the time has 160 | advanced past it (long poll)." 161 | (let ((update-time (ffloor (elfeed-db-last-update)))) 162 | (if (= update-time (ffloor (float (string-to-number (or time ""))))) 163 | (push (httpd-discard-buffer) elfeed-web-waiting) 164 | (princ (json-encode update-time))))) 165 | 166 | (defservlet* elfeed/mark-all-read application/json () 167 | "Marks all entries in the database as read (quick-and-dirty)." 168 | (with-elfeed-web 169 | (with-elfeed-db-visit (e _) 170 | (elfeed-untag e 'unread)) 171 | (princ (json-encode t)))) 172 | 173 | (defservlet* elfeed/tags application/json () 174 | "Endpoint for adding and removing tags on zero or more entries. 175 | Only PUT requests are accepted, and the content must be a JSON 176 | object with any of these properties: 177 | 178 | add : array of tags to be added 179 | remove : array of tags to be removed 180 | entries : array of web IDs for entries to be modified 181 | 182 | The current set of tags for each entry will be returned." 183 | (with-elfeed-web 184 | (let* ((request (caar httpd-request)) 185 | (content (cadr (assoc "Content" httpd-request))) 186 | (json (ignore-errors (json-read-from-string content))) 187 | (add (cdr (assoc 'add json))) 188 | (remove (cdr (assoc 'remove json))) 189 | (webids (cdr (assoc 'entries json))) 190 | (entries (cl-map 'list #'elfeed-web-lookup webids)) 191 | (status 192 | (cond 193 | ((not (equal request "PUT")) 405) 194 | ((null json) 400) 195 | ((cl-some #'null entries) 404) 196 | (t 200)))) 197 | (if (not (eql status 200)) 198 | (progn 199 | (princ (json-encode `(:error ,status))) 200 | (httpd-send-header t "application/json" status)) 201 | (cl-loop for entry in entries 202 | for webid = (elfeed-web-make-webid entry) 203 | do (apply #'elfeed-tag entry (cl-map 'list #'intern add)) 204 | do (apply #'elfeed-untag entry (cl-map 'list #'intern remove)) 205 | collect (cons webid (elfeed-entry-tags entry)) into result 206 | finally (princ (if result (json-encode result) "{}"))))))) 207 | 208 | (defservlet elfeed text/plain (uri-path _ request) 209 | "Serve static files from `elfeed-web-data-root'." 210 | (if (not elfeed-web-enabled) 211 | (insert "Elfeed web interface is disabled.\n" 212 | "Set `elfeed-web-enabled' to true to enable it.") 213 | (let ((base "/elfeed/")) 214 | (if (< (length uri-path) (length base)) 215 | (httpd-redirect t base) 216 | (let ((path (substring uri-path (1- (length base))))) 217 | (httpd-serve-root t elfeed-web-data-root path request)))))) 218 | 219 | (defun elfeed-web-update () 220 | "Update waiting clients about database changes." 221 | (while elfeed-web-waiting 222 | (let ((proc (pop elfeed-web-waiting))) 223 | (ignore-errors 224 | (with-httpd-buffer proc "application/json" 225 | (princ (json-encode (ffloor (elfeed-db-last-update))))))))) 226 | 227 | (add-hook 'elfeed-db-update-hook 'elfeed-web-update) 228 | 229 | ;;;###autoload 230 | (defun elfeed-web-start () 231 | "Start the Elfeed web interface server." 232 | (interactive) 233 | (httpd-start) 234 | (setf elfeed-web-enabled t)) 235 | 236 | (defun elfeed-web-stop () 237 | "Stop the Elfeed web interface server." 238 | (interactive) 239 | (setf elfeed-web-enabled nil)) 240 | 241 | (provide 'elfeed-web) 242 | 243 | ;;; elfeed-web.el ends here 244 | -------------------------------------------------------------------------------- /web/elfeed.css: -------------------------------------------------------------------------------- 1 | .tag-unread { 2 | font-weight: bold; 3 | } 4 | 5 | .no-results { 6 | font-style: italic; 7 | } 8 | 9 | img.favicon { 10 | display: inline-block; 11 | width: 16px; 12 | height: 16px; 13 | } 14 | 15 | .entry .title { 16 | display: block; 17 | } 18 | 19 | iframe { 20 | border: 0; 21 | min-height: 1024px; 22 | } 23 | 24 | .entry { 25 | margin-bottom: 10px; 26 | } 27 | -------------------------------------------------------------------------------- /web/elfeed.js: -------------------------------------------------------------------------------- 1 | var INITIAL_QUERY = '@3-days-old'; 2 | 3 | function favicon(url) { 4 | return URI(url).path('favicon.ico').search('') 5 | .toString().replace(/\?$/, ''); 6 | } 7 | 8 | function entryFill(entry) { 9 | entry.favicon = favicon(entry.link); 10 | var date = new Date(entry.date); 11 | entry.dateString = [ 12 | 1900 + date.getYear(), 13 | 1 + date.getMonth(), 14 | date.getDate() 15 | ].join('-'); 16 | entry.classes = entry.tags.map(function(tag) { 17 | return 'tag-' + tag; 18 | }).join(' '); 19 | } 20 | 21 | function SearchCtrl($scope, $http) { 22 | $scope.query = INITIAL_QUERY; 23 | $scope.busy = false; 24 | $scope.dirty = true; 25 | 26 | $scope.update = function(blur) { 27 | if (!$scope.busy) { 28 | $scope.busy = true; 29 | $scope.dirty = false; 30 | $http.get(URI('/elfeed/search').search({ 31 | q: $scope.query 32 | }).toString()).success(function(data) { 33 | data.forEach(entryFill); 34 | $scope.entries = data; 35 | $scope.busy = false; 36 | if ($scope.dirty) $scope.update(); 37 | }); 38 | } else { 39 | $scope.dirty = true; 40 | } 41 | 42 | if (blur) { 43 | // Is there a "right" way to do this? I don't think there is. 44 | document.getElementById('query').blur(); 45 | } 46 | }; 47 | 48 | $scope.time = 0; 49 | function poll() { 50 | $http.get(URI('/elfeed/update').search({ 51 | time: $scope.time 52 | }).toString()).success(function(data) { 53 | $scope.time = data; 54 | $scope.update(); 55 | poll(); 56 | }); 57 | } 58 | 59 | poll(); 60 | $scope.selected = null; 61 | 62 | $scope.show = function(entry) { 63 | $scope.selected = entry; 64 | }; 65 | 66 | $scope.markAllRead = function() { 67 | $http.get(URI('/elfeed/mark-all-read')); 68 | $scope.update(); 69 | }; 70 | } 71 | -------------------------------------------------------------------------------- /web/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | Elfeed Web 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 |
14 |
15 |

Emacs Elfeed

16 |
17 |
18 | 19 |
20 | 21 |
22 |
23 | 24 |
25 | 27 |
28 | 31 | 32 |
    33 |
  • 34 | 35 | 36 | {{entry.feed.title}} 37 | 38 | 41 | 42 | {{entry.title}} 43 | 44 |
    • 45 | 46 | No results. 47 | 48 |
49 |
50 |
51 | 52 |
53 |
54 |
55 |

56 | 57 | {{selected.title}} 58 | 59 |

60 | 63 |
64 |
65 |
66 | 67 |
68 | 69 | 70 | 71 | -------------------------------------------------------------------------------- /xml-query.el: -------------------------------------------------------------------------------- 1 | ;;; xml-query.el --- query engine complimenting the xml package 2 | 3 | ;; This is free and unencumbered software released into the public domain. 4 | 5 | ;;; Commentary: 6 | 7 | ;; This provides a very rudimentary, jQuery-like, XML selector 8 | ;; s-expression language. It operates on the output of the xml 9 | ;; package, such as `xml-parse-region' and `xml-parse-file'. It was 10 | ;; written to support Elfeed. 11 | 12 | ;; See the docstring for `xml-query-all'. 13 | 14 | ;; The macro forms, `xml-query*' and `xml-query-all*', are an order of 15 | ;; magnitude faster, but only work on static selectors and need the 16 | ;; namespaces to be pre-stripped. 17 | 18 | ;; Examples: 19 | 20 | ;; This query grabs the top-level paragraph content from XHTML. 21 | 22 | ;; (xml-query-all '(html body p *) xhtml) 23 | 24 | ;; This query extracts all the links from an Atom feed. 25 | 26 | ;; (xml-query-all '(feed entry link [rel "alternate"] :href) xml) 27 | 28 | ;;; Code: 29 | 30 | (require 'cl-lib) 31 | 32 | (defun xml-query-strip-ns (tag) 33 | "Remove the namespace, if any, from TAG." 34 | (when (symbolp tag) 35 | (let ((name (symbol-name tag))) 36 | (if (cl-find ?\: name) 37 | (intern (replace-regexp-in-string "^.+:" "" name)) 38 | tag)))) 39 | 40 | (defun xml-query--tag-all (match xml) 41 | (cl-loop for (tag attribs . content) in (cl-remove-if-not #'listp xml) 42 | when (or (eq tag match) (eq (xml-query-strip-ns tag) match)) 43 | collect (cons tag (cons attribs content)))) 44 | 45 | (defun xml-query--attrib-all (attrib value xml) 46 | (cl-loop for (tag attribs . content) in (cl-remove-if-not #'listp xml) 47 | when (equal (cdr (assoc attrib attribs)) value) 48 | collect (cons tag (cons attribs content)))) 49 | 50 | (defun xml-query--keyword (matcher xml) 51 | (cl-loop with match = (intern (substring (symbol-name matcher) 1)) 52 | for (tag attribs . content) in (cl-remove-if-not #'listp xml) 53 | when (cdr (assoc match attribs)) 54 | collect it)) 55 | 56 | (defun xml-query--symbol (matcher xml) 57 | (xml-query--tag-all matcher xml)) 58 | 59 | (defun xml-query--vector (matcher xml) 60 | (let ((attrib (aref matcher 0)) 61 | (value (aref matcher 1))) 62 | (xml-query--attrib-all attrib value xml))) 63 | 64 | (defun xml-query--list (matchers xml) 65 | (cl-loop for matcher in matchers 66 | append (xml-query-all (if (listp matcher) 67 | matcher 68 | (list matcher)) xml))) 69 | 70 | (defun xml-query--append (xml) 71 | (cl-loop for (tag attribs . content) in (cl-remove-if-not #'listp xml) 72 | append content)) 73 | 74 | (defun xml-query--stringp (thing) 75 | "Return non-nil of THING is a non-blank string." 76 | (and (stringp thing) (string-match "[^ \t\r\n]" thing))) 77 | 78 | (defun xml-query-all (query xml) 79 | "Given a list of tags, XML, apply QUERY and return a list of 80 | matching tags. 81 | 82 | A query is a list of matchers. 83 | - SYMBOL: filters to matching tags 84 | - LIST: each element is a full sub-query, whose results are concatenated 85 | - VECTOR: filters to tags with matching attribute, [tag attrib value] 86 | - KEYWORD: filters to an attribute value (must be last) 87 | - * (an asterisk symbol): filters to content strings (must be last) 88 | 89 | For example, to find all the \"alternate\" link URL in a typical 90 | Atom feed: 91 | 92 | (xml-query-all \\='(feed entry link [rel \"alternate\"] :href) xml)" 93 | (if (null query) 94 | xml 95 | (cl-destructuring-bind (matcher . rest) query 96 | (cond 97 | ((keywordp matcher) (xml-query--keyword matcher xml)) 98 | ((eq matcher '*) 99 | (cl-remove-if-not #'xml-query--stringp (xml-query--append xml))) 100 | (:else 101 | (let ((matches 102 | (cl-etypecase matcher 103 | (symbol (xml-query--symbol matcher xml)) 104 | (vector (xml-query--vector matcher xml)) 105 | (list (xml-query--list matcher xml))))) 106 | (cond 107 | ((null rest) matches) 108 | ((and (or (symbolp (car rest)) 109 | (listp (car rest))) 110 | (not (keywordp (car rest))) 111 | (not (eq '* (car rest)))) 112 | (xml-query-all (cdr query) (xml-query--append matches))) 113 | (:else (xml-query-all rest matches))))))))) 114 | 115 | (defun xml-query (query xml) 116 | "Like `xml-query-all' but only return the first result." 117 | (let ((result (xml-query-all query xml))) 118 | (if (xml-query--stringp result) 119 | result 120 | (car (xml-query-all query xml))))) 121 | 122 | ;; Macro alternatives: 123 | 124 | ;; This is a slightly less capable alternative with significantly 125 | ;; better performance (x10 speedup) that requires a static selector. 126 | ;; The selector is compiled into Lisp code via macro at compile-time, 127 | ;; which is then carried through to byte-code by the compiler. In 128 | ;; byte-code form, the macro performs no function calls other than 129 | ;; `throw' in the case of `xml-query*', where it's invoked less than 130 | ;; once per evaluation (only on success). 131 | 132 | ;; Queries are compiled tail-to-head with a result handler at the 133 | ;; deepest level. The generated code makes multiple bindings of the 134 | ;; variable "v" as it dives deeper into the query, using the layers of 135 | ;; bindings as a breadcrumb stack. 136 | 137 | ;; For `xml-query*', which has a single result, the whole expression 138 | ;; is wrapped in a catch, and the first successful match is thrown to 139 | ;; it from the result handler. 140 | 141 | ;; For `xml-query-all*', the result is pushed into an output list. 142 | 143 | (defun xml-query--compile-tag (tag subexp subloop-p) 144 | `(when (and (consp v) (eq (car v) ',tag)) 145 | ,(if subloop-p 146 | `(dolist (v (cddr v)) 147 | ,subexp) 148 | subexp))) 149 | 150 | (defun xml-query--compile-attrib (pair subexp subloop-p) 151 | `(let ((value (cdr (assq ',(aref pair 0) (cadr v))))) 152 | (when (equal value ,(aref pair 1)) 153 | ,(if subloop-p 154 | `(dolist (v (cddr v)) 155 | ,subexp) 156 | subexp)))) 157 | 158 | (defun xml-query--compile-keyword (keyword subexp) 159 | (let ((attrib (intern (substring (symbol-name keyword) 1)))) 160 | `(let ((v (cdr (assq ',attrib (cadr v))))) 161 | (when v 162 | ,subexp)))) 163 | 164 | (defun xml-query--compile-star (subexp) 165 | `(when (and (stringp v) (string-match "[^ \t\r\n]" v)) 166 | ,subexp)) 167 | 168 | (defun xml-query--compile-top (query input subexp) 169 | (let* ((rquery (reverse query)) 170 | (prev nil)) 171 | (while rquery 172 | (let ((matcher (pop rquery)) 173 | ;; Should the next item loop over its children? 174 | (subloop-p (and (not (null prev)) 175 | (not (keywordp prev)) 176 | (symbolp prev)))) 177 | (cond 178 | ((eq '* matcher) 179 | (setf subexp (xml-query--compile-star subexp))) 180 | ((keywordp matcher) 181 | (setf subexp (xml-query--compile-keyword matcher subexp))) 182 | ((symbolp matcher) 183 | (setf subexp (xml-query--compile-tag matcher subexp subloop-p))) 184 | ((vectorp matcher) 185 | (setf subexp (xml-query--compile-attrib matcher subexp subloop-p))) 186 | ((error "Bad query: %S" query))) 187 | (setf prev matcher))) 188 | `(dolist (v ,input) 189 | ,subexp))) 190 | 191 | (defun xml-query--compile (query input) 192 | (let ((tag (make-symbol "done"))) 193 | `(catch ',tag 194 | ,(xml-query--compile-top query input `(throw ',tag v))))) 195 | 196 | (defmacro xml-query* (query sexp) 197 | "Like `xml-query' but generate code to execute QUERY on SEXP. 198 | 199 | Unlike `xml-query', QUERY must be a static, compile-time 200 | s-expression. See `xml-query-all*' for more information. 201 | 202 | QUERY is *not* evaluated, so it should not be quoted." 203 | (xml-query--compile query sexp)) 204 | 205 | (defun xml-query-all--compile (query input) 206 | (let ((output (make-symbol "output"))) 207 | `(let ((,output ())) 208 | ,(xml-query--compile-top query input `(push v ,output)) 209 | (nreverse ,output)))) 210 | 211 | (defmacro xml-query-all* (query sexp) 212 | "Like `xml-query-all' but generate code to execute QUERY on SEXP. 213 | 214 | Unlike `xml-query-all', QUERY must be a static, compile-time 215 | s-expression. This macro compiles the query into actual code. The 216 | result is faster since the query will be compiled into byte-code 217 | rather than \"interpreted\" at run time. 218 | 219 | Also unlike `xml-query-all', the parsed XML s-expression must 220 | also have its namespace pre-stripped. This is accomplished by 221 | setting the optional PARSE-NS argument of `xml-parse-region' to 222 | symbol-qnames. 223 | 224 | Sub-expression lists are not supported by this macro. 225 | 226 | QUERY is *not* evaluated, so it should not be quoted." 227 | (xml-query-all--compile query sexp)) 228 | 229 | (provide 'xml-query) 230 | 231 | ;;; xml-query.el ends here 232 | --------------------------------------------------------------------------------