elfeed-3.3.0/0000755000175000017500000000000013566267252012611 5ustar dogslegdogslegelfeed-3.3.0/NEWS.md0000644000175000017500000001461213566267252013713 0ustar dogslegdogsleg# Changes ## 3.3.0 (2019-11-23) * New option: `elfeed-search-remain-on-entry`. * More graceful handling of feed filters (=). * Fix minor time handling issue with Emacs >= 26.1 * Load bookmarks before trying to use them. ## 3.2.0 (2019-08-24) * Support for absolute date/time expressions in filters. See README.md for documentation and examples. * curl's `--disable` is now default. To load your .curlrc file, use `--config` explicitly in `elfeed-curl-extra-arguments`. * Re-enable curl's HTTP/2 support. * Function `elfeed-next-link` was renamed to `elfeed-show-next-link`. * New search buffer bindings: <, >, h, c * Multiple authors are now parsed from entries. Reflecting this, the meta key for authors is now `:authors` instead of `:author`. The value is always a list of zero or more authors. * New variable: `elfeed-show-unique-buffers`. Allows for displaying multiple show buffers at the same time. * Various minor fixes and improvements. ## 3.1.0 (2018-08-29) * Add `elfeed-show-enclosure-filename-function` for controlling enclosure filenames. * Dynamically enable/disable --compressed curl option. On some systems curl is built without this option, so it causes errors when it is used. * Minor documentation fixes. ## 3.0.0 (2018-05-13) * Under Emacs 26, there is a new database index format (version 4). Emacs 26 introduces a new "record" type, and cl-defstruct objects used by Elfeed as its database format are now based on this type. This unfortunately changes (and breaks) Elfeed's index format. Prior to this release, Emacs 26 could not open an Emacs 24–25 index and vice versa. As of Elfeed 2.4.0, Elfeed running under Emacs 26 will automatically and quietly upgrade an Emacs 25 database index for Emacs 26. **THIS UPGRADE IS IRREVERSIBLE** and the database can no longer be used with Emacs 25. A one-time backup copy ("index.backup") of the original Emacs 25 index is created before performing the upgrade. If Emacs 25, whether running this or any prior Elfeed release, loads the new database format, it will see an empty database as if starting from scratch. ## 2.3.1 (2018-05-13) * The index is now saved when quitting the elfeed-search window ("q"). * `elfeed-link` is now autoloaded. ## 2.3.0 (2018-01-21) * New `=` syntax in search filters * Support for protocol-relative entry links (i.e. //example.com/foo/) * New `elfeed-add-feed` `:save` key argument * New plist-based parsed search filter format (breaking change) * New hook: `elfeed-search-update-hook` * New hook: `elfeed-db-unload-hook` * New variable: `elfeed-search-sort-function` * Connect curl with a pipe instead of a pty—a performance boost * Minor bug fixes ## 2.2.0 (2017-07-09) * Support for org links (`elfeed-link.el`) * Added `elfeed-db-unload` * New `elfeed-curl-retrieve` interface (breaking changes) * New hooks `elfeed-tag-hooks` and `elfeed-untag-hooks` ## 2.1.1 (2017-04-02) * Added `elfeed-show-entry-author` customization variable. * Added `elfeed-search-unparse-filter` ## 2.1.0 (2017-01-25) * New entry ID based only on domain, not whole feed * Byte-compiled search filters (`elfeed-search-compile-filter`) * Improved metadata persistence on entry updates * Gather `:author` from entries * Gather `:categories` from entries * New `elfeed-add-feed` interface (thanks Mark Oteiza) * New xml-query macros for faster feed parsing ## 2.0.1 (2016-10-30) * Added `elfeed-curl-extra-arguments` customization * Use `x-get-selection` instead of `x-get-selection-value` * More flexible date handling (including Atom 0.3 support) * Various elfeed-web fixes ## 2.0.0 (2016-08-26) * Elfeed now uses cURL when available (`elfeed-use-curl`) * Windows OS now supported when using cURL * Conditional GET (ETag, `If-Modified-Since`) when using cURL * Support for xml:base in Atom feeds * New options: `elfeed-set-max-connections`, `elfeed-set-timeout` * New feed metadata: :canonical-url, :etag, :last-modified * New variable: `elfeed-log-level` * New database export option: `elfeed-csv-export` * Additional validation for `elfeed-feeds` ## 1.4.1 (2016-05-25) * Major bug fix: disable local variables when loading the index * New command `elfeed-show-play-enclosure` (requires emms) * Yank now works on regions in the search buffer * Feed structs now have author field filled out * New command `elfeed-search-set-feed-title` * New command `elfeed-search-set-entry-title` * Smarter handling of invalid timestamps * Following links in show mode (`elfeed-show-visit`) takes a prefix arg ## 1.4.0 (2015-12-22) * New header built on Emacs' built-in buffer headers * New hook: `elfeed-new-entry-parse-hook` * Emacs' bookmark support (`bookmark-set`, `bookmark-jump`) * Emacs' desktop support (save/restore windows) * Custom faces in search listing via `elfeed-search-face-alist` * Dedicated log buffer, *elfeed-log* * Scoped updates with prefix argument to `elfeed-search-fetch` * Various bug fixes * Fixes to feed Unicode decoding ## 1.3.0 (2015-11-20) * `elfeed-search-face-alist` for custom entry faces * `display-local-help` (C-h .) support in search * Fixes to #n count filter ## 1.2.0 (2015-10-05) * Switched to url-queue (see `url-queue-timeout`) * New #n filter for limiting results to first n entries * Faster live filtering * `elfeed-version` * Enclosure downloading * Database size optimizations * Search listing is more responsive to updates * `elfeed-http-error-hooks`, `elfeed-parse-error-hooks` * Various bug fixes ## 1.1.2 (2014-11-04) * Fixed support for non-HTTP protocols * Add ! search syntax * Add elfeed-unjam * Combine regexp search terms by AND instead of OR * Link navigation keybindings (tab) * Add elfeed-show-truncate-long-urls * Add elfeed-search-filter customization * Various bug fixes ## 1.1.1 (2014-06-14) * Fix database corruption issue * Properly handle URLs from XML * Slightly better RSS date guessing * User interface tweaks * Add `elfeed-sort-order` * Use tab and backtab to move between links ## 1.1.0 (2014-01-27) * Autotagging support * Better database performance * Database packing * Arbitrary struct metadata * Added `elfeed-search-clipboard-type` * Update to cl-lib from cl * Lots of bug fixes ## 1.0.1 (2013-09-08) * Live filter editing * Support for RSS 1.0 * OPML import/export * Fix multibyte support (thanks cellscape) * Fix date-change database corruption * Add n and p bindings to elfeed-search, like notmuch * Friendlier intro header * Automated builds * Lots of small bug fixes ## 1.0.0 (2013-09-02) * Initial release elfeed-3.3.0/elfeed.el0000644000175000017500000006712613566267252014373 0ustar dogslegdogsleg;;; elfeed.el --- an Emacs Atom/RSS feed reader -*- lexical-binding: t; -*- ;; This is free and unencumbered software released into the public domain. ;; Author: Christopher Wellons ;; URL: https://github.com/skeeto/elfeed ;;; Commentary: ;; Elfeed is a web feed client for Emacs, inspired by notmuch. See ;; the README for full documentation. ;; Notice: Before stamping a new release the following places need to ;; be updated: ;; * NEWS.md ;; * elfeed.el (`elfeed-version') ;; * elfeed-pkg.el ;; * web/elfeed-web-pkg.el ;; * Makefile (VERSION) ;;; Code: (require 'cl-lib) (require 'xml) (require 'xml-query) (require 'url-parse) (require 'url-queue) (require 'elfeed-db) (require 'elfeed-lib) (require 'elfeed-log) (require 'elfeed-curl) ;; Interface to elfeed-search (lazy required) (declare-function elfeed-search-buffer 'elfeed-search ()) (declare-function elfeed-search-mode 'elfeed-search ()) (defgroup elfeed () "An Emacs web feed reader." :group 'comm) (defconst elfeed-version "3.3.0") (defcustom elfeed-feeds () "List of all feeds that Elfeed should follow. You must add your feeds to this list. In its simplest form this will be a list of strings of feed URLs. Items in this list can also be list whose car is the feed URL and cdr is a list of symbols to be applied to all discovered entries as tags (\"autotags\"). For example, (setq elfeed-feeds '(\"http://foo/\" \"http://bar/\" (\"http://baz/\" comic))) All entries from the \"baz\" feed will be tagged as \"comic\" when they are first discovered." :group 'elfeed :type '(repeat (choice string (cons string (repeat symbol))))) (defcustom elfeed-feed-functions '(elfeed-get-link-at-point elfeed-get-url-at-point elfeed-clipboard-get) "List of functions to use to get possible feeds for `elfeed-add-feed'. Each function should accept no arguments, and return a string or nil." :group 'elfeed :type 'hook :options '(elfeed-get-link-at-point elfeed-get-url-at-point elfeed-clipboard-get)) (defcustom elfeed-use-curl (not (null (executable-find elfeed-curl-program-name))) "If non-nil, fetch feeds using curl instead of `url-retrieve'." :group 'elfeed :type 'boolean) (defcustom elfeed-user-agent (format "Emacs Elfeed %s" elfeed-version) "User agent string to use for Elfeed (requires `elfeed-use-curl')." :group 'elfeed :type 'string) (defcustom elfeed-initial-tags '(unread) "Initial tags for new entries." :group 'elfeed :type '(repeat symbol)) ;; Fetching: (defvar elfeed-http-error-hooks () "Hooks to run when an http connection error occurs. It is called with 2 arguments. The first argument is the url of the failing feed. The second argument is the http status code.") (defvar elfeed-parse-error-hooks () "Hooks to run when an error occurs during the parsing of a feed. It is called with 2 arguments. The first argument is the url of the failing feed. The second argument is the error message .") (defvar elfeed-update-hooks () "Hooks to run any time a feed update has completed a request. It is called with 1 argument: the URL of the feed that was just updated. The hook is called even when no new entries were found.") (defvar elfeed-update-init-hooks () "Hooks called when one or more feed updates have begun. Receivers may want to, say, update a display to indicate that updates are pending.") (defvar elfeed-tag-hooks () "Hooks called when one or more entries add tags. It is called with 2 arguments. The first argument is the entry list. The second argument is the tag list.") (defvar elfeed-untag-hooks () "Hooks called when one or more entries remove tags. It is called with 2 arguments. The first argument is the entry list. The second argument is the tag list.") (defvar elfeed--inhibit-update-init-hooks nil "When non-nil, don't run `elfeed-update-init-hooks'.") (defun elfeed-queue-count-active () "Return the number of items in process." (if elfeed-use-curl elfeed-curl-queue-active (cl-count-if #'url-queue-buffer url-queue))) (defun elfeed-queue-count-total () "Return the number of items in process." (if elfeed-use-curl (+ (length elfeed-curl-queue) elfeed-curl-queue-active) (length url-queue))) (defun elfeed-set-max-connections (n) "Limit the maximum number of concurrent connections to N." (if elfeed-use-curl (setf elfeed-curl-max-connections n) (setf url-queue-parallel-processes n))) (defun elfeed-get-max-connections () "Get the maximum number of concurrent connections." (if elfeed-use-curl elfeed-curl-max-connections url-queue-parallel-processes)) (defun elfeed-set-timeout (seconds) "Limit the time for fetching a feed to SECONDS." (if elfeed-use-curl (setf elfeed-curl-timeout seconds) (setf url-queue-timeout seconds))) (defun elfeed-get-timeout () "Get the time limit for fetching feeds in SECONDS." (if elfeed-use-curl elfeed-curl-timeout url-queue-timeout)) (defun elfeed-is-status-error (status use-curl) "Check if HTTP request returned status means a error." (or (and use-curl (null status)) ; nil = error (and (not use-curl) (eq (car status) :error)))) (defmacro elfeed-with-fetch (url &rest body) "Asynchronously run BODY in a buffer with the contents from URL. This macro is anaphoric, with STATUS referring to the status from `url-retrieve'/cURL and USE-CURL being the original invoked-value of `elfeed-use-curl'." (declare (indent defun)) `(let* ((use-curl elfeed-use-curl) ; capture current value in closure (cb (lambda (status) ,@body))) (if elfeed-use-curl (let* ((feed (elfeed-db-get-feed url)) (last-modified (elfeed-meta feed :last-modified)) (etag (elfeed-meta feed :etag)) (headers `(("User-Agent" . ,elfeed-user-agent)))) (when etag (push `("If-None-Match" . ,etag) headers)) (when last-modified (push `("If-Modified-Since" . ,last-modified) headers)) (elfeed-curl-enqueue ,url cb :headers headers)) (url-queue-retrieve ,url cb () t t)))) (defun elfeed-unjam () "Manually clear the connection pool when connections fail to timeout. This is a workaround for issues in `url-queue-retrieve'." (interactive) (if elfeed-use-curl (setf elfeed-curl-queue nil elfeed-curl-queue-active 0) (let ((fails (mapcar #'url-queue-url url-queue))) (when fails (elfeed-log 'warn "Elfeed aborted feeds: %s" (mapconcat #'identity fails " "))) (setf url-queue nil))) (run-hooks 'elfeed-update-init-hooks)) ;; Parsing: (defun elfeed-feed-type (content) "Return the feed type (:atom, :rss, :rss1.0) or nil for unknown." (let ((top (xml-query-strip-ns (caar content)))) (cadr (assoc top '((feed :atom) (rss :rss) (RDF :rss1.0)))))) (defun elfeed-generate-id (&optional content) "Generate an ID based on CONTENT or from the current time." (concat "urn:sha1:" (sha1 (format "%s" (or content (float-time)))))) (defun elfeed--atom-content (entry) "Get content string from ENTRY." (let ((content-type (xml-query* (content :type) entry))) (if (equal content-type "xhtml") (with-temp-buffer (let ((xhtml (cddr (xml-query* (content) entry)))) (dolist (element xhtml) (if (stringp element) (insert element) (elfeed-xml-unparse element)))) (buffer-string)) (let ((all-content (or (xml-query-all* (content *) entry) (xml-query-all* (summary *) entry)))) (when all-content (apply #'concat all-content)))))) (defvar elfeed-new-entry-parse-hook '() "Hook to be called after parsing a new entry. Take three arguments: the feed TYPE, the XML structure for the entry, and the Elfeed ENTRY object. Return value is ignored, and is called for side-effects on the ENTRY object.") (defsubst elfeed--fixup-protocol (protocol url) "Prepend PROTOCOL to URL if it is protocol-relative. If PROTOCOL is nil, returns URL." (if (and protocol url (string-match-p "^//[^/]" url)) (concat protocol ":" url) url)) (defsubst elfeed--atom-authors-to-plist (authors) "Parse list of author XML tags into list of plists." (let ((result ())) (dolist (author authors) (let ((plist ()) (name (xml-query* (name *) author)) (uri (xml-query* (uri *) author)) (email (xml-query* (email *) author))) (when email (setf plist (list :email (elfeed-cleanup email)))) (when uri (setf plist (nconc (list :uri (elfeed-cleanup uri)) plist))) (when name (setf plist (nconc (list :name (elfeed-cleanup name)) plist))) (push plist result))) (nreverse result))) (defsubst elfeed--creators-to-plist (creators) "Convert Dublin Core list of creators into an authors plist." (cl-loop for creator in creators collect (list :name creator))) (defun elfeed-entries-from-atom (url xml) "Turn parsed Atom content into a list of elfeed-entry structs." (let* ((feed-id url) (protocol (url-type (url-generic-parse-url url))) (namespace (elfeed-url-to-namespace url)) (feed (elfeed-db-get-feed feed-id)) (title (elfeed-cleanup (xml-query* (feed title *) xml))) (authors (xml-query-all* (feed author) xml)) (xml-base (or (xml-query* (feed :base) xml) url)) (autotags (elfeed-feed-autotags url))) (setf (elfeed-feed-url feed) url (elfeed-feed-title feed) title (elfeed-feed-author feed) (elfeed--atom-authors-to-plist authors)) (cl-loop for entry in (xml-query-all* (feed entry) xml) collect (let* ((title (or (xml-query* (title *) entry) "")) (xml-base (elfeed-update-location xml-base (xml-query* (:base) (list entry)))) (anylink (xml-query* (link :href) entry)) (altlink (xml-query* (link [rel "alternate"] :href) entry)) (link (elfeed--fixup-protocol protocol (elfeed-update-location xml-base (or altlink anylink)))) (date (or (xml-query* (published *) entry) (xml-query* (updated *) entry) (xml-query* (date *) entry) (xml-query* (modified *) entry) ; Atom 0.3 (xml-query* (issued *) entry))) ; Atom 0.3 (authors (nconc (elfeed--atom-authors-to-plist (xml-query-all* (author) entry)) ;; Dublin Core (elfeed--creators-to-plist (xml-query-all* (creator *) entry)))) (categories (xml-query-all* (category :term) entry)) (content (elfeed--atom-content entry)) (id (or (xml-query* (id *) entry) link (elfeed-generate-id content))) (type (or (xml-query* (content :type) entry) (xml-query* (summary :type) entry) "")) (tags (elfeed-normalize-tags autotags elfeed-initial-tags)) (content-type (if (string-match-p "html" type) 'html nil)) (etags (xml-query-all* (link [rel "enclosure"]) entry)) (enclosures (cl-loop for enclosure in etags for wrap = (list enclosure) for href = (xml-query* (:href) wrap) for type = (xml-query* (:type) wrap) for length = (xml-query* (:length) wrap) collect (list href type length))) (db-entry (elfeed-entry--create :title (elfeed-cleanup title) :feed-id feed-id :id (cons namespace (elfeed-cleanup id)) :link (elfeed-cleanup link) :tags tags :date (or (elfeed-float-time date) (float-time)) :content content :enclosures enclosures :content-type content-type :meta `(,@(when authors (list :authors authors)) ,@(when categories (list :categories categories)))))) (dolist (hook elfeed-new-entry-parse-hook) (funcall hook :atom entry db-entry)) db-entry)))) (defsubst elfeed--rss-author-to-plist (author) "Parse an RSS author element into an authors plist." (when author (let ((clean (elfeed-cleanup author))) (if (string-match "^\\(.*\\) (\\([^)]+\\))$" clean) (list (list :name (match-string 2 clean) :email (match-string 1 clean))) (list (list :email clean)))))) (defun elfeed-entries-from-rss (url xml) "Turn parsed RSS content into a list of elfeed-entry structs." (let* ((feed-id url) (protocol (url-type (url-generic-parse-url url))) (namespace (elfeed-url-to-namespace url)) (feed (elfeed-db-get-feed feed-id)) (title (elfeed-cleanup (xml-query* (rss channel title *) xml))) (autotags (elfeed-feed-autotags url))) (setf (elfeed-feed-url feed) url (elfeed-feed-title feed) title) (cl-loop for item in (xml-query-all* (rss channel item) xml) collect (let* ((title (or (xml-query* (title *) item) "")) (guid (xml-query* (guid *) item)) (link (elfeed--fixup-protocol protocol (or (xml-query* (link *) item) guid))) (date (or (xml-query* (pubDate *) item) (xml-query* (date *) item))) (authors (nconc (elfeed--rss-author-to-plist (xml-query* (author *) item)) ;; Dublin Core (elfeed--creators-to-plist (xml-query-all* (creator *) item)))) (categories (xml-query-all* (category *) item)) (content (or (xml-query-all* (encoded *) item) (xml-query-all* (description *) item))) (description (apply #'concat content)) (id (or guid link (elfeed-generate-id description))) (full-id (cons namespace (elfeed-cleanup id))) (original (elfeed-db-get-entry full-id)) (original-date (and original (elfeed-entry-date original))) (tags (elfeed-normalize-tags autotags elfeed-initial-tags)) (etags (xml-query-all* (enclosure) item)) (enclosures (cl-loop for enclosure in etags for wrap = (list enclosure) for url = (xml-query* (:url) wrap) for type = (xml-query* (:type) wrap) for length = (xml-query* (:length) wrap) collect (list url type length))) (db-entry (elfeed-entry--create :title (elfeed-cleanup title) :id full-id :feed-id feed-id :link (elfeed-cleanup link) :tags tags :date (elfeed-new-date-for-entry original-date date) :enclosures enclosures :content description :content-type 'html :meta `(,@(when authors (list :authors authors)) ,@(when categories (list :categories categories)))))) (dolist (hook elfeed-new-entry-parse-hook) (funcall hook :rss item db-entry)) db-entry)))) (defun elfeed-entries-from-rss1.0 (url xml) "Turn parsed RSS 1.0 content into a list of elfeed-entry structs." (let* ((feed-id url) (namespace (elfeed-url-to-namespace url)) (feed (elfeed-db-get-feed feed-id)) (title (elfeed-cleanup (xml-query* (RDF channel title *) xml))) (autotags (elfeed-feed-autotags url))) (setf (elfeed-feed-url feed) url (elfeed-feed-title feed) title) (cl-loop for item in (xml-query-all* (RDF item) xml) collect (let* ((title (or (xml-query* (title *) item) "")) (link (xml-query* (link *) item)) (date (or (xml-query* (pubDate *) item) (xml-query* (date *) item))) (description (apply #'concat (xml-query-all* (description *) item))) (id (or link (elfeed-generate-id description))) (full-id (cons namespace (elfeed-cleanup id))) (original (elfeed-db-get-entry full-id)) (original-date (and original (elfeed-entry-date original))) (tags (elfeed-normalize-tags autotags elfeed-initial-tags)) (db-entry (elfeed-entry--create :title (elfeed-cleanup title) :id full-id :feed-id feed-id :link (elfeed-cleanup link) :tags tags :date (elfeed-new-date-for-entry original-date date) :content description :content-type 'html))) (dolist (hook elfeed-new-entry-parse-hook) (funcall hook :rss1.0 item db-entry)) db-entry)))) (defun elfeed-feed-list () "Return a flat list version of `elfeed-feeds'. Only a list of strings will be returned." ;; Validate elfeed-feeds and fail early rather than asynchronously later. (dolist (feed elfeed-feeds) (unless (cl-typecase feed (list (and (stringp (car feed)) (cl-every #'symbolp (cdr feed)))) (string t)) (error "elfeed-feeds malformed, bad entry: %S" feed))) (cl-loop for feed in elfeed-feeds when (listp feed) collect (car feed) else collect feed)) (defun elfeed-feed-autotags (url-or-feed) "Return tags to automatically apply to all entries from URL-OR-FEED." (let ((url (if (elfeed-feed-p url-or-feed) (or (elfeed-feed-url url-or-feed) (elfeed-feed-id url-or-feed)) url-or-feed))) (mapcar #'elfeed-keyword->symbol (cdr (assoc url elfeed-feeds))))) (defun elfeed-apply-autotags-now () "Apply autotags to existing entries according to `elfeed-feeds'." (interactive) (with-elfeed-db-visit (entry feed) (apply #'elfeed-tag entry (elfeed-feed-autotags feed)))) (defun elfeed-handle-http-error (url status) "Handle an http error during retrieval of URL with STATUS code." (cl-incf (elfeed-meta (elfeed-db-get-feed url) :failures 0)) (run-hook-with-args 'elfeed-http-error-hooks url status) (elfeed-log 'error "%s: %S" url status)) (defun elfeed-handle-parse-error (url error) "Handle parse error during parsing of URL with ERROR message." (cl-incf (elfeed-meta (elfeed-db-get-feed url) :failures 0)) (run-hook-with-args 'elfeed-parse-error-hooks url error) (elfeed-log 'error "%s: %s" url error)) (defun elfeed-update-feed (url) "Update a specific feed." (interactive (list (completing-read "Feed: " (elfeed-feed-list)))) (unless elfeed--inhibit-update-init-hooks (run-hooks 'elfeed-update-init-hooks)) (elfeed-with-fetch url (if (elfeed-is-status-error status use-curl) (let ((print-escape-newlines t)) (elfeed-handle-http-error url (if use-curl elfeed-curl-error-message status))) (condition-case error (let ((feed (elfeed-db-get-feed url))) (unless use-curl (elfeed-move-to-first-empty-line) (set-buffer-multibyte t)) (unless (eql elfeed-curl-status-code 304) ;; Update Last-Modified and Etag (setf (elfeed-meta feed :last-modified) (cdr (assoc "last-modified" elfeed-curl-headers)) (elfeed-meta feed :etag) (cdr (assoc "etag" elfeed-curl-headers))) (if (equal url elfeed-curl-location) (setf (elfeed-meta feed :canonical-url) nil) (setf (elfeed-meta feed :canonical-url) elfeed-curl-location)) (let* ((xml (elfeed-xml-parse-region (point) (point-max))) (entries (cl-case (elfeed-feed-type xml) (:atom (elfeed-entries-from-atom url xml)) (:rss (elfeed-entries-from-rss url xml)) (:rss1.0 (elfeed-entries-from-rss1.0 url xml)) (otherwise (error (elfeed-handle-parse-error url "Unknown feed type.")))))) (elfeed-db-add entries)))) (error (elfeed-handle-parse-error url error)))) (unless use-curl (kill-buffer)) (run-hook-with-args 'elfeed-update-hooks url))) (defun elfeed-candidate-feeds () "Return a list of possible feeds from `elfeed-feed-functions'." (let (res) (run-hook-wrapped 'elfeed-feed-functions (lambda (fun) (let* ((val (elfeed-cleanup (funcall fun)))) (when (and (not (zerop (length val))) (elfeed-looks-like-url-p val)) (cl-pushnew val res :test #'equal))) nil)) (nreverse res))) (cl-defun elfeed-add-feed (url &key save) "Manually add a feed to the database. If SAVE is non-nil the new value of ‘elfeed-feeds’ is saved. When called interactively, SAVE is set to t." (interactive (list (let* ((feeds (elfeed-candidate-feeds)) (prompt (if feeds (concat "URL (default " (car feeds) "): ") "URL: ")) (input (read-from-minibuffer prompt nil nil nil nil feeds)) (result (elfeed-cleanup input))) (cond ((not (zerop (length result))) result) (feeds (car feeds)) ((user-error "No feed to add")))) :save t)) (cl-pushnew url elfeed-feeds :test #'equal) (when save (customize-save-variable 'elfeed-feeds elfeed-feeds)) (elfeed-update-feed url)) ;;;###autoload (defun elfeed-update () "Update all the feeds in `elfeed-feeds'." (interactive) (elfeed-log 'info "Elfeed update: %s" (format-time-string "%B %e %Y %H:%M:%S %Z")) (let ((elfeed--inhibit-update-init-hooks t)) (mapc #'elfeed-update-feed (elfeed--shuffle (elfeed-feed-list)))) (run-hooks 'elfeed-update-init-hooks) (elfeed-db-save)) ;;;###autoload (defun elfeed () "Enter elfeed." (interactive) (switch-to-buffer (elfeed-search-buffer)) (unless (eq major-mode 'elfeed-search-mode) (elfeed-search-mode))) ;; New entry filtering (cl-defun elfeed-make-tagger (&key feed-title feed-url entry-title entry-link after before add remove callback) "Create a function that adds or removes tags on matching entries. FEED-TITLE, FEED-URL, ENTRY-TITLE, and ENTRY-LINK are regular expressions or a list (not ), which indicates a negative match. AFTER and BEFORE are relative times (see `elfeed-time-duration'). Entries must match all provided expressions. If an entry matches, add tags ADD and remove tags REMOVE. Examples, (elfeed-make-tagger :feed-url \"youtube\\\\.com\" :add '(video youtube)) (elfeed-make-tagger :before \"1 week ago\" :remove 'unread) (elfeed-make-tagger :feed-url \"example\\\\.com\" :entry-title '(not \"something interesting\") :add 'junk) The returned function should be added to `elfeed-new-entry-hook'." (let ((after-time (and after (elfeed-time-duration after))) (before-time (and before (elfeed-time-duration before)))) (when (and add (symbolp add)) (setf add (list add))) (when (and remove (symbolp remove)) (setf remove (list remove))) (lambda (entry) (let ((feed (elfeed-entry-feed entry)) (date (elfeed-entry-date entry)) (case-fold-search t)) (cl-flet ((match (r s) (or (null r) (if (listp r) (not (string-match-p (cl-second r) s)) (string-match-p r s))))) (when (and (match feed-title (elfeed-feed-title feed)) (match feed-url (elfeed-feed-url feed)) (match entry-title (elfeed-entry-title entry)) (match entry-link (elfeed-entry-link entry)) (or (not after-time) (> date (- (float-time) after-time))) (or (not before-time) (< date (- (float-time) before-time)))) (when add (apply #'elfeed-tag entry add)) (when remove (apply #'elfeed-untag entry remove)) (when callback (funcall callback entry)) entry)))))) ;; OPML (defun elfeed--parse-opml (xml) "Parse XML (from `xml-parse-region') into `elfeed-feeds' list." (cl-loop for (tag attr . content) in (cl-remove-if-not #'listp xml) count tag into work-around-bug ; bug#15326 when (assoc 'xmlUrl attr) collect (cdr it) else append (elfeed--parse-opml content))) ;;;###autoload (defun elfeed-load-opml (file) "Load feeds from an OPML file into `elfeed-feeds'. When called interactively, the changes to `elfeed-feeds' are saved to your customization file." (interactive "fOPML file: ") (let* ((xml (xml-parse-file file)) (feeds (elfeed--parse-opml xml)) (full (append feeds elfeed-feeds))) (prog1 (setf elfeed-feeds (cl-delete-duplicates full :test #'string=)) (when (called-interactively-p 'any) (customize-save-variable 'elfeed-feeds elfeed-feeds) (elfeed-log 'notice "%d feeds loaded from %s" (length feeds) file))))) ;;;###autoload (defun elfeed-export-opml (file) "Export the current feed listing to OPML-formatted FILE." (interactive "FOutput OPML file: ") (with-temp-file file (let ((standard-output (current-buffer))) (princ "\n") (xml-print `((opml ((version . "1.0")) (head () (title () "Elfeed Export")) (body () ,@(cl-loop for url in (elfeed-feed-list) for feed = (elfeed-db-get-feed url) for title = (or (elfeed-feed-title feed) "") collect `(outline ((xmlUrl . ,url) (title . ,title))))))))))) (provide 'elfeed) (cl-eval-when (load eval) ;; run-time only, so don't load when compiling other files (unless byte-compile-root-dir (require 'elfeed-csv) (require 'elfeed-show) (require 'elfeed-search))) ;;; elfeed.el ends here elfeed-3.3.0/elfeed-link.el0000644000175000017500000000545113566267252015317 0ustar dogslegdogsleg;;; elfeed-link.el --- misc functions for elfeed -*- lexical-binding: t; -*- ;; This is free and unencumbered software released into the public domain. ;;; Commentary: ;; Code for integration with org-mode. ;; To use, add (require 'elfeed-link) somewhere in your configuration. ;;; Code: (require 'org) (require 'cl-lib) (require 'elfeed-db) (require 'elfeed-show) (require 'elfeed-search) ;;;###autoload (defun elfeed-link-store-link () "Store a link to an elfeed search or entry buffer. When storing a link to an entry, automatically extract all the entry metadata. These can be used in the capture templates as %:elfeed-entry-. See `elfeed-entry--create' for the list of available props." (cond ((derived-mode-p 'elfeed-search-mode) (org-store-link-props :type "elfeed" :link (format "elfeed:%s" elfeed-search-filter) :description elfeed-search-filter)) ((derived-mode-p 'elfeed-show-mode) (apply 'org-store-link-props :type "elfeed" :link (format "elfeed:%s#%s" (car (elfeed-entry-id elfeed-show-entry)) (cdr (elfeed-entry-id elfeed-show-entry))) :description (elfeed-entry-title elfeed-show-entry) (cl-loop for prop in (list 'id 'title 'link 'date 'content 'content-type 'enclosures 'tags 'feed-id 'meta) nconc (list (intern (concat ":elfeed-entry-" (symbol-name prop))) (funcall (intern (concat "elfeed-entry-" (symbol-name prop))) elfeed-show-entry))))))) ;;;###autoload (defun elfeed-link-open (filter-or-id) "Jump to an elfeed entry or search. Depending on what FILTER-OR-ID looks like, we jump to either search buffer or show a concrete entry." (if (string-match "\\([^#]+\\)#\\(.+\\)" filter-or-id) (elfeed-show-entry (elfeed-db-get-entry (cons (match-string 1 filter-or-id) (match-string 2 filter-or-id)))) (elfeed) (elfeed-search-set-filter filter-or-id))) ;;;###autoload (eval-after-load 'org `(funcall ;; The extra quote below is necessary because uncompiled closures ;; do not evaluate to themselves. The quote is harmless for ;; byte-compiled function objects. ',(lambda () (if (version< (org-version) "9.0") (with-no-warnings (org-add-link-type "elfeed" #'elfeed-link-open) (add-hook 'org-store-link-functions #'elfeed-link-store-link)) (with-no-warnings (org-link-set-parameters "elfeed" :follow #'elfeed-link-open :store #'elfeed-link-store-link)))))) (provide 'elfeed-link) ;;; elfeed-link.el ends here elfeed-3.3.0/elfeed-search.el0000644000175000017500000011042413566267252015624 0ustar dogslegdogsleg;;; elfeed-search.el --- list feed entries -*- lexical-binding: t; -*- ;; This is free and unencumbered software released into the public domain. ;;; Code: (require 'cl-lib) (require 'browse-url) (require 'wid-edit) ; widget-inactive face (require 'bookmark) (bookmark-maybe-load-default-file) (require 'elfeed) (require 'elfeed-db) (require 'elfeed-lib) ;; Interface to elfeed-show (lazy required) (declare-function elfeed-show-entry 'elfeed-show (entry)) (defvar elfeed-search-entries () "List of the entries currently on display.") (defvar elfeed-search-filter-history nil "Filter history for `completing-read'.") (defvar elfeed-search-last-update 0 "The last time the buffer was redrawn in epoch seconds.") (defvar elfeed-search-update-hook () "List of functions to run immediately following a search buffer update.") (defcustom elfeed-search-filter "@6-months-ago +unread" "Query string filtering shown entries." :group 'elfeed :type 'string) (defcustom elfeed-sort-order 'descending "The order in which entries should be displayed. Changing this from the default will lead to misleading results during live filter editing, but the results be will correct when live filter editing is exited. " :group 'elfeed :type '(choice (const descending) (const ascending))) (defcustom elfeed-search-sort-function nil "Sort predicate applied to the list of entries before display. This function must take two entries as arguments, an interface suitable as the predicate for `sort'. Changing this from the default will lead to misleading results during live filter editing, but the results be will correct when live filter editing is exited." :group 'elfeed :type '(choice function (const nil))) (defcustom elfeed-search-remain-on-entry nil "When non-nil, keep point at entry after performing a command. When nil, move to next entry." :group 'elfeed :type 'boolean) (defcustom elfeed-search-clipboard-type 'PRIMARY "Selects the clipboard `elfeed-search-yank' should use. Choices are the symbols PRIMARY, SECONDARY, or CLIPBOARD." :group 'elfeed :type '(choice (const PRIMARY) (const SECONDARY) (const CLIPBOARD))) (defcustom elfeed-search-date-format '("%Y-%m-%d" 10 :left) "The `format-time-string' format, target width, and alignment for dates. This should be (string integer keyword) for (format width alignment). Possible alignments are :left and :right." :group 'elfeed :type '(list string integer (choice (const :left) (const :right)))) (defcustom elfeed-search-compile-filter t "If non-nil, compile search filters into bytecode on the fly." :group 'elfeed :type 'boolean) (defvar elfeed-search-filter-active nil "When non-nil, Elfeed is currently reading a filter from the minibuffer. When live editing the filter, it is bound to :live.") (defvar elfeed-search-filter-overflowing nil "When non-nil, the current live filter overflows the window.") (defvar elfeed-search--offset 1 "Offset between line numbers and entry list position.") (defvar elfeed-search-header-function #'elfeed-search--header "Function that returns the string to be used for the Elfeed search header.") (defvar elfeed-search-print-entry-function #'elfeed-search-print-entry--default "Function to print entries into the *elfeed-search* buffer.") (defalias 'elfeed-search-tag-all-unread (elfeed-expose #'elfeed-search-tag-all 'unread) "Add the `unread' tag to all selected entries.") (defalias 'elfeed-search-untag-all-unread (elfeed-expose #'elfeed-search-untag-all 'unread) "Remove the `unread' tag from all selected entries.") (defalias 'elfeed-search-update--force (elfeed-expose #'elfeed-search-update :force) "Force refresh view of the feed listing.") (defun elfeed-search-quit-window () "Save the database, then `quit-window'." (interactive) (elfeed-db-save) (quit-window)) (defun elfeed-search-last-entry () "Place point on first entry." (interactive) (setf (point) (point-max)) (forward-line -2)) (defun elfeed-search-first-entry () "Place point on last entry." (interactive) (setf (point) (point-min))) (defvar elfeed-search-mode-map (let ((map (make-sparse-keymap))) (prog1 map (suppress-keymap map) (define-key map "h" #'describe-mode) (define-key map "q" #'elfeed-search-quit-window) (define-key map "g" #'elfeed-search-update--force) (define-key map "G" #'elfeed-search-fetch) (define-key map (kbd "RET") #'elfeed-search-show-entry) (define-key map "s" #'elfeed-search-live-filter) (define-key map "S" #'elfeed-search-set-filter) (define-key map "c" #'elfeed-search-clear-filter) (define-key map "b" #'elfeed-search-browse-url) (define-key map "y" #'elfeed-search-yank) (define-key map "u" #'elfeed-search-tag-all-unread) (define-key map "r" #'elfeed-search-untag-all-unread) (define-key map "n" #'next-line) (define-key map "p" #'previous-line) (define-key map "+" #'elfeed-search-tag-all) (define-key map "-" #'elfeed-search-untag-all) (define-key map "<" #'elfeed-search-first-entry) (define-key map ">" #'elfeed-search-last-entry))) "Keymap for elfeed-search-mode.") (defun elfeed-search--intro-header () "Return the header shown to new users." (with-temp-buffer (cl-flet ((button (f) (insert-button (symbol-name f) 'follow-link t 'action (lambda (_) (call-interactively f))))) (insert "Database empty. Use ") (button 'elfeed-add-feed) (insert ", or ") (button 'elfeed-load-opml) (insert ", or ") (button 'elfeed-update) (insert ".") (buffer-string)))) (defun elfeed-search--count-unread () "Count the number of entries and feeds being currently displayed." (if (and elfeed-search-filter-active elfeed-search-filter-overflowing) "?/?:?" (cl-loop with feeds = (make-hash-table :test 'equal) for entry in elfeed-search-entries for feed = (elfeed-entry-feed entry) for url = (elfeed-feed-url feed) count entry into entry-count count (elfeed-tagged-p 'unread entry) into unread-count do (puthash url t feeds) finally (cl-return (format "%d/%d:%d" unread-count entry-count (hash-table-count feeds)))))) (defvar elfeed-search--header-cache nil "Cache of the last computed header.") (defun elfeed-search--header () "Returns the string to be used as the Elfeed header." (if (eql (car elfeed-search--header-cache) (buffer-modified-tick)) (cdr elfeed-search--header-cache) (let* ((header (elfeed-search--header-1)) (cache (cons (buffer-modified-tick) header))) (prog1 header (setf elfeed-search--header-cache cache))))) (defun elfeed-search--header-1 () "Computes the string to be used as the Elfeed header." (cond ((zerop (elfeed-db-last-update)) (elfeed-search--intro-header)) ((> (elfeed-queue-count-total) 0) (let ((total (elfeed-queue-count-total)) (in-process (elfeed-queue-count-active))) (format "%d jobs pending, %d active..." (- total in-process) in-process))) ((let* ((db-time (seconds-to-time (elfeed-db-last-update))) (update (format-time-string "%Y-%m-%d %H:%M" db-time)) (unread (elfeed-search--count-unread))) (format "Updated %s, %s%s" (propertize update 'face 'elfeed-search-last-update-face) (propertize unread 'face 'elfeed-search-unread-count-face) (cond (elfeed-search-filter-active "") ((string-match-p "[^ ]" elfeed-search-filter) (concat ", " (propertize elfeed-search-filter 'face 'elfeed-search-filter-face))) (""))))))) (defun elfeed-search-mode () "Major mode for listing elfeed feed entries. \\{elfeed-search-mode-map}" (interactive) (kill-all-local-variables) (use-local-map elfeed-search-mode-map) (setq major-mode 'elfeed-search-mode mode-name "elfeed-search" truncate-lines t buffer-read-only t desktop-save-buffer #'elfeed-search-desktop-save header-line-format '(:eval (funcall elfeed-search-header-function))) (set (make-local-variable 'bookmark-make-record-function) #'elfeed-search-bookmark-make-record) (buffer-disable-undo) (hl-line-mode) (make-local-variable 'elfeed-search-entries) (make-local-variable 'elfeed-search-filter) (add-hook 'elfeed-update-hooks #'elfeed-search-update) (add-hook 'elfeed-update-init-hooks #'elfeed-search-update--force) (add-hook 'kill-buffer-hook #'elfeed-db-save t t) (add-hook 'elfeed-db-unload-hook #'elfeed-search--unload) (elfeed-search-update :force) (run-mode-hooks 'elfeed-search-mode-hook)) (defun elfeed-search-buffer () (get-buffer-create "*elfeed-search*")) (defun elfeed-search--unload () "Hook function for `elfeed-db-unload-hook'." (with-current-buffer (elfeed-search-buffer) ;; don't try to save the database in this case (remove-hook 'kill-buffer-hook #'elfeed-db-save t) (kill-buffer ))) (defun elfeed-search-format-date (date) "Format a date for printing in `elfeed-search-mode'. The customization `elfeed-search-date-format' sets the formatting." (cl-destructuring-bind (format target alignment) elfeed-search-date-format (let* ((string (format-time-string format (seconds-to-time date))) (width (string-width string))) (cond ((> width target) (if (eq alignment :left) (substring string 0 target) (substring string (- width target) width))) ((< width target) (let ((pad (make-string (- target width) ?\s))) (if (eq alignment :left) (concat string pad) (concat pad string)))) (string))))) (defface elfeed-search-date-face '((((class color) (background light)) (:foreground "#aaa")) (((class color) (background dark)) (:foreground "#77a"))) "Face used in search mode for dates." :group 'elfeed) (defface elfeed-search-title-face '((((class color) (background light)) (:foreground "#000")) (((class color) (background dark)) (:foreground "#fff"))) "Face used in search mode for titles." :group 'elfeed) (defface elfeed-search-unread-title-face '((t :weight bold)) "Face used in search mode for unread entry titles." :group 'elfeed) (defface elfeed-search-feed-face '((((class color) (background light)) (:foreground "#aa0")) (((class color) (background dark)) (:foreground "#ff0"))) "Face used in search mode for feed titles." :group 'elfeed) (defface elfeed-search-tag-face '((((class color) (background light)) (:foreground "#070")) (((class color) (background dark)) (:foreground "#0f0"))) "Face used in search mode for tags." :group 'elfeed) (defface elfeed-search-last-update-face '((t)) "Face for showing the date and time the database was last updated." :group 'elfeed) (defface elfeed-search-unread-count-face '((((class color) (background light)) (:foreground "#000")) (((class color) (background dark)) (:foreground "#fff"))) "Face used in search mode for unread entry titles." :group 'elfeed) (defface elfeed-search-filter-face '((t :inherit mode-line-buffer-id)) "Face for showing the current Elfeed search filter." :group 'elfeed) (defcustom elfeed-search-title-max-width 70 "Maximum column width for titles in the elfeed-search buffer." :group 'elfeed :type 'integer) (defcustom elfeed-search-title-min-width 16 "Minimum column width for titles in the elfeed-search buffer." :group 'elfeed :type 'integer) (defcustom elfeed-search-trailing-width 30 "Space reserved for displaying the feed and tag information." :group 'elfeed :type 'integer) (defcustom elfeed-search-face-alist '((unread elfeed-search-unread-title-face)) "Mapping of tags to faces in the Elfeed entry listing." :group 'elfeed :type '(alist :key-type symbol :value-type (repeat face))) (defun elfeed-search--faces (tags) "Return all the faces that apply to an entry with TAGS." (nconc (cl-loop for (tag . faces) in elfeed-search-face-alist when (memq tag tags) append faces) (list 'elfeed-search-title-face))) (defun elfeed-search-print-entry--default (entry) "Print ENTRY to the buffer." (let* ((date (elfeed-search-format-date (elfeed-entry-date entry))) (title (or (elfeed-meta entry :title) (elfeed-entry-title entry) "")) (title-faces (elfeed-search--faces (elfeed-entry-tags entry))) (feed (elfeed-entry-feed entry)) (feed-title (when feed (or (elfeed-meta feed :title) (elfeed-feed-title feed)))) (tags (mapcar #'symbol-name (elfeed-entry-tags entry))) (tags-str (mapconcat (lambda (s) (propertize s 'face 'elfeed-search-tag-face)) tags ",")) (title-width (- (window-width) 10 elfeed-search-trailing-width)) (title-column (elfeed-format-column title (elfeed-clamp elfeed-search-title-min-width title-width elfeed-search-title-max-width) :left))) (insert (propertize date 'face 'elfeed-search-date-face) " ") (insert (propertize title-column 'face title-faces 'kbd-help title) " ") (when feed-title (insert (propertize feed-title 'face 'elfeed-search-feed-face) " ")) (when tags (insert "(" tags-str ")")))) (defun elfeed-search-parse-filter (filter) "Parse the elements of a search filter into a plist." (let ((must-have ()) (must-not-have ()) (before nil) (after nil) (matches ()) (not-matches ()) (limit nil) (feeds ())) (cl-loop for element in (split-string filter) for type = (aref element 0) do (cl-case type (?+ (let ((symbol (intern (substring element 1)))) (unless (eq '## symbol) (push symbol must-have)))) (?- (let ((symbol (intern (substring element 1)))) (unless (eq '## symbol) (push symbol must-not-have)))) (?@ (cl-multiple-value-bind (a b) (split-string (substring element 1) "--") (let ((duration-a (elfeed-time-duration a)) (duration-b (and b (elfeed-time-duration b)))) (when (and duration-b (> duration-b duration-a)) (cl-rotatef duration-a duration-b)) (when duration-b (setf before duration-b)) (setf after duration-a)))) (?! (let ((re (substring element 1))) (when (elfeed-valid-regexp-p re) (push re not-matches)))) (?# (setf limit (string-to-number (substring element 1)))) (?= (let ((re (substring element 1))) (when (elfeed-valid-regexp-p re) (push re feeds)))) (otherwise (when (elfeed-valid-regexp-p element) (push element matches))))) `(,@(when before (list :before before)) ,@(when after (list :after after)) ,@(when must-have (list :must-have must-have)) ,@(when must-not-have (list :must-not-have must-not-have)) ,@(when matches (list :matches matches)) ,@(when not-matches (list :not-matches not-matches)) ,@(when limit (list :limit limit)) ,@(when feeds (list :feeds feeds))))) (defun elfeed-search--recover-time (seconds) "Pick a reasonable filter representation for SECONDS." (let ((units '((60 1 "minute") (60 1 "hour") (24 1 "day") (7 1 "week") (30 7 "month") (1461 120 "year"))) (value (float seconds)) (name "second")) (cl-loop for (n d unit) in units for next-value = (/ (* value d) n) when (< next-value 1.0) return t do (setf name unit value next-value)) (let ((count (format "%.4g" value))) (format "%s-%s%s-ago" count name (if (equal count "1") "" "s"))))) (defun elfeed-search--recover-units (after-seconds &optional before-seconds) "Stringify the age or optionally the date range specified by AFTER-SECONDS and BEFORE-SECONDS." (apply 'concat "@" (elfeed-search--recover-time after-seconds) (when before-seconds (list "--"(elfeed-search--recover-time before-seconds))))) (defun elfeed-search-unparse-filter (filter) "Inverse of `elfeed-search-parse-filter', returning a string. The time (@n-units-ago) filter may not exactly match the original, but will be equal in its effect." (let ((output ())) (let ((after (plist-get filter :after)) (before (plist-get filter :before)) (must-have (plist-get filter :must-have)) (must-not-have (plist-get filter :must-not-have)) (matches (plist-get filter :matches)) (not-matches (plist-get filter :not-matches)) (limit (plist-get filter :limit)) (feeds (plist-get filter :feeds))) (when after (push (elfeed-search--recover-units after before) output)) (dolist (tag must-have) (push (format "+%S" tag) output)) (dolist (tag must-not-have) (push (format "-%S" tag) output)) (dolist (re matches) (push re output)) (dolist (re not-matches) (push (concat "!" re) output)) (when limit (push (format "#%d" limit) output)) (dolist (feed feeds) (push (format "=%s" feed) output)) (mapconcat #'identity (nreverse output) " ")))) (defun elfeed-search-filter (filter entry feed &optional count) "Return non-nil if ENTRY and FEED pass FILTER. COUNT is the total number of entries collected so far, for filtering against a limit filter (ex. #10). See `elfeed-search-set-filter' for format/syntax documentation. This function must *only* be called within the body of `with-elfeed-db-visit' because it may perform a non-local exit." (let ((after (plist-get filter :after)) (must-have (plist-get filter :must-have)) (must-not-have (plist-get filter :must-not-have)) (matches (plist-get filter :matches)) (not-matches (plist-get filter :not-matches)) (limit (plist-get filter :limit)) (feeds (plist-get filter :feeds))) (let* ((tags (elfeed-entry-tags entry)) (date (elfeed-entry-date entry)) (age (- (float-time) date)) (title (or (elfeed-meta entry :title) (elfeed-entry-title entry))) (link (elfeed-entry-link entry)) (feed-title (or (elfeed-meta feed :title) (elfeed-feed-title feed) "")) (feed-id (elfeed-feed-id feed))) (when (or (and after (> age after)) (and limit (<= limit 0)) (and limit count (>= count limit))) (elfeed-db-return)) (and (cl-every (lambda (tag) (memq tag tags)) must-have) (cl-notany (lambda (tag) (memq tag tags)) must-not-have) (or (null matches) (cl-every (lambda (m) (or (and title (string-match-p m title)) (and link (string-match-p m link)))) matches)) (cl-notany (lambda (m) (or (and title (string-match-p m title)) (and link (string-match-p m link)))) not-matches) (or (null feeds) (cl-some (lambda (f) (or (string-match-p f feed-id) (string-match-p f feed-title))) feeds)))))) (defun elfeed-search-compile-filter (filter) "Compile FILTER into a lambda function for `byte-compile'. Executing a filter in bytecode form is generally faster than \"interpreting\" the filter with `elfeed-search-filter'." (let ((after (plist-get filter :after)) (before (plist-get filter :before)) (must-have (plist-get filter :must-have)) (must-not-have (plist-get filter :must-not-have)) (matches (plist-get filter :matches)) (not-matches (plist-get filter :not-matches)) (limit (plist-get filter :limit)) (feeds (plist-get filter :feeds))) `(lambda (,(if (or after matches not-matches must-have must-not-have) 'entry '_entry) ,(if feeds 'feed '_feed) ,(if limit 'count '_count)) (let* (,@(when after '((date (elfeed-entry-date entry)) (age (- (float-time) date)))) ,@(when (or must-have must-not-have) '((tags (elfeed-entry-tags entry)))) ,@(when (or matches not-matches) '((title (or (elfeed-meta entry :title) (elfeed-entry-title entry))) (link (elfeed-entry-link entry)))) ,@(when feeds '((feed-id (elfeed-feed-id feed)) (feed-title (or (elfeed-meta feed :title) (elfeed-feed-title feed) ""))))) ,@(when after `((when (> age ,after) (elfeed-db-return)))) ,@(when limit `((when (>= count ,limit) (elfeed-db-return)))) (and ,@(cl-loop for forbid in must-not-have collect `(not (memq ',forbid tags))) ,@(cl-loop for forbid in must-have collect `(memq ',forbid tags)) ,@(cl-loop for regex in matches collect `(or (string-match-p ,regex title) (string-match-p ,regex link))) ,@(cl-loop for regex in not-matches collect `(not (or (string-match-p ,regex title) (string-match-p ,regex link)))) ,@(when feeds `((or ,@(cl-loop for regex in feeds collect `(string-match-p ,regex feed-id) collect `(string-match-p ,regex feed-title))))) ,@(when before `((> age ,before)))))))) (defun elfeed-search--prompt (current) "Prompt for a new filter, starting with CURRENT." (read-from-minibuffer "Filter: " (if (or (string= "" current) (string-match-p " $" current)) current (concat current " ")) nil nil 'elfeed-search-filter-history)) (defun elfeed-search-clear-filter () "Reset the search filter to the default value of `elfeed-search-filter'." (interactive) (setf elfeed-search-filter (default-value 'elfeed-search-filter)) (elfeed-search-update--force)) (defun elfeed-search-set-filter (new-filter) "Set a new search filter for the elfeed-search buffer. When NEW-FILTER is nil, reset the filter to the default value. When given a prefix argument, the current filter is not displayed in the minibuffer when prompting for a new filter. Any component beginning with a + or - is treated as a tag. If + the tag must be present on the entry. If - the tag must *not* be present on the entry. Ex. \"+unread\" or \"+unread -comic\". Any component beginning with an @ is an age limit or an age range. If a limit, no posts older than this are allowed. If a range, posts dates have to be inbetween the specified date range. Examples: - \"@3-days-ago\" - \"@1-year-old\" - \"@2019-06-24\" - \"@2019-06-24--2019-06-24\" - \"@5-days-ago--1-day-ago\" Any component beginning with a # is an entry count maximum. The number following # determines the maxiumum number of entries to be shown (descending by date). Ex. \"#20\" or \"#100\". Any component beginning with a = is a regular expression matching the entry's feed (title or URL). Only entries belonging to a feed that match at least one of the = expressions will be shown. Every other space-seperated element is treated like a regular expression, matching against entry link, title, and feed title." (interactive (let ((elfeed-search-filter-active :non-interactive)) (list (elfeed-search--prompt (if current-prefix-arg "" elfeed-search-filter))))) (with-current-buffer (elfeed-search-buffer) (setf elfeed-search-filter (or new-filter (default-value 'elfeed-search-filter))) (elfeed-search-update :force))) (defun elfeed-search--update-list () "Update `elfeed-search-filter' list." (let* ((filter (elfeed-search-parse-filter elfeed-search-filter)) (head (list nil)) (tail head) (count 0)) (if elfeed-search-compile-filter ;; Force lexical bindings regardless of the current ;; buffer-local value. Lexical scope uses the faster ;; stack-ref opcode instead of the traditional varref opcode. (let ((lexical-binding t) (func (byte-compile (elfeed-search-compile-filter filter)))) (with-elfeed-db-visit (entry feed) (when (funcall func entry feed count) (setf (cdr tail) (list entry) tail (cdr tail) count (1+ count))))) (with-elfeed-db-visit (entry feed) (when (elfeed-search-filter filter entry feed count) (setf (cdr tail) (list entry) tail (cdr tail) count (1+ count))))) ;; Determine the final list order (let ((entries (cdr head))) (when elfeed-search-sort-function (setf entries (sort entries elfeed-search-sort-function))) (when (eq elfeed-sort-order 'ascending) (setf entries (nreverse entries))) (setf elfeed-search-entries entries)))) (defmacro elfeed-save-excursion (&rest body) "Like `save-excursion', but by entry/line/column instead of point." (declare (indent defun)) `(let ((entry (elfeed-search-selected :single)) (line (line-number-at-pos)) (column (current-column))) (unwind-protect (progn ,@body) (let ((entry-position (cl-position entry elfeed-search-entries))) (elfeed-goto-line (if entry-position (+ elfeed-search--offset entry-position) line)) (move-to-column column))))) (defun elfeed-search-update (&optional force) "Update the elfeed-search buffer listing to match the database. When FORCE is non-nil, redraw even when the database hasn't changed." (interactive) (with-current-buffer (elfeed-search-buffer) (when (or force (and (not elfeed-search-filter-active) (< elfeed-search-last-update (elfeed-db-last-update)))) (elfeed-save-excursion (let ((inhibit-read-only t) (standard-output (current-buffer))) (erase-buffer) (elfeed-search--update-list) (dolist (entry elfeed-search-entries) (funcall elfeed-search-print-entry-function entry) (insert "\n")) (insert "End of entries.\n") (setf elfeed-search-last-update (float-time)))) (run-hooks 'elfeed-search-update-hook)))) (defun elfeed-search-fetch (prefix) "Update all feeds via `elfeed-update', or only visible feeds with PREFIX. Given a prefix, this function becomes `elfeed-search-fetch-visible'." (interactive "P") (if prefix (elfeed-search-fetch-visible) (elfeed-update))) (defun elfeed-search-fetch-visible () "Update any feed with an entry currently displayed in the search buffer." (interactive) (cl-loop with seen = (make-hash-table :test 'equal) for entry in elfeed-search-entries for feed = (elfeed-entry-feed entry) for url = (elfeed-feed-url feed) when (not (gethash url seen)) do (elfeed-update-feed (setf (gethash url seen) url)))) (defun elfeed-search-update-line (&optional n) "Redraw the current line." (let ((inhibit-read-only t)) (save-excursion (when n (elfeed-goto-line n)) (let ((entry (elfeed-search-selected :ignore-region))) (when entry (elfeed-kill-line) (funcall elfeed-search-print-entry-function entry)))))) (defun elfeed-search-update-entry (entry) "Redraw a specific entry." (let ((n (cl-position entry elfeed-search-entries))) (when n (elfeed-search-update-line (+ elfeed-search--offset n))))) (defun elfeed-search-selected (&optional ignore-region-p) "Return a list of the currently selected feeds. If IGNORE-REGION-P is non-nil, only return the entry under point." (let ((use-region (and (not ignore-region-p) (use-region-p)))) (let ((start (if use-region (region-beginning) (point))) (end (if use-region (region-end) (point)))) (cl-loop for line from (line-number-at-pos start) to (line-number-at-pos end) for offset = (- line elfeed-search--offset) when (and (>= offset 0) (nth offset elfeed-search-entries)) collect it into selected finally (return (if ignore-region-p (car selected) selected)))))) (defun elfeed-search-browse-url (&optional use-generic-p) "Visit the current entry in your browser using `browse-url'. If there is a prefix argument, visit the current entry in the browser defined by `browse-url-generic-program'." (interactive "P") (let ((entries (elfeed-search-selected))) (cl-loop for entry in entries do (elfeed-untag entry 'unread) when (elfeed-entry-link entry) do (if use-generic-p (browse-url-generic it) (browse-url it))) (mapc #'elfeed-search-update-entry entries) (unless (or elfeed-search-remain-on-entry (use-region-p)) (forward-line)))) (defun elfeed-search-yank () "Copy the selected feed items to clipboard and kill-ring." (interactive) (let* ((entries (elfeed-search-selected)) (links (mapcar #'elfeed-entry-link entries)) (links-str (mapconcat #'identity links " "))) (when entries (elfeed-untag entries 'unread) (kill-new links-str) (if (fboundp 'gui-set-selection) (gui-set-selection elfeed-search-clipboard-type links-str) (with-no-warnings (x-set-selection elfeed-search-clipboard-type links-str))) (message "Copied: %s" links-str) (mapc #'elfeed-search-update-entry entries) (unless (or elfeed-search-remain-on-entry (use-region-p)) (forward-line))))) (defun elfeed-search-tag-all (tag) "Apply TAG to all selected entries." (interactive (list (intern (read-from-minibuffer "Tag: ")))) (let ((entries (elfeed-search-selected))) (elfeed-tag entries tag) (mapc #'elfeed-search-update-entry entries) (unless (or elfeed-search-remain-on-entry (use-region-p)) (forward-line)))) (defun elfeed-search-untag-all (tag) "Remove TAG from all selected entries." (interactive (list (intern (read-from-minibuffer "Tag: ")))) (let ((entries (elfeed-search-selected))) (elfeed-untag entries tag) (mapc #'elfeed-search-update-entry entries) (unless (or elfeed-search-remain-on-entry (use-region-p)) (forward-line)))) (defun elfeed-search-toggle-all (tag) "Toggle TAG on all selected entries." (interactive (list (intern (read-from-minibuffer "Tag: ")))) (let ((entries (elfeed-search-selected)) entries-tag entries-untag) (cl-loop for entry in entries when (elfeed-tagged-p tag entry) do (push entry entries-untag) else do (push entry entries-tag)) (elfeed-tag entries-tag tag) (elfeed-untag entries-untag tag) (mapc #'elfeed-search-update-entry entries) (unless (or elfeed-search-remain-on-entry (use-region-p)) (forward-line)))) (defun elfeed-search-show-entry (entry) "Display the currently selected item in a buffer." (interactive (list (elfeed-search-selected :ignore-region))) (require 'elfeed-show) (when (elfeed-entry-p entry) (elfeed-untag entry 'unread) (elfeed-search-update-entry entry) (unless elfeed-search-remain-on-entry (forward-line)) (elfeed-show-entry entry))) (defun elfeed-search-set-entry-title (title) "Manually set the title for the entry under point. Sets the :title key of the entry's metadata. See `elfeed-meta'." (interactive "sTitle: ") (let ((entry (elfeed-search-selected :ignore-region))) (unless entry (error "No entry selected!")) (setf (elfeed-meta entry :title) title) (elfeed-search-update-entry entry))) (defun elfeed-search-set-feed-title (title) "Manually set the title for the feed belonging to the entry under point. Sets the :title key of the feed's metadata. See `elfeed-meta'." (interactive "sTitle: ") (let ((entry (elfeed-search-selected :ignore-region))) (unless entry (error "No entry selected!")) (let ((feed (elfeed-entry-feed entry))) (setf (elfeed-meta feed :title) title) (dolist (to-fix elfeed-search-entries) (elfeed-search-update-entry to-fix))))) ;; Live Filters (defvar elfeed-search-filter-syntax-table (let ((table (make-syntax-table))) (prog1 table (modify-syntax-entry ?+ "w" table) (modify-syntax-entry ?- "w" table) (modify-syntax-entry ?= "w" table) (modify-syntax-entry ?@ "w" table))) "Syntax table active when editing the filter in the minibuffer.") (defun elfeed-search--minibuffer-setup () "Set up the minibuffer for live filtering." (when elfeed-search-filter-active (set-syntax-table elfeed-search-filter-syntax-table) (when (eq :live elfeed-search-filter-active) (add-hook 'post-command-hook 'elfeed-search--live-update nil :local)))) (add-hook 'minibuffer-setup-hook 'elfeed-search--minibuffer-setup) (defun elfeed-search--live-update () "Update the elfeed-search buffer based on the contents of the minibuffer." (when (eq :live elfeed-search-filter-active) (let ((buffer (elfeed-search-buffer)) (current-filter (minibuffer-contents-no-properties))) (when buffer (with-current-buffer buffer (let* ((window (get-buffer-window (elfeed-search-buffer))) (height (window-total-height window)) (limiter (if window (format "#%d " height) "#1 ")) (elfeed-search-filter (concat limiter current-filter))) (elfeed-search-update :force) (setf elfeed-search-filter-overflowing (= (length elfeed-search-entries) height)))))))) (defun elfeed-search-live-filter () "Filter the elfeed-search buffer as the filter is written." (interactive) (unwind-protect (let ((elfeed-search-filter-active :live)) (setq elfeed-search-filter (read-from-minibuffer "Filter: " elfeed-search-filter))) (elfeed-search-update :force))) ;; Bookmarks ;;;###autoload (defun elfeed-search-bookmark-handler (record) "Jump to an elfeed-search bookmarked location." (elfeed) (elfeed-search-set-filter (bookmark-prop-get record 'location))) (defun elfeed-search-bookmark-make-record () "Return a bookmark record for the current elfeed-search buffer." (let* ((filter (elfeed-search-parse-filter elfeed-search-filter)) (tags (plist-get filter :must-have))) `(,(format "elfeed %s" elfeed-search-filter) (location . ,elfeed-search-filter) (tags ,@(mapcar #'symbol-name tags)) (handler . elfeed-search-bookmark-handler)))) ;; Desktop Save (defun elfeed-search-desktop-save (_desktop-dirname) "Save the state of the current elfeed-search buffer so that it may be restored as part of a saved desktop. Also save the state of the db for when `desktop-auto-save-timeout' is enabled." (elfeed-db-save) elfeed-search-filter) ;;;###autoload (defun elfeed-search-desktop-restore (_file-name _buffer-name search-filter) "Restore the state of an elfeed-search buffer on desktop restore." (elfeed) (elfeed-search-set-filter search-filter) (current-buffer)) ;;;###autoload (add-to-list 'desktop-buffer-mode-handlers '(elfeed-search-mode . elfeed-search-desktop-restore)) (provide 'elfeed-search) ;;; elfeed-search.el ends here elfeed-3.3.0/elfeed-lib.el0000644000175000017500000003404013566267252015124 0ustar dogslegdogsleg;;; elfeed-lib.el --- misc functions for elfeed -*- lexical-binding: t; -*- ;; This is free and unencumbered software released into the public domain. ;;; Commentary: ;; These are general functions that aren't specific to web feeds. It's ;; a library of useful functions to Elfeed. ;;; Code: (require 'xml) (require 'cl-lib) (require 'time-date) (require 'url-parse) (require 'url-util) (defun elfeed-expose (function &rest args) "Return an interactive version of FUNCTION, 'exposing' it to the user." (lambda () (interactive) (apply function args))) (defun elfeed-goto-line (n) "Like `goto-line' but for non-interactive use." (goto-char (point-min)) (forward-line (1- n))) (defun elfeed-kill-buffer () "Kill the current buffer." (interactive) (kill-buffer (current-buffer))) (defun elfeed-kill-line () "Clear out the current line without touching anything else." (beginning-of-line) (let ((start (point))) (end-of-line) (delete-region start (point)))) (defun elfeed-time-duration (time &optional now) "Turn a time expression into a number of seconds. Uses `timer-duration' but allows a bit more flair. If `now' is non-nil, use it as the current time (`float-time'). This is mostly useful for testing." (cond ((numberp time) time) ((let ((iso-time (elfeed-parse-simple-iso-8601 time))) (when iso-time (- (or now (float-time)) iso-time)))) ((string-match-p "[[:alpha:]]" time) (let* ((clean (replace-regexp-in-string "\\(ago\\|old\\|-\\)" " " time)) (duration (timer-duration clean))) ;; convert to float since float-time is used elsewhere (when duration (float duration)))))) (defun elfeed-looks-like-url-p (string) "Return true if STRING looks like it could be a URL." (and (stringp string) (not (string-match-p "[ \n\t\r]" string)) (not (null (url-type (url-generic-parse-url string)))))) (defun elfeed-format-column (string width &optional align) "Return STRING truncated or padded to WIDTH following ALIGNment. Align should be a keyword :left or :right." (if (<= width 0) "" (format (format "%%%s%d.%ds" (if (eq align :left) "-" "") width width) string))) (defun elfeed-clamp (min value max) "Clamp a value between two values." (min max (max min value))) (defun elfeed-valid-regexp-p (regexp) "Return t if REGEXP is a valid REGEXP." (ignore-errors (prog1 t (string-match-p regexp "")))) (defun elfeed-cleanup (name) "Trim trailing and leading spaces and collapse multiple spaces." (let ((trim (replace-regexp-in-string "[\f\n\r\t\v ]+" " " (or name "")))) (replace-regexp-in-string "^ +\\| +$" "" trim))) (defun elfeed-parse-simple-iso-8601 (string) "Attempt to parse STRING as a simply formatted ISO 8601 date. Examples: 2015-02-22, 2015-02, 20150222" (let* ((re (cl-flet ((re-numbers (num) (format "\\([0-9]\\{%s\\}\\)" num))) (format "^%s-?%s-?%s?\\(T%s:%s:?%s?\\)?" (re-numbers 4) (re-numbers 2) (re-numbers 2) (re-numbers 2) (re-numbers 2) (re-numbers 2)))) (matches (save-match-data (when (string-match re string) (cl-loop for i from 1 to 7 collect (let ((match (match-string i string))) (and match (string-to-number match)))))))) (when matches (cl-multiple-value-bind (year month day _ hour min sec) matches (float-time (encode-time (or sec 0) (or min 0) (or hour 0) (or day 1) month year t)))))) (defun elfeed-new-date-for-entry (old-date new-date) "Decide entry date, given an existing date (nil for new) and a new date. Existing entries' dates are unchanged if the new date is not parseable. New entries with unparseable dates default to the current time." (or (elfeed-float-time new-date) old-date (float-time))) (defun elfeed-float-time (date) "Like `float-time' but accept anything reasonable for DATE. Defaults to nil if DATE could not be parsed. Date is allowed to be relative to now (`elfeed-time-duration')." (cl-typecase date (string (let ((iso-8601 (elfeed-parse-simple-iso-8601 date))) (if iso-8601 iso-8601 (let ((duration (elfeed-time-duration date))) (if duration (- (float-time) duration) (let ((time (ignore-errors (date-to-time date)))) ;; check if date-to-time failed, silently or otherwise (unless (or (null time) (equal time '(14445 17280))) (float-time time)))))))) (integer date) (otherwise nil))) (defun elfeed-xml-parse-region (&optional beg end buffer parse-dtd _parse-ns) "Decode (if needed) and parse XML file. Uses coding system from XML encoding declaration." (unless beg (setq beg (point-min))) (unless end (setq end (point-max))) (setf (point) beg) (when (re-search-forward "<\\?xml.*?encoding=[\"']\\([^\"']+\\)[\"'].*?\\?>" nil t) (let ((coding-system (intern-soft (downcase (match-string 1))))) (when (ignore-errors (check-coding-system coding-system)) (let ((mark-beg (make-marker)) (mark-end (make-marker))) ;; Region changes with encoding, so use markers to track it. (set-marker mark-beg beg) (set-marker mark-end end) (set-buffer-multibyte t) (recode-region mark-beg mark-end coding-system 'raw-text) (setf beg (marker-position mark-beg) end (marker-position mark-end)))))) (let ((xml-default-ns ())) (xml-parse-region beg end buffer parse-dtd 'symbol-qnames))) (defun elfeed-xml-unparse (element) "Inverse of `elfeed-xml-parse-region', writing XML to the buffer." (cl-destructuring-bind (tag attrs . body) element (insert (format "<%s" tag)) (dolist (attr attrs) (cl-destructuring-bind (key . value) attr (insert (format " %s='%s'" key (xml-escape-string value))))) (if (null body) (insert "/>") (insert ">") (dolist (sub body) (if (stringp sub) (insert (xml-escape-string sub)) (elfeed-xml-unparse sub))) (insert (format "" tag))))) (defun elfeed-directory-empty-p (dir) "Return non-nil if DIR is empty." (null (cddr (directory-files dir)))) (defun elfeed-slurp (file &optional literally) "Return the contents of FILE as a string." (with-temp-buffer (if literally (insert-file-contents-literally file) (insert-file-contents file)) (buffer-string))) (cl-defun elfeed-spit (file string &key fsync append (encoding 'utf-8)) "Write STRING to FILE." (let ((coding-system-for-write encoding) (write-region-inhibit-fsync (not fsync))) (with-temp-buffer (insert string) (write-region nil nil file append 0)))) (defvar elfeed-gzip-supported-p--cache :unknown "To avoid running the relatively expensive test more than once.") (defun elfeed-gzip-supported-p () "Return non-nil if `auto-compression-mode' can handle gzip." (if (not (eq elfeed-gzip-supported-p--cache :unknown)) elfeed-gzip-supported-p--cache (setf elfeed-gzip-supported-p--cache (and (executable-find "gzip") (ignore-errors (save-window-excursion (let ((file (make-temp-file "gziptest" nil ".gz")) (data (cl-loop for i from 32 to 3200 collect i into chars finally (return (apply #'string chars))))) (unwind-protect (progn (elfeed-spit file data) (and (string= data (elfeed-slurp file)) (not (string= data (elfeed-slurp file t))))) (delete-file file))))))))) (defun elfeed-libxml-supported-p () "Return non-nil if `libxml-parse-html-region' is available." (with-temp-buffer (insert "") (and (fboundp 'libxml-parse-html-region) (not (null (libxml-parse-html-region (point-min) (point-max))))))) (defun elfeed-keyword->symbol (keyword) "If a keyword, convert KEYWORD into a plain symbol (remove the colon)." (if (keywordp keyword) (intern (substring (symbol-name keyword) 1)) keyword)) (defun elfeed-resize-vector (vector length) "Return a copy of VECTOR set to size LENGTH." (let ((new-vector (make-vector length nil))) (prog1 new-vector ; don't use dotimes result (bug#16206) (dotimes (i (min (length new-vector) (length vector))) (setf (aref new-vector i) (aref vector i)))))) (defun elfeed-readable-p (value) "Return non-nil if VALUE can be serialized." (condition-case _ (prog1 t (read (prin1-to-string value))) (error nil))) (defun elfeed-strip-properties (string) "Return a copy of STRING with all properties removed. If STRING is nil, returns nil." (when string (let ((copy (copy-sequence string))) (prog1 copy (set-text-properties 0 (length copy) nil copy))))) (defun elfeed-clipboard-get () "Try to get a sensible value from the system clipboard. On systems running X, it will try to use the PRIMARY selection first, then fall back onto the standard clipboard like other systems." (elfeed-strip-properties (or (and (fboundp 'x-get-selection) (funcall 'x-get-selection)) (and (functionp interprogram-paste-function) (funcall interprogram-paste-function)) (and (fboundp 'w32-get-clipboard-data) (funcall 'w32-get-clipboard-data)) (ignore-errors (current-kill 0 :non-destructively))))) (defun elfeed-get-link-at-point () "Try to a link at point and return its URL." (or (get-text-property (point) 'shr-url) (and (fboundp 'eww-current-url) (funcall 'eww-current-url)) (get-text-property (point) :nt-link))) (defun elfeed-get-url-at-point () "Try to get a plain URL at point." (or (url-get-url-at-point) (thing-at-point 'url))) (defun elfeed-move-to-first-empty-line () "Place point after first blank line, for use with `url-retrieve'. If no such line exists, point is left in place." (let ((start (point))) (setf (point) (point-min)) (unless (search-forward-regexp "^$" nil t) (setf (point) start)))) (defun elfeed--shuffle (seq) "Destructively shuffle SEQ." (let ((n (length seq))) (prog1 seq ; don't use dotimes result (bug#16206) (dotimes (i n) (cl-rotatef (elt seq i) (elt seq (+ i (cl-random (- n i))))))))) (defun elfeed-split-ranges-to-numbers (str n) "Convert STR containing enclosure numbers into a list of numbers. STR is a string; N is the highest possible number in the list. This includes expanding e.g. 3-5 into 3,4,5. If the letter \"a\" ('all')) is given, that is expanded to a list with numbers [1..n]." (let ((str-split (split-string str)) beg end list) (dolist (elem str-split list) ;; special number "a" converts into all enclosures 1-N. (when (equal elem "a") (setf elem (concat "1-" (int-to-string n)))) (if (string-match "\\([0-9]+\\)-\\([0-9]+\\)" elem) ;; we have found a range A-B, which needs converting ;; into the numbers A, A+1, A+2, ... B. (progn (setf beg (string-to-number (match-string 1 elem)) end (string-to-number (match-string 2 elem))) (while (<= beg end) (setf list (nconc list (list beg)) beg (1+ beg)))) ;; else just a number (push (string-to-number elem) list))))) (defun elfeed-remove-dot-segments (input) "Relative URL algorithm as described in RFC 3986 §5.2.4." (cl-loop with output = "" for s = input then (cond ((string-match-p "^\\.\\./" s) (substring s 3)) ((string-match-p "^\\./" s) (substring s 2)) ((string-match-p "^/\\./" s) (substring s 2)) ((string-match-p "^/\\.$" s) "/") ((string-match-p "^/\\.\\./" s) (setf output (replace-regexp-in-string "/?[^/]*$" "" output)) (substring s 3)) ((string-match-p "^/\\.\\.$" s) (setf output (replace-regexp-in-string "/?[^/]*$" "" output)) "/") ((string-match-p "^\\.\\.?$" s) "") ((string-match "^/?[^/]*" s) (setf output (concat output (match-string 0 s))) (replace-regexp-in-string "^/?[^/]*" "" s))) until (zerop (length s)) finally return output)) (defun elfeed-update-location (old-url new-url) "Return full URL for maybe-relative NEW-URL based on full OLD-URL." (if (null new-url) old-url (let ((old (url-generic-parse-url old-url)) (new (url-generic-parse-url new-url))) (cond ;; Is new URL absolute already? ((url-type new) new-url) ;; Empty is a special case (clear fragment) ((equal new-url "") (setf (url-target old) nil) (url-recreate-url old)) ;; Does it start with //? Append the old protocol. ((url-fullness new) (concat (url-type old) ":" new-url)) ;; Is it a relative path? ((not (string-match-p "^/" new-url)) (let* ((old-dir (or (file-name-directory (url-filename old)) "/")) (concat (concat old-dir new-url)) (new-file (elfeed-remove-dot-segments concat))) (setf (url-filename old) nil (url-target old) nil (url-attributes old) nil (url-filename old) new-file) (url-recreate-url old))) ;; Replace the relative part. ((progn (setf (url-filename old) (elfeed-remove-dot-segments new-url) (url-target old) nil (url-attributes old) nil) (url-recreate-url old))))))) (defun elfeed-url-to-namespace (url) "Compute an ID namespace from URL." (let* ((urlobj (url-generic-parse-url url)) (host (url-host urlobj))) (if (= 0 (length host)) url host))) (provide 'elfeed-lib) ;;; elfeed-lib.el ends here elfeed-3.3.0/elfeed-show.el0000644000175000017500000004264213566267252015345 0ustar dogslegdogsleg;;; elfeed-show.el --- display feed entries -*- lexical-binding: t; -*- ;; This is free and unencumbered software released into the public domain. ;;; Code: (require 'cl-lib) (require 'shr) (require 'url-parse) (require 'browse-url) (require 'message) ; faces (require 'elfeed) (require 'elfeed-db) (require 'elfeed-lib) (require 'elfeed-search) (defcustom elfeed-show-truncate-long-urls t "When non-nil, use an ellipsis to shorten very long displayed URLs." :group 'elfeed :type 'boolean) (defcustom elfeed-show-entry-author t "When non-nil, show the entry's author (if it's in the entry's metadata)." :group 'elfeed :type 'boolean) (defvar elfeed-show-entry nil "The entry being displayed in this buffer.") (defvar elfeed-show-entry-switch #'switch-to-buffer "Function to call to display and switch to the feed entry buffer. Defaults to `switch-to-buffer'.") (defvar elfeed-show-entry-delete #'elfeed-kill-buffer "Function called when quitting from the elfeed-entry buffer. Does not take any arguments. Defaults to `elfeed-kill-buffer'.") (defvar elfeed-show-refresh-function #'elfeed-show-refresh--mail-style "Function called to refresh the `*elfeed-entry*' buffer.") (defvar elfeed-show-mode-map (let ((map (make-sparse-keymap))) (prog1 map (suppress-keymap map) (define-key map "h" #'describe-mode) (define-key map "d" #'elfeed-show-save-enclosure) (define-key map "q" #'elfeed-kill-buffer) (define-key map "g" #'elfeed-show-refresh) (define-key map "n" #'elfeed-show-next) (define-key map "p" #'elfeed-show-prev) (define-key map "s" #'elfeed-show-new-live-search) (define-key map "b" #'elfeed-show-visit) (define-key map "y" #'elfeed-show-yank) (define-key map "u" #'elfeed-show-tag--unread) (define-key map "+" #'elfeed-show-tag) (define-key map "-" #'elfeed-show-untag) (define-key map "<" #'beginning-of-buffer) (define-key map ">" #'end-of-buffer) (define-key map (kbd "SPC") #'scroll-up-command) (define-key map (kbd "DEL") #'scroll-down-command) (define-key map (kbd "TAB") #'elfeed-show-next-link) (define-key map "\e\t" #'shr-previous-link) (define-key map [backtab] #'shr-previous-link) (define-key map [mouse-2] #'shr-browse-url) (define-key map "A" #'elfeed-show-add-enclosure-to-playlist) (define-key map "P" #'elfeed-show-play-enclosure))) "Keymap for `elfeed-show-mode'.") (defun elfeed-show-mode () "Mode for displaying Elfeed feed entries. \\{elfeed-show-mode-map}" (interactive) (kill-all-local-variables) (use-local-map elfeed-show-mode-map) (setq major-mode 'elfeed-show-mode mode-name "elfeed-show" buffer-read-only t) (buffer-disable-undo) (make-local-variable 'elfeed-show-entry) (run-mode-hooks 'elfeed-show-mode-hook)) (defalias 'elfeed-show-tag--unread (elfeed-expose #'elfeed-show-tag 'unread) "Mark the current entry unread.") (defun elfeed-insert-html (html &optional base-url) "Converted HTML markup to a propertized string." (shr-insert-document (if (elfeed-libxml-supported-p) (with-temp-buffer ;; insert to work around libxml-parse-html-region bug (when base-url (insert (format "" base-url))) (insert html) (libxml-parse-html-region (point-min) (point-max) base-url)) '(i () "Elfeed: libxml2 functionality is unavailable")))) (cl-defun elfeed-insert-link (url &optional (content url)) "Insert a clickable hyperlink to URL titled CONTENT." (when (and elfeed-show-truncate-long-urls (integerp shr-width) (> (length content) (- shr-width 8))) (let ((len (- (/ shr-width 2) 10))) (setq content (format "%s[...]%s" (substring content 0 len) (substring content (- len)))))) (elfeed-insert-html (format "%s" url content))) (defun elfeed-compute-base (url) "Return the base URL for URL, useful for relative paths." (let ((obj (url-generic-parse-url url))) (setf (url-filename obj) nil) (setf (url-target obj) nil) (url-recreate-url obj))) (defun elfeed--show-format-author (author) "Format author plist for the header." (let ((name (plist-get author :name)) (uri (plist-get author :uri)) (email (plist-get author :email))) (cond ((and name uri email) (format "%s <%s> (%s)" name email uri)) ((and name email) (format "%s <%s>" name email)) ((and name uri) (format "%s (%s)" name uri)) (name name) (email email) (uri uri) ("[unknown]")))) (defun elfeed-show-refresh--mail-style () "Update the buffer to match the selected entry, using a mail-style." (interactive) (let* ((inhibit-read-only t) (title (elfeed-entry-title elfeed-show-entry)) (date (seconds-to-time (elfeed-entry-date elfeed-show-entry))) (authors (elfeed-meta elfeed-show-entry :authors)) (link (elfeed-entry-link elfeed-show-entry)) (tags (elfeed-entry-tags elfeed-show-entry)) (tagsstr (mapconcat #'symbol-name tags ", ")) (nicedate (format-time-string "%a, %e %b %Y %T %Z" date)) (content (elfeed-deref (elfeed-entry-content elfeed-show-entry))) (type (elfeed-entry-content-type elfeed-show-entry)) (feed (elfeed-entry-feed elfeed-show-entry)) (feed-title (elfeed-feed-title feed)) (base (and feed (elfeed-compute-base (elfeed-feed-url feed))))) (erase-buffer) (insert (format (propertize "Title: %s\n" 'face 'message-header-name) (propertize title 'face 'message-header-subject))) (when elfeed-show-entry-author (dolist (author authors) (let ((formatted (elfeed--show-format-author author))) (insert (format (propertize "Author: %s\n" 'face 'message-header-name) (propertize formatted 'face 'message-header-to)))))) (insert (format (propertize "Date: %s\n" 'face 'message-header-name) (propertize nicedate 'face 'message-header-other))) (insert (format (propertize "Feed: %s\n" 'face 'message-header-name) (propertize feed-title 'face 'message-header-other))) (when tags (insert (format (propertize "Tags: %s\n" 'face 'message-header-name) (propertize tagsstr 'face 'message-header-other)))) (insert (propertize "Link: " 'face 'message-header-name)) (elfeed-insert-link link link) (insert "\n") (cl-loop for enclosure in (elfeed-entry-enclosures elfeed-show-entry) do (insert (propertize "Enclosure: " 'face 'message-header-name)) do (elfeed-insert-link (car enclosure)) do (insert "\n")) (insert "\n") (if content (if (eq type 'html) (elfeed-insert-html content base) (insert content)) (insert (propertize "(empty)\n" 'face 'italic))) (goto-char (point-min)))) (defun elfeed-show-refresh () "Update the buffer to match the selected entry." (interactive) (call-interactively elfeed-show-refresh-function)) (defcustom elfeed-show-unique-buffers nil "When non-nil, every entry buffer gets a unique name. This allows for displaying multiple show buffers at the same time." :group 'elfeed :type 'boolean) (defun elfeed-show--buffer-name (entry) "Return the appropriate buffer name for ENTRY. The result depends on the value of `elfeed-show-unique-buffers'." (if elfeed-show-unique-buffers (format "*elfeed-entry-<%s %s>*" (elfeed-entry-title entry) (format-time-string "%F" (elfeed-entry-date entry))) "*elfeed-entry*")) (defun elfeed-show-entry (entry) "Display ENTRY in the current buffer." (let ((buff (get-buffer-create (elfeed-show--buffer-name entry)))) (with-current-buffer buff (elfeed-show-mode) (setq elfeed-show-entry entry) (elfeed-show-refresh)) (funcall elfeed-show-entry-switch buff))) (defun elfeed-show-next () "Show the next item in the elfeed-search buffer." (interactive) (funcall elfeed-show-entry-delete) (with-current-buffer (elfeed-search-buffer) (call-interactively #'elfeed-search-show-entry))) (defun elfeed-show-prev () "Show the previous item in the elfeed-search buffer." (interactive) (funcall elfeed-show-entry-delete) (with-current-buffer (elfeed-search-buffer) (forward-line -2) (call-interactively #'elfeed-search-show-entry))) (defun elfeed-show-new-live-search () "Kill the current buffer, search again in *elfeed-search*." (interactive) (elfeed-kill-buffer) (elfeed) (elfeed-search-live-filter)) (defun elfeed-show-visit (&optional use-generic-p) "Visit the current entry in your browser using `browse-url'. If there is a prefix argument, visit the current entry in the browser defined by `browse-url-generic-program'." (interactive "P") (let ((link (elfeed-entry-link elfeed-show-entry))) (when link (message "Sent to browser: %s" link) (if use-generic-p (browse-url-generic link) (browse-url link))))) (defun elfeed-show-yank () "Copy the current entry link URL to the clipboard." (interactive) (let ((link (elfeed-entry-link elfeed-show-entry))) (when link (kill-new link) (if (fboundp 'gui-set-selection) (gui-set-selection 'PRIMARY link) (with-no-warnings (x-set-selection 'PRIMARY link))) (message "Yanked: %s" link)))) (defun elfeed-show-tag (&rest tags) "Add TAGS to the displayed entry." (interactive (list (intern (read-from-minibuffer "Tag: ")))) (let ((entry elfeed-show-entry)) (apply #'elfeed-tag entry tags) (with-current-buffer (elfeed-search-buffer) (elfeed-search-update-entry entry)) (elfeed-show-refresh))) (defun elfeed-show-untag (&rest tags) "Remove TAGS from the displayed entry." (interactive (let* ((tags (elfeed-entry-tags elfeed-show-entry)) (names (mapcar #'symbol-name tags)) (select (completing-read "Untag: " names nil :match))) (list (intern select)))) (let ((entry elfeed-show-entry)) (apply #'elfeed-untag entry tags) (with-current-buffer (elfeed-search-buffer) (elfeed-search-update-entry entry)) (elfeed-show-refresh))) ;; Enclosures: (defcustom elfeed-enclosure-default-dir (expand-file-name "~") "Default directory for saving enclosures. This can be either a string (a file system path), or a function that takes a filename and the mime-type as arguments, and returns the enclosure dir." :type 'directory :group 'elfeed :safe 'stringp) (defcustom elfeed-save-multiple-enclosures-without-asking nil "If non-nil, saving multiple enclosures asks once for a directory and saves all attachments in the chosen directory." :type 'boolean :group 'elfeed) (defvar elfeed-show-enclosure-filename-function #'elfeed-show-enclosure-filename-remote "Function called to generate the filename for an enclosure.") (defun elfeed--download-enclosure (url path) "Download asynchronously the enclosure from URL to PATH." (if (require 'async nil :noerror) (with-no-warnings (async-start (lambda () (url-copy-file url path t)) (lambda (_) (message (format "%s downloaded" url))))) (url-copy-file url path t))) (defun elfeed--get-enclosure-num (prompt entry &optional multi) "Ask the user with PROMPT for an enclosure number for ENTRY. The number is [1..n] for enclosures \[0..(n-1)] in the entry. If MULTI is nil, return the number for the enclosure; otherwise (MULTI is non-nil), accept ranges of enclosure numbers, as per `elfeed-split-ranges-to-numbers', and return the corresponding string." (let* ((count (length (elfeed-entry-enclosures entry))) def) (when (zerop count) (error "No enclosures to this entry")) (if (not multi) (if (= count 1) (read-number (format "%s: " prompt) 1) (read-number (format "%s (1-%d): " prompt count))) (progn (setq def (if (= count 1) "1" (format "1-%d" count))) (read-string (format "%s (default %s): " prompt def) nil nil def))))) (defun elfeed--request-enclosure-path (fname path) "Ask the user where to save FNAME (default is PATH/FNAME)." (let ((fpath (expand-file-name (read-file-name "Save as: " path nil nil fname) path))) (if (file-directory-p fpath) (expand-file-name fname fpath) fpath))) (defun elfeed--request-enclosures-dir (path) "Ask the user where to save multiple enclosures (default is PATH)." (let ((fpath (expand-file-name (read-directory-name (format "Save in directory: ") path nil nil nil) path))) (if (file-directory-p fpath) fpath))) (defun elfeed-show-enclosure-filename-remote (_entry url-enclosure) "Returns the remote filename as local filename for an enclosure." (file-name-nondirectory (url-unhex-string (car (url-path-and-query (url-generic-parse-url url-enclosure)))))) (defun elfeed-show-save-enclosure-single (&optional entry enclosure-index) "Save enclosure number ENCLOSURE-INDEX from ENTRY. If ENTRY is nil use the elfeed-show-entry variable. If ENCLOSURE-INDEX is nil ask for the enclosure number." (interactive) (let* ((path elfeed-enclosure-default-dir) (entry (or entry elfeed-show-entry)) (enclosure-index (or enclosure-index (elfeed--get-enclosure-num "Enclosure to save" entry))) (url-enclosure (car (elt (elfeed-entry-enclosures entry) (- enclosure-index 1)))) (fname (funcall elfeed-show-enclosure-filename-function entry url-enclosure)) (retry t) (fpath)) (while retry (setf fpath (elfeed--request-enclosure-path fname path) retry (and (file-exists-p fpath) (not (y-or-n-p (format "Overwrite '%s'?" fpath)))))) (elfeed--download-enclosure url-enclosure fpath))) (defun elfeed-show-save-enclosure-multi (&optional entry) "Offer to save multiple entry enclosures from the current entry. Default is to save all enclosures, [1..n], where n is the number of enclosures. You can type multiple values separated by space, e.g. 1 3-6 8 will save enclosures 1,3,4,5,6 and 8. Furthermore, there is a shortcut \"a\" which so means all enclosures, but as this is the default, you may not need it." (interactive) (let* ((entry (or entry elfeed-show-entry)) (attachstr (elfeed--get-enclosure-num "Enclosure number range (or 'a' for 'all')" entry t)) (count (length (elfeed-entry-enclosures entry))) (attachnums (elfeed-split-ranges-to-numbers attachstr count)) (path elfeed-enclosure-default-dir) (fpath)) (if elfeed-save-multiple-enclosures-without-asking (let ((attachdir (elfeed--request-enclosures-dir path))) (dolist (enclosure-index attachnums) (let* ((url-enclosure (aref (elfeed-entry-enclosures entry) enclosure-index)) (fname (funcall elfeed-show-enclosure-filename-function entry url-enclosure)) (retry t)) (while retry (setf fpath (expand-file-name (concat attachdir fname) path) retry (and (file-exists-p fpath) (not (y-or-n-p (format "Overwrite '%s'?" fpath)))))) (elfeed--download-enclosure url-enclosure fpath)))) (dolist (enclosure-index attachnums) (elfeed-show-save-enclosure-single entry enclosure-index))))) (defun elfeed-show-save-enclosure (&optional multi) "Offer to save enclosure(s). If MULTI (prefix-argument) is nil, save a single one, otherwise, offer to save a range of enclosures." (interactive "P") (if multi (elfeed-show-save-enclosure-multi) (elfeed-show-save-enclosure-single))) (defun elfeed--enclosure-maybe-prompt-index (entry) "Prompt for an enclosure if there are multiple in ENTRY." (if (= 1 (length (elfeed-entry-enclosures entry))) 1 (elfeed--get-enclosure-num "Enclosure to play" entry))) (defun elfeed-show-play-enclosure (enclosure-index) "Play enclosure number ENCLOSURE-INDEX from current entry using EMMS. Prompts for ENCLOSURE-INDEX when called interactively." (interactive (list (elfeed--enclosure-maybe-prompt-index elfeed-show-entry))) (elfeed-show-add-enclosure-to-playlist enclosure-index) (with-no-warnings (with-current-emms-playlist (save-excursion (emms-playlist-last) (emms-playlist-mode-play-current-track))))) (defun elfeed-show-add-enclosure-to-playlist (enclosure-index) "Add enclosure number ENCLOSURE-INDEX to current EMMS playlist. Prompts for ENCLOSURE-INDEX when called interactively." (interactive (list (elfeed--enclosure-maybe-prompt-index elfeed-show-entry))) (require 'emms) ;; optional (with-no-warnings ;; due to lazy (require ) (emms-add-url (car (elt (elfeed-entry-enclosures elfeed-show-entry) (- enclosure-index 1)))))) (defun elfeed-show-next-link () "Skip to the next link, exclusive of the Link header." (interactive) (let ((properties (text-properties-at (line-beginning-position)))) (when (memq 'message-header-name properties) (forward-paragraph)) (shr-next-link))) (provide 'elfeed-show) ;;; elfeed-show.el ends here elfeed-3.3.0/UNLICENSE0000644000175000017500000000227313566267252014065 0ustar dogslegdogslegThis is free and unencumbered software released into the public domain. Anyone is free to copy, modify, publish, use, compile, sell, or distribute this software, either in source code form or as a compiled binary, for any purpose, commercial or non-commercial, and by any means. In jurisdictions that recognize copyright laws, the author or authors of this software dedicate any and all copyright interest in the software to the public domain. We make this dedication for the benefit of the public at large and to the detriment of our heirs and successors. We intend this dedication to be an overt act of relinquishment in perpetuity of all present and future rights to this software under copyright law. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. For more information, please refer to elfeed-3.3.0/elfeed-log.el0000644000175000017500000000513713566267252015144 0ustar dogslegdogsleg;;; elfeed-log.el --- Elfeed's logging system -*- lexical-binding: t; -*- ;;; Commentary: ;;; Code: (require 'cl-lib) (defface elfeed-log-date-face '((t :inherit font-lock-type-face)) "Face for showing the date in the elfeed log buffer." :group 'elfeed) (defface elfeed-log-error-level-face '((t :foreground "red")) "Face for showing the `error' log level in the elfeed log buffer." :group 'elfeed) (defface elfeed-log-warn-level-face '((t :foreground "goldenrod")) "Face for showing the `warn' log level in the elfeed log buffer." :group 'elfeed) (defface elfeed-log-info-level-face '((t :foreground "deep sky blue")) "Face for showing the `info' log level in the elfeed log buffer." :group 'elfeed) (defface elfeed-log-debug-level-face '((t :foreground "magenta2")) "Face for showing the `debug' log level in the elfeed log buffer." :group 'elfeed) (defvar elfeed-log-buffer-name "*elfeed-log*" "Name of buffer used for logging Elfeed events.") (defvar elfeed-log-level 'info "Lowest type of messages to be logged.") (defun elfeed-log-buffer () "Returns the buffer for `elfeed-log', creating it as needed." (let ((buffer (get-buffer elfeed-log-buffer-name))) (if buffer buffer (with-current-buffer (generate-new-buffer elfeed-log-buffer-name) (special-mode) (current-buffer))))) (defun elfeed-log--level-number (level) "Return a relative level number for LEVEL." (cl-case level (debug -10) (info 0) (warn 10) (error 20) (otherwise -10))) (defun elfeed-log (level fmt &rest objects) "Write log message FMT at LEVEL to Elfeed's log buffer. LEVEL should be a symbol: debug, info, warn, error. FMT must be a string suitable for `format' given OBJECTS as arguments." (let ((log-buffer (elfeed-log-buffer)) (log-level-face (cl-case level (debug 'elfeed-log-debug-level-face) (info 'elfeed-log-info-level-face) (warn 'elfeed-log-warn-level-face) (error 'elfeed-log-error-level-face))) (inhibit-read-only t)) (when (>= (elfeed-log--level-number level) (elfeed-log--level-number elfeed-log-level)) (with-current-buffer log-buffer (goto-char (point-max)) (insert (format (concat "[" (propertize "%s" 'face 'elfeed-log-date-face) "] " "[" (propertize "%s" 'face log-level-face) "]: %s\n") (format-time-string "%Y-%m-%d %H:%M:%S") level (apply #'format fmt objects))))))) (provide 'elfeed-log) ;;; elfeed-log.el ends here elfeed-3.3.0/tests/0000755000175000017500000000000013566267252013753 5ustar dogslegdogslegelfeed-3.3.0/tests/elfeed-lib-tests.el0000644000175000017500000001623713566267252017436 0ustar dogslegdogsleg;;; elfeed-lib-tests.el --- library tests -*- lexical-binding: t; -*- (require 'ert) (require 'elfeed-lib) (ert-deftest elfeed-goto-line () (with-temp-buffer (insert "a\nbb\nccc\ndddd\n") (elfeed-goto-line 2) (should (looking-at "bb")) (elfeed-goto-line 4) (should (looking-at "dddd")))) (ert-deftest elfeed-kill-line () (with-temp-buffer (insert "a\nbb\nccc\ndddd\n") (elfeed-goto-line 3) (elfeed-kill-line) (should (equal (buffer-string) "a\nbb\n\ndddd\n")))) (ert-deftest elfeed-time-duration () (should (= (elfeed-time-duration "1 week ago") (* 1.0 7 24 60 60))) (should (= (elfeed-time-duration "3 years old") (* 3.0 365.25 24 60 60))) (should (= (elfeed-time-duration "1-day") (* 1.0 24 60 60))) (should (= (elfeed-time-duration "1hour") (* 1.0 60 60)))) (ert-deftest elfeed-time-duration-absolute () ;; fixed time for testing: assume U.S. eastern (let ((now (float-time (encode-time 0 20 13 24 6 2019 (* -1 4 60 60))))) ;; "2019-06-24T13:20:00-04:00" is "2019-06-24T17:20:00Z" so 17h 20mins is ;; the time difference: (should (= (+ (* 17 60 60) (* 20 60)) (elfeed-time-duration "2019-06-24" now))) (should (= (* 10 60) (elfeed-time-duration "2019-06-24T17:10" now))) (should (= (* 10 60) (elfeed-time-duration "2019-06-24T17:10:00" now))) (should (= (+ (* 9 60) 30) (elfeed-time-duration "2019-06-24T17:10:30" now))) (should (= (+ (* 9 60) 30) (elfeed-time-duration "2019-06-24T17:10:30Z" now))) (should (= (+ (* 9 60) 30) (elfeed-time-duration "2019-06-24T17:10:30+00:00" now))) (should (= (+ (* 9 60) 30) (elfeed-time-duration "20190624T17:10:30+00:00" now))))) (ert-deftest elfeed-format-column () (should (string= (elfeed-format-column "foo" 10 :right) " foo")) (should (string= (elfeed-format-column "foo" 10 :left) "foo ")) (should (string= (elfeed-format-column "foo" 2 :left) "fo")) (should (string= (elfeed-format-column "foo" 2 :right) "fo")) (should (string= (elfeed-format-column "foo" 0) "")) (should (string= (elfeed-format-column "foo" -1) ""))) (ert-deftest elfeed-clamp () (should (= (elfeed-clamp 0 3 4) 3)) (should (= (elfeed-clamp 2 9 4) 4)) (should (= (elfeed-clamp 2 0 4) 2)) (should (= (elfeed-clamp -6 3 0) 0))) (ert-deftest elfeed-valid-regexp-p () (should (elfeed-valid-regexp-p "")) (should (elfeed-valid-regexp-p "[abc]\\.")) (should-not (elfeed-valid-regexp-p "\\")) (should-not (elfeed-valid-regexp-p "[")) (should-not (elfeed-valid-regexp-p :foo))) (ert-deftest elfeed-looks-like-url-p () (should (elfeed-looks-like-url-p "http://nullprogram.com/")) (should (elfeed-looks-like-url-p "https://example.com/")) (should-not (elfeed-looks-like-url-p "example.com")) (should-not (elfeed-looks-like-url-p "foo bar")) (should-not (elfeed-looks-like-url-p nil))) (ert-deftest elfeed-cleanup () (should (string= (elfeed-cleanup " foo bar\n") "foo bar")) (should (string= (elfeed-cleanup "foo\nbar") "foo bar"))) (ert-deftest elfeed-float-time () (cl-macrolet ((test (time seconds) `(should (= (elfeed-float-time ,time) ,seconds)))) (test "1985-03-24" 480470400.0) (test "1985-03-24T03:23:42Z" 480482622.0) (test "Mon, 5 May 1986 15:16:09 GMT" 515690169.0) (test "2015-02-20" 1424390400.0) (test "20150220" 1424390400.0) (test "2015-02" 1422748800.0) (should (null (elfeed-float-time "notadate"))))) (ert-deftest elfeed-xml-parse-region () (with-temp-buffer (insert (encode-coding-string " Тест" 'windows-1251)) (let ((xml (elfeed-xml-parse-region))) (should (string= "Тест" (nth 2 (nth 0 xml)))))) (with-temp-buffer (insert (encode-coding-string " Тест" 'windows-1251)) (let ((xml (elfeed-xml-parse-region))) (should (string= "Тест" (nth 2 (nth 0 xml)))))) (with-temp-buffer (insert (concat "" (mapconcat (lambda (_) " ") (number-sequence 1 100000) "") "")) (elfeed-xml-parse-region)) (with-temp-buffer (set-buffer-multibyte nil) (insert "" "\xb0\xd9\xb6\xc8\xbf\xc6\xbc\xbc" "\xbd\xb9\xb5\xe3\xd0\xc2\xce\xc5") (should (equal (elfeed-xml-parse-region) '((x nil "百度科技焦点新闻")))))) (ert-deftest elfeed-directory-empty-p () (let ((empty (make-temp-file "empty" t)) (full (make-temp-file "full" t))) (unwind-protect (progn (with-temp-file (expand-file-name "foo" full)) (should (elfeed-directory-empty-p empty)) (should-not (elfeed-directory-empty-p full))) (delete-directory empty :recursive) (delete-directory full :recursive)))) (ert-deftest elfeed-slurp-spit () (let ((file (make-temp-file "spit")) (data (string 40 400 4000 40000))) (unwind-protect (progn (elfeed-spit file data) (should (string= (elfeed-slurp file) data)) (elfeed-spit file data :append t) (should (string= (elfeed-slurp file) (concat data data)))) (delete-file file)))) (ert-deftest elfeed-keyword->symbol () (should (eq (elfeed-keyword->symbol :foo) 'foo)) (should (eq (elfeed-keyword->symbol 'foo) 'foo))) (ert-deftest elfeed-resize-vector () (should (equal [nil nil] (elfeed-resize-vector [] 2))) (should (equal [1 2] (elfeed-resize-vector [1 2 3 4] 2))) (should (equal [9 8 7 nil] (elfeed-resize-vector [9 8 7] 4)))) (ert-deftest elfeed-readable-p () (should (elfeed-readable-p t)) (should (elfeed-readable-p nil)) (should-not (elfeed-readable-p (current-buffer))) (should (elfeed-readable-p 101)) (should-not (elfeed-readable-p (make-marker))) (should (elfeed-readable-p "foobar")) (should (elfeed-readable-p (make-hash-table))) (should-not (elfeed-readable-p (symbol-function '+)))) (ert-deftest elfeed-move-to-first-empty-line () (with-temp-buffer (insert "aaaaa\nbbbb\n\ncccccc") (elfeed-move-to-first-empty-line) (should (= (point) 12))) (with-temp-buffer (insert "aaaaa\nbbbb\ncccccc") (setf (point) 5) (elfeed-move-to-first-empty-line) (should (= (point) 5)))) (ert-deftest elfeed-update-location () (cl-macrolet ((t (o n e) `(should (equal (elfeed-update-location ,o ,n) ,e)))) (t "http://foo.example/" "/foo" "http://foo.example/foo") (t "ftp://foo.example/" "//bar.com/ok" "ftp://bar.com/ok") (t "https://foo.example/a/b/c" "d" "https://foo.example/a/b/d") (t "http://foo.example/a/b/c" "/x/x" "http://foo.example/x/x") (t "http://foo.example/a/b/c" nil "http://foo.example/a/b/c") (t "http://foo.example/a/b/c#foo" "" "http://foo.example/a/b/c") (t "http://foo.example/a/b/" "../c" "http://foo.example/a/c") (t "http://foo.example/a/b/" ".././c" "http://foo.example/a/c") (t "http://foo.example/a/b/" "../c/../../d" "http://foo.example/d"))) (provide 'elfeed-lib-tests) ;;; elfeed-lib-tests.el ends here elfeed-3.3.0/tests/elfeed-db-tests.el0000644000175000017500000002462613566267252017256 0ustar dogslegdogsleg;;; elfeed-db-tests.el --- database tests -*- lexical-binding: t; -*- (require 'cl-lib) (require 'ert) (require 'url-parse) (require 'elfeed) (require 'elfeed-db) (require 'elfeed-lib) (require 'jka-compr) (defvar elfeed-test-random-state (if (functionp 'record) ; Emacs 26 or later? (record 'cl--random-state -1 30 267466518) (vector 'cl-random-state-tag -1 30 267466518)) "Use the same random state for each run.") (defun elfeed-random* (x) "Generate a random number from `elfeed-test-random-state'." (cl-random x elfeed-test-random-state)) (defun elfeed-test-generate-letter (&optional multibyte) "Generate a single character from a-z or unicode." (cl-flet ((control-p (char) (or (<= char #x001F) (and (>= char #x007F) (<= char #x009F))))) (if multibyte (cl-loop for char = (elfeed-random* (1+ #x10FF)) unless (control-p char) return char) (+ ?a (elfeed-random* 26))))) (cl-defun elfeed-test-random (n &optional (variance 1.0)) "Generate a random integer around N, minimum of 1." (max 1 (floor (+ n (- (elfeed-random* (* 1.0 variance n)) (* variance 0.5 n)))))) (cl-defun elfeed-test-generate-word (&optional multibyte (length 6)) "Generate a word around LENGTH letters long." (apply #'string (cl-loop repeat (elfeed-test-random length) collect (elfeed-test-generate-letter multibyte)))) (cl-defun elfeed-test-generate-title (&optional multibyte (length 8)) "Generate a title around LENGTH words long, capitalized." (mapconcat #'identity (cl-loop repeat (elfeed-test-random length) collect (elfeed-test-generate-word multibyte) into words finally (return (cons (capitalize (car words)) (cdr words)))) " ")) (defun elfeed-test-generate-url () "Generate a random URL." (let* ((tlds '(".com" ".net" ".org")) (tld (nth (elfeed-random* (length tlds)) tlds)) (path (downcase (elfeed-test-generate-title nil 3)))) (url-recreate-url (url-parse-make-urlobj "http" nil nil (concat (elfeed-test-generate-word nil 10) tld) nil (concat "/" (replace-regexp-in-string " " "/" path)) nil nil :full)))) (defmacro with-elfeed-test (&rest body) "Run BODY with a fresh, empty database that will be destroyed on exit." (declare (indent defun)) `(let* ((elfeed-db nil) (elfeed-db-feeds nil) (elfeed-db-entries nil) (elfeed-db-index nil) (elfeed-feeds nil) (temp-dir (make-temp-file "elfeed-test-" t)) (elfeed-db-directory temp-dir) (elfeed-new-entry-hook nil) (elfeed-db-update-hook nil) (elfeed-initial-tags '(unread))) (unwind-protect (progn ,@body) (delete-directory temp-dir :recursive)))) (defun elfeed-test-generate-feed () "Generate a random feed. Warning: run this in `with-elfeed-test'." (let* ((url (elfeed-test-generate-url)) (id url) (feed (elfeed-db-get-feed id))) (prog1 feed (push url elfeed-feeds) (setf (elfeed-feed-title feed) (elfeed-test-generate-title)) (setf (elfeed-feed-url feed) url)))) (cl-defun elfeed-test-generate-date (&optional (within "1 year")) "Generate an epoch time within WITHIN time before now." (let* ((duration (elfeed-time-duration within)) (min-time (- (float-time) duration))) (+ min-time (elfeed-random* duration)))) (cl-defun elfeed-test-generate-entry (feed &optional (within "1 year")) "Generate a random entry. Warning: run this in `with-elfeed-test'." (let* ((feed-id (elfeed-feed-id feed)) (namespace (elfeed-url-to-namespace feed-id)) (link (elfeed-test-generate-url))) (elfeed-entry--create :id (cons namespace link) :title (elfeed-test-generate-title) :link link :date (elfeed-test-generate-date within) :tags (list 'unread) :feed-id feed-id))) (ert-deftest elfeed-db-size () (let ((count 143)) (with-elfeed-test (let ((feed (elfeed-test-generate-feed))) (elfeed-db-add (cl-loop repeat count collect (elfeed-test-generate-entry feed)))) (should (= (elfeed-db-size) count))))) (ert-deftest elfeed-db-merge () (with-elfeed-test (let* ((feed (elfeed-test-generate-feed)) (entry (elfeed-test-generate-entry feed)) (update (copy-sequence entry))) (should (eq (elfeed-entry-merge entry update) nil)) (setf (elfeed-entry-title update) (elfeed-test-generate-title)) (should (eq (elfeed-entry-merge entry update) t))) (let ((a (elfeed-entry--create :tags '(a b c) :meta '(:a 1 :b 2))) (b (elfeed-entry--create :tags '(c d) :meta '(:b 3 :c 4)))) (elfeed-entry-merge a b) (should (equal (elfeed-entry-tags a) '(a b c))) (should (eql (plist-get (elfeed-entry-meta a) :a) 1)) (should (eql (plist-get (elfeed-entry-meta a) :b) 3)) (should (eql (plist-get (elfeed-entry-meta a) :c) 4))))) (ert-deftest elfeed-db-tag () (with-elfeed-test (let* ((feed (elfeed-test-generate-feed)) (entry (elfeed-test-generate-entry feed)) (tags (elfeed-normalize-tags '(foo bar baz)))) (apply #'elfeed-tag entry tags) (elfeed-untag entry 'unread) (should (equal (elfeed-entry-tags entry) tags)) (should (elfeed-tagged-p 'foo entry)) (should (elfeed-tagged-p 'bar entry)) (should (elfeed-tagged-p 'baz entry)) (should-not (elfeed-tagged-p 'unread entry))))) (ert-deftest elfeed-db-visit () (with-elfeed-test (cl-loop for feed in (cl-loop repeat 8 collect (elfeed-test-generate-feed)) do (elfeed-db-add (cl-loop repeat 10 collect (elfeed-test-generate-entry feed)))) (let ((entries nil) (feeds nil)) (with-elfeed-db-visit (entry feed) (push (elfeed-entry-date entry) entries) (cl-pushnew feed feeds :test #'equal)) ;; All entries should have appeared. (should (= (length entries) 80)) ;; All feeds should have appeared. (should (= (length feeds) 8)) ;; All entries should have appeared in date order (should (equal (sort (copy-sequence entries) #'<) entries)) entries))) (ert-deftest elfeed-db-dates () (with-elfeed-test (let* ((feed (elfeed-test-generate-feed)) (entries (cl-loop repeat 100 collect (elfeed-test-generate-entry feed))) (updated-p nil)) (elfeed-db-add entries) (add-hook 'elfeed-new-entry-hook (apply-partially #'error "No new entries expected!")) (add-hook 'elfeed-db-update-hook (lambda () (setf updated-p t))) (elfeed-db-add (cl-loop for entry in entries for update = (copy-sequence entry) do (setf (elfeed-entry-date update) (elfeed-test-generate-date)) collect update)) (should updated-p) (let ((collected nil) (sorted nil)) (with-elfeed-db-visit (entry _) (push (elfeed-entry-date entry) collected)) (setf sorted (sort (copy-sequence collected) #'<)) (should (equal collected sorted)))))) (ert-deftest elfeed-ref () (with-elfeed-test (let* ((content (cl-loop repeat 25 collect (elfeed-test-generate-title t))) (refs (mapcar #'elfeed-ref content)) (derefs (mapcar #'elfeed-deref refs))) (should (equal content derefs))) (let ((string "naïveté")) (should (string= string (elfeed-deref (elfeed-ref string))))))) (ert-deftest elfeed-ref-pack () (catch 'test-abort (with-elfeed-test (let ((jka-compr-verbose nil) (matcher "^[a-z0-9]\\{2\\}$") (feed (elfeed-test-generate-feed)) (data (expand-file-name "data" elfeed-db-directory))) (unless (elfeed-gzip-supported-p) (message "warning: gzip auto-compression unsupported, skipping") (throw 'test-abort nil)) (cl-flet ((make-entries (n) (cl-loop repeat n for entry = (elfeed-test-generate-entry feed) do (setf (elfeed-entry-title entry) (elfeed-test-generate-title :multibyte)) do (setf (elfeed-entry-content entry) (elfeed-entry-title entry)) collect entry))) (let ((entries-a (make-entries 20)) (entries-b (make-entries 20))) (elfeed-db-add entries-a) (should (directory-files data nil matcher)) (elfeed-db-pack) (elfeed-db-add entries-b) (elfeed-db-pack) (elfeed-db-gc) (should-not (directory-files data nil matcher)) (dolist (entry (append entries-a entries-b)) (let ((title (elfeed-entry-title entry)) (content (elfeed-deref (elfeed-entry-content entry)))) (should (string= title content)))))))))) (ert-deftest elfeed-db-meta () (with-elfeed-test (let* ((feed (elfeed-db-get-feed (elfeed-test-generate-url))) (entry (elfeed-test-generate-entry feed))) (should (null (elfeed-meta feed :status))) (should (null (elfeed-meta entry :rating))) (should (= (elfeed-meta entry :errors 10) 10)) (setf (elfeed-meta feed :status) 'down (elfeed-meta entry :rating) 4) (cl-incf (elfeed-meta entry :errors 0)) (should (equal 'down (elfeed-meta feed :status))) (should (equal 4 (elfeed-meta entry :rating))) (should (= (elfeed-meta entry :errors) 1)) (should-error (setf (elfeed-meta entry :rating) (current-buffer)))))) (ert-deftest elfeed-db-feed-entries () "Test `elfeed-feed-entries'." (with-elfeed-test (cl-flet ((tsort (x) (sort (mapcar #'elfeed-entry-title x) #'string<))) (let* ((feed-a (elfeed-test-generate-feed)) (feed-a-entries (cl-loop repeat 10 collect (elfeed-test-generate-entry feed-a))) (feed-b (elfeed-test-generate-feed)) (feed-b-id (elfeed-feed-id feed-b)) (feed-b-entries (cl-loop repeat 10 collect (elfeed-test-generate-entry feed-b)))) (elfeed-db-add feed-a-entries) (elfeed-db-add feed-b-entries) ;; Fetch the entries using `elfeed-feed-entries' (should (equal (tsort (elfeed-feed-entries feed-a)) (tsort feed-a-entries))) (should (equal (tsort (elfeed-feed-entries feed-b-id)) (tsort feed-b-entries))))))) (provide 'elfeed-db-tests) ;;; elfeed-db-tests.el ends here elfeed-3.3.0/tests/elfeed-search-tests.el0000644000175000017500000000574513566267252020137 0ustar dogslegdogsleg;;; elfeed-search-tests.el --- search tests -*- lexical-binding: t; -*- (require 'ert) (require 'elfeed-search) (defmacro test-search-parse-filter-duration (filter after-days &optional before-days) (let ((day (* 24 60 60))) `(should (equal ',(cl-concatenate 'list (when before-days (list :before (float (* day before-days)))) (list :after (float (* day after-days)))) (elfeed-search-parse-filter ,filter))))) (ert-deftest elfeed-parse-filter-time-durations () (cl-letf (((symbol-function 'current-time) (lambda () (encode-time 0 0 0 24 6 2019 t)))) (test-search-parse-filter-duration "@5-days-ago--3-days-ago" 5 3) (test-search-parse-filter-duration "@3-days-ago--5-days-ago" 5 3) (test-search-parse-filter-duration "@2019-06-01" 23) (test-search-parse-filter-duration "@2019-06-20--2019-06-01" 23 4) (test-search-parse-filter-duration "@2019-06-01--2019-06-20" 23 4) (test-search-parse-filter-duration "@2019-06-01--4-days-ago" 23 4) (test-search-parse-filter-duration "@4-days-ago--2019-06-01" 23 4))) (defmacro run-date-filter (filter entry-time-string test-time-string) "Creates an entry with ENTRY-TIME-STRING, sets the current time to TEST-TIME-STRING and then tests the compiled filter function by calling it with entry and FILTER. Returns t if the filter matches, nil otherwise." `(let* ((test-time (seconds-to-time (elfeed-parse-simple-iso-8601 ,test-time-string))) (entry-time (seconds-to-time (elfeed-parse-simple-iso-8601 ,entry-time-string))) (orig-float-time (symbol-function 'float-time)) (entry (elfeed-entry--create :title "test-entry" :date (float-time entry-time)))) (cl-letf (((symbol-function 'current-time) (lambda () test-time)) ((symbol-function 'float-time) (lambda (&optional time) (funcall orig-float-time test-time)))) (catch 'elfeed-db-done (let ((filter-fn (elfeed-search-compile-filter (elfeed-search-parse-filter ,filter)))) (funcall filter-fn entry nil 0)))))) (ert-deftest elfeed-search-compile-filter () (should (null (run-date-filter "@1-days-ago" "2019-06-23" "2019-06-25"))) (should (run-date-filter "@3-days-ago" "2019-06-23" "2019-06-25")) (should (null (run-date-filter "@30-days-ago--10-days-ago" "2019-06-23" "2019-06-25"))) (should (run-date-filter "@2019-06-01" "2019-06-23" "2019-06-25")) (should (null (run-date-filter "@2019-06-01--2019-06-20" "2019-06-23" "2019-06-25")))) (ert-deftest elfeed-search-unparse-filter () (should (string-equal "@5-minutes-ago" (elfeed-search-unparse-filter '(:after 300)))) (should (string-equal "@5-minutes-ago--1-minute-ago" (elfeed-search-unparse-filter '(:after 300 :before 60))))) (provide 'elfeed-search-tests) ;;; elfeed-search-tests.el ends here elfeed-3.3.0/tests/xml-query-tests.el0000644000175000017500000000230113566267252017374 0ustar dogslegdogsleg;;; xml-query-tests.el -- tests for xml-query (require 'ert) (require 'xml-query) (ert-deftest xml-query () (let ((xml '((foo ((xmlns . "example/xml")) (bar ((href . "example.com")) "FOO" (p ()) "BAR") (baz () "FOOBAZ"))))) (should (string= (xml-query '(foo :xmlns) xml) "example/xml")) (should (string= (xml-query* (foo :xmlns) xml) "example/xml")) (should (string= (xml-query '(foo bar :href) xml) "example.com")) (should (string= (xml-query* (foo bar :href) xml) "example.com")) (should (string= (xml-query '(foo baz *) xml) "FOOBAZ")) (should (string= (xml-query* (foo baz *) xml) "FOOBAZ")) (should (string= (xml-query '(foo bar *) xml) "FOO")) (should (string= (xml-query* (foo bar *) xml) "FOO")) (should (equal (xml-query-all '(foo bar *) xml) '("FOO" "BAR"))) (should (equal (xml-query-all* (foo bar *) xml) '("FOO" "BAR"))) (should (equal (xml-query-all '(foo baz *) xml) '("FOOBAZ"))) (should (equal (xml-query-all* (foo baz *) xml) '("FOOBAZ"))) (should (equal (xml-query-all '(foo (baz bar) *) xml) '("FOOBAZ" "FOO" "BAR"))))) (provide 'xml-query-tests) ;;; xml-query-tests.el ends here elfeed-3.3.0/tests/elfeed-tests.el0000644000175000017500000004570613566267252016675 0ustar dogslegdogsleg;;; elfeed-tests.el --- tests for elfeed -*- lexical-binding: t; -*- ;; emacs -batch -Q -L .. -L . -l elfeed-tests.el -f ert-run-tests-batch (require 'ert) (require 'elfeed) (require 'elfeed-lib) (require 'xml-query-tests) (require 'elfeed-db-tests) (require 'elfeed-lib-tests) (defvar elfeed-test-rss " RSS Title This is an example of an RSS feed http://www.example.com/main.html Mon, 06 Sep 2014 00:01:00 +0000 Mon, 05 Sep 2014 16:20:00 +0000 1800 Example entry 1 Interesting description 1. john.doe@example.com (John Doe) 84815091-a6a3-35d4-7f04-80a6610dc85c Mon, 06 Sep 2009 16:20:00 +0000 example-entry Example One Example entry 2 Interesting description 2. http://www.wikipedia.org/ Jane Doe <jane.doe@example.com> Baby Doe <baby.doe@example.com> 5059196a-7f8e-3678-ecfe-dad84511d76f Mon, 2 Sep 2013 20:25:07 GMT example-entry Example Two ") (defvar elfeed-test-atom " Example Feed A subtitle. urn:uuid:60a76c80-d399-11d9-b91C-0003939e0af6 2003-12-13T18:30:02Z John Doe (feed) johndoe@example.com Jane Doe (feed) janedoe@example.com Atom-Powered Robots Run Amok urn:uuid:1225c695-cfb8-4ebb-aaaa-80da344efa6a 2003-12-13T18:30:02Z Some text. John Doe johndoe@example.com It's Raining Cats and Dogs urn:uuid:1b91e3d7-2dac-3916-27a3-8d31566f2d09 2004-12-13T18:30:02Z Some text. John Doe johndoe@example.com Jane Doe janedoe@example.com Foo Bar ") (defvar elfeed-test-rss1.0 " XML.com http://xml.com/pub XML.com features a rich mix of information and services for the XML community. Processing Inclusions with XSLT http://xml.com/pub/2000/08/09/xslt/xslt.html Processing document inclusions with general XML tools can be problematic. This article proposes a way of preserving inclusion information through SAX-based processing. Putting RDF to Work http://xml.com/pub/2000/08/09/rdfdb/index.html Tool and API support for the Resource Description Framework is slowly coming of age. Edd Dumbill takes a look at RDFDB, one of the most exciting new RDF toolkits. ") (defvar elfeed-test-xml-base " xml:base test xml:base is complicated urn:uuid:1edeb49c-1f0a-3de3-9a37-9802ef5c0add 2015-12-13T18:30:02Z xml:base xml@base.example.com Entry 0 urn:uuid:b42c623a-fbf0-31c8-3d54-1a56ee88e6a4 2015-12-13T18:30:02Z Content 0 Entry 1 urn:uuid:bdc21cd1-ceac-3439-ea05-3a1d34796dd2 2016-12-13T18:30:02Z Content 1 Entry 1 urn:uuid:bdc21cd1-ceac-3439-ea05-3a1d34796dd2 2016-12-13T18:30:02Z Content 1 ") (defvar elfeed-test-opml " Web Feeds ") (ert-deftest elfeed-feed-type () (with-temp-buffer (insert elfeed-test-rss) (should (eq (elfeed-feed-type (elfeed-xml-parse-region)) :rss))) (with-temp-buffer (insert elfeed-test-atom) (should (eq (elfeed-feed-type (elfeed-xml-parse-region)) :atom))) (with-temp-buffer (insert elfeed-test-rss1.0) (should (eq (elfeed-feed-type (elfeed-xml-parse-region)) :rss1.0)))) (ert-deftest elfeed-entries-from-x () (with-elfeed-test (with-temp-buffer (insert elfeed-test-rss) (goto-char (point-min)) (let* ((url (elfeed-test-generate-url)) (namespace (elfeed-url-to-namespace url)) (xml (elfeed-xml-parse-region))) (cl-destructuring-bind (a b) (elfeed-entries-from-rss url xml) (should (string= (elfeed-feed-title (elfeed-db-get-feed url)) "RSS Title")) (should (string= (elfeed-entry-title a) "Example entry 1")) (should (string= (elfeed-entry-link a) "http://nullprogram.com/")) (should (= (elfeed-entry-date a) 1252254000.0)) (should (equal (elfeed-entry-id a) (cons namespace "84815091-a6a3-35d4-7f04-80a6610dc85c"))) (should (string= (plist-get (nth 0 (elfeed-meta a :authors)) :name) "John Doe")) (should (string= (plist-get (nth 0 (elfeed-meta a :authors)) :email) "john.doe@example.com")) (should (string= (elfeed-entry-title b) "Example entry 2")) (should (= (elfeed-entry-date b) 1378153507.0)) (should (equal (elfeed-entry-id b) (cons namespace "5059196a-7f8e-3678-ecfe-dad84511d76f"))) (should (string= (plist-get (nth 0 (elfeed-meta b :authors)) :name) "Jane Doe ")) (should (string= (plist-get (nth 1 (elfeed-meta b :authors)) :name) "Baby Doe ")) (should (member "example-entry" (elfeed-meta b :categories))) (should (member "Example Two" (elfeed-meta b :categories)))))) (with-temp-buffer (insert elfeed-test-atom) (goto-char (point-min)) (let* ((url (elfeed-test-generate-url)) (namespace (elfeed-url-to-namespace url)) (xml (elfeed-xml-parse-region)) (feed (elfeed-db-get-feed url))) (cl-destructuring-bind (a b) (elfeed-entries-from-atom url xml) ;; Authors (should (string= (plist-get (nth 0 (elfeed-feed-author feed)) :name) "John Doe (feed)")) (should (string= (plist-get (nth 0 (elfeed-feed-author feed)) :email) "johndoe@example.com")) (should (string= (plist-get (nth 1 (elfeed-feed-author feed)) :name) "Jane Doe (feed)")) (should (string= (plist-get (nth 1 (elfeed-feed-author feed)) :email) "janedoe@example.com")) ;; Titles (should (string= (elfeed-feed-title (elfeed-db-get-feed url)) "Example Feed")) (should (string= (elfeed-entry-title a) "Atom-Powered Robots Run Amok")) ;; Entry A (should (string= (elfeed-entry-link a) "http://example.org/2003/atom03.html")) (should (= (elfeed-entry-date a) 1071340202.0)) (should (equal (elfeed-entry-id a) (cons namespace "urn:uuid:1225c695-cfb8-4ebb-aaaa-80da344efa6a"))) (should (member "example" (elfeed-meta a :categories))) (should (member "cat-1" (elfeed-meta a :categories))) ;; Entry B (should (string= (elfeed-entry-title b) "It's Raining Cats and Dogs")) (should (string= (elfeed-entry-link b) "http://example.org/2004/12/13/atom03.html")) (should (= (elfeed-entry-date b) 1102962602.0)) (should (string= (plist-get (nth 0 (elfeed-meta b :authors)) :name) "John Doe")) (should (string= (plist-get (nth 0 (elfeed-meta b :authors)) :email) "johndoe@example.com")) (should (string= (plist-get (nth 1 (elfeed-meta b :authors)) :name) "Jane Doe")) (should (string= (plist-get (nth 1 (elfeed-meta b :authors)) :email) "janedoe@example.com")) (should (member "example" (elfeed-meta b :categories))) (should (member "cat-2" (elfeed-meta b :categories))) (should (equal (elfeed-entry-id b) (cons namespace "urn:uuid:1b91e3d7-2dac-3916-27a3-8d31566f2d09")))))) (with-temp-buffer (insert elfeed-test-rss1.0) (goto-char (point-min)) (let* ((url (elfeed-test-generate-url)) (namespace (elfeed-url-to-namespace url)) (xml (elfeed-xml-parse-region))) (cl-destructuring-bind (a b) (elfeed-entries-from-rss1.0 url xml) (should (string= (elfeed-feed-title (elfeed-db-get-feed url)) "XML.com")) (should (string= (elfeed-entry-title a) "Processing Inclusions with XSLT")) (should (equal (elfeed-entry-id a) (cons namespace "http://xml.com/pub/2000/08/09/xslt/xslt.html"))) (should (string= (elfeed-entry-title b) "Putting RDF to Work")) (should (equal (elfeed-entry-id b) (cons namespace "http://xml.com/pub/2000/08/09/rdfdb/index.html")))))))) (ert-deftest elfeed-protocol-relative-url () (with-elfeed-test (with-temp-buffer (insert elfeed-test-rss) (setf (point) (point-min)) (while (search-forward "http://" nil t) (replace-match "//" nil t)) (setf (point) (point-min)) (let ((xml (elfeed-xml-parse-region))) (cl-destructuring-bind (a b) (elfeed-entries-from-rss "http://example.com/" xml) (should (equal (elfeed-entry-link a) "http://nullprogram.com/")) (should (equal (elfeed-entry-link b) "http://www.wikipedia.org/"))) (cl-destructuring-bind (a b) (elfeed-entries-from-rss "https://example.com/" xml) (should (equal (elfeed-entry-link a) "https://nullprogram.com/")) (should (equal (elfeed-entry-link b) "https://www.wikipedia.org/"))))) (with-temp-buffer (insert elfeed-test-atom) (setf (point) (point-min)) (while (search-forward "base=\"http://" nil t) (replace-match "base=\"//" nil t)) (setf (point) (point-min)) (let ((xml (elfeed-xml-parse-region))) (cl-destructuring-bind (a b) (elfeed-entries-from-atom "http://example.com/" xml) (should (equal (elfeed-entry-link a) ;; inherited protocol-relative from xml:base "http://example.org/2003/atom03.html")) (should (equal (elfeed-entry-link b) "http://example.org/2004/12/13/atom03.html"))) (cl-destructuring-bind (a b) (elfeed-entries-from-atom "https://example.com/" xml) (should (equal (elfeed-entry-link a) ;; inherited protocol-relative from xml:base "https://example.org/2003/atom03.html")) (should (equal (elfeed-entry-link b) "http://example.org/2004/12/13/atom03.html"))))))) (ert-deftest elfeed-xml-base () (with-elfeed-test (with-temp-buffer (insert elfeed-test-xml-base) (goto-char (point-min)) (let* ((url "http://bar.example.org/") (xml (elfeed-xml-parse-region)) (_feed (elfeed-db-get-feed url))) (cl-destructuring-bind (a b c) (elfeed-entries-from-atom url xml) (should (string= (elfeed-entry-link a) "http://foo.example.org/entry0/content0.html")) (should (string= (elfeed-entry-link b) "http://foo.example.org/entry1/content1.html")) (should (string= (elfeed-entry-link c) "https://entry2.example.com/entry2/content2.html"))))))) (ert-deftest elfeed-tagger () (with-elfeed-test (let* ((feed (elfeed-test-generate-feed)) (tagger (elfeed-make-tagger :after "1 year ago" :entry-title "foobar" :feed-title '(not "exclude")))) (setf (elfeed-feed-title feed) "exclude this") (should-not (funcall tagger (elfeed-entry--create :title "welcome to foobar: enjoy your stay" :date (elfeed-float-time "6 months ago") :feed-id (elfeed-feed-id feed)))) (setf (elfeed-feed-title feed) "now include this") (should (funcall tagger (elfeed-entry--create :title "welcome to foobar: enjoy your stay" :date (elfeed-float-time "6 months ago") :feed-id (elfeed-feed-id feed)))) ;; May fail if this test takes more than 2 months to run! (should-not (funcall tagger (elfeed-entry--create :title "welcome to foobar: enjoy your stay" :date (elfeed-float-time "14 months ago") :feed-id (elfeed-feed-id feed)))) (should-not (funcall tagger (elfeed-entry--create :title "welcome to barfoo: enjoy your stay" :date (elfeed-float-time "1 month ago") :feed-id (elfeed-feed-id feed))))))) (ert-deftest elfeed-opml () (let ((elfeed-feeds nil) (file (make-temp-file "feedlist"))) (unwind-protect (progn (with-temp-file file (insert elfeed-test-opml)) (elfeed-load-opml file) (setq elfeed-feeds (sort elfeed-feeds #'string<)) (should (equal elfeed-feeds '("http://boring.example.com/rss/" "http://example.com/feed/" "http://foo.example.com/atom.xml" "http://funny.example.com/feed/")))) (ignore-errors (delete-file file)))) (with-elfeed-test (let* ((outfile (make-temp-file "opml")) (feeds (cl-loop repeat 10 collect (elfeed-test-generate-url))) (elfeed-feeds feeds)) (unwind-protect (progn (cl-loop for url in elfeed-feeds for feed = (elfeed-db-get-feed url) for title = (elfeed-test-generate-title) do (setf (elfeed-feed-title feed) title)) (elfeed-export-opml outfile) (setf elfeed-feeds nil) (elfeed-load-opml outfile) (setf elfeed-feeds (sort elfeed-feeds #'string<)) (setf feeds (sort feeds #'string<)) (should (equal elfeed-feeds feeds))) (ignore-errors (delete-file outfile)))))) (ert-deftest elfeed-autotags () (let ((elfeed-feeds '("foo" ("bar" :tag-a tag-b) "baz" ("qux")))) (should (equal (elfeed-feed-list) '("foo" "bar" "baz" "qux"))) (should (equal (elfeed-feed-autotags "foo") '())) (should (equal (elfeed-feed-autotags "qux") '())) (should (equal (elfeed-feed-autotags "bar") '(tag-a tag-b))) (should (equal (elfeed-feed-autotags (elfeed-feed--create :url "bar")) '(tag-a tag-b)))) (with-elfeed-test (with-temp-buffer (insert elfeed-test-atom) (goto-char (point-min)) (let* ((elfeed-feeds '("http://bar/" ("http://foo/" tag-a :tag-b))) (xml (elfeed-xml-parse-region)) (entry (cl-first (elfeed-entries-from-atom "http://foo/" xml)))) (should (equal (elfeed-entry-tags entry) (elfeed-normalize-tags '(unread tag-a tag-b)))))))) (provide 'elfeed-tests) ;;; elfeed-tests.el ends here elfeed-3.3.0/elfeed-pkg.el0000644000175000017500000000013013566267252015130 0ustar dogslegdogsleg(define-package "elfeed" "3.3.0" "an Emacs Atom/RSS feed reader" '((emacs "24.3"))) elfeed-3.3.0/Makefile0000644000175000017500000000434113566267252014253 0ustar dogslegdogsleg.POSIX: EMACS = emacs BATCH = $(EMACS) -batch -Q -L . -L tests VERSION = 3.3.0 EL = elfeed-csv.el elfeed-curl.el elfeed-db.el elfeed-lib.el \ elfeed-log.el elfeed-show.el elfeed.el xml-query.el \ elfeed-search.el elfeed-link.el DOC = README.md NEWS.md UNLICENSE elfeed-pkg.el WEB = web/elfeed-web-pkg.el web/elfeed-web.el web/elfeed.css \ web/elfeed.js web/index.html TEST = tests/elfeed-db-tests.el tests/elfeed-lib-tests.el \ tests/elfeed-tests.el tests/xml-query-tests.el compile: $(EL:.el=.elc) $(TEST:.el=.elc) check: test test: $(EL:.el=.elc) $(TEST:.el=.elc) $(BATCH) -l tests/elfeed-tests.elc -f ert-run-tests-batch package: elfeed-$(VERSION).tar elfeed-web-$(VERSION).tar clean: rm -f *.tar $(EL:.el=.elc) $(TEST:.el=.elc) virtual: compile (mkdir -p tmp-$$$$/.elfeed; \ cp ~/.elfeed/index tmp-$$$$/.elfeed/ 2>/dev/null || true; \ trap "rm -rf tmp-$$$$" INT EXIT; \ HOME=$$PWD/tmp-$$$$ $(EMACS) -L . -l elfeed.elc $(ARGS)) elfeed-$(VERSION).tar: $(EL) $(DOC) rm -rf elfeed-$(VERSION)/ mkdir elfeed-$(VERSION)/ cp $(EL) $(DOC) elfeed-$(VERSION)/ tar cf $@ elfeed-$(VERSION)/ rm -rf elfeed-$(VERSION)/ elfeed-web-$(VERSION).tar: $(WEB) rm -rf elfeed-web-$(VERSION)/ mkdir elfeed-web-$(VERSION)/ cp $(WEB) elfeed-web-$(VERSION)/ tar cf $@ elfeed-web-$(VERSION)/ rm -rf elfeed-web-$(VERSION)/ elfeed-csv.elc: elfeed-csv.el elfeed-db.elc elfeed-curl.elc: elfeed-curl.el elfeed-lib.elc elfeed-log.elc elfeed-db.elc: elfeed-db.el elfeed-lib.elc elfeed-lib.elc: elfeed-lib.el elfeed-log.elc: elfeed-log.el elfeed-show.elc: elfeed-show.el elfeed.elc elfeed-db.elc elfeed-lib.elc \ elfeed-search.elc elfeed-link.elc: elfeed-link.el elfeed.elc elfeed-search.elc elfeed-show.elc elfeed.elc: elfeed.el elfeed-lib.elc elfeed-log.elc elfeed-curl.elc \ elfeed-db.elc xml-query.elc xml-query.elc: xml-query.el elfeed-search.elc: elfeed-search.el elfeed.elc elfeed-db.elc elfeed-lib.elc tests/elfeed-db-tests.elc: tests/elfeed-db-tests.el elfeed-db.elc tests/elfeed-lib-tests.elc: tests/elfeed-lib-tests.el elfeed-lib.elc tests/elfeed-tests.elc: tests/elfeed-tests.el elfeed.elc tests/xml-query-tests.elc: tests/xml-query-tests.el xml-query.elc .SUFFIXES: .el .elc .el.elc: $(BATCH) -f batch-byte-compile $< elfeed-3.3.0/web/0000755000175000017500000000000013566267252013366 5ustar dogslegdogslegelfeed-3.3.0/web/index.html0000644000175000017500000000417213566267252015367 0ustar dogslegdogsleg Elfeed Web

Emacs Elfeed

{{selected.title}}

elfeed-3.3.0/web/elfeed.js0000644000175000017500000000340313566267252015150 0ustar dogslegdogslegvar INITIAL_QUERY = '@3-days-old'; function favicon(url) { return URI(url).path('favicon.ico').search('') .toString().replace(/\?$/, ''); } function entryFill(entry) { entry.favicon = favicon(entry.link); var date = new Date(entry.date); entry.dateString = [ 1900 + date.getYear(), 1 + date.getMonth(), date.getDate() ].join('-'); entry.classes = entry.tags.map(function(tag) { return 'tag-' + tag; }).join(' '); } function SearchCtrl($scope, $http) { $scope.query = INITIAL_QUERY; $scope.busy = false; $scope.dirty = true; $scope.update = function(blur) { if (!$scope.busy) { $scope.busy = true; $scope.dirty = false; $http.get(URI('/elfeed/search').search({ q: $scope.query }).toString()).success(function(data) { data.forEach(entryFill); $scope.entries = data; $scope.busy = false; if ($scope.dirty) $scope.update(); }); } else { $scope.dirty = true; } if (blur) { // Is there a "right" way to do this? I don't think there is. document.getElementById('query').blur(); } }; $scope.time = 0; function poll() { $http.get(URI('/elfeed/update').search({ time: $scope.time }).toString()).success(function(data) { $scope.time = data; $scope.update(); poll(); }); } poll(); $scope.selected = null; $scope.show = function(entry) { $scope.selected = entry; }; $scope.markAllRead = function() { $http.get(URI('/elfeed/mark-all-read')); $scope.update(); }; } elfeed-3.3.0/web/elfeed-web.el0000644000175000017500000002160313566267252015711 0ustar dogslegdogsleg;;; elfeed-web.el --- web interface to Elfeed -*- lexical-binding: t; -*- ;; This is free and unencumbered software released into the public domain. ;; Author: Christopher Wellons ;; URL: https://github.com/skeeto/elfeed ;;; Commentary: ;; This is a very early work in progress. The long-term goal is to ;; provide a web interface view of the database with optional remote ;; tag updating. An AngularJS client accesses the database over a few ;; RESTful endpoints with JSON for serialization. ;; The IDs provided by RSS and Atom are completely arbitrary. To avoid ;; ugly encoding issues they're normalized into short, unique, ;; alphanumeric codes called webids. Both feeds and entries fall into ;; the same webid namespace so they share a single endpoint. ;; Endpoints: ;; /elfeed/ ;; Serves the static HTML, JS, and CSS content. ;; /elfeed/content/ ;; Serves content from the content database (`elfeed-deref'). ;; /elfeed/things/ ;; Serve up an elfeed-feed or elfeed-entry in JSON format. ;; /elfeed/search ;; Accepts a q parameter which is an filter string to be parsed ;; and handled by `elfeed-search-parse-filter'. ;; /elfeed/tags ;; Accepts a PUT request to modify the tags of zero or more ;; entries based on a JSON entry passed as the content. ;; /elfeed/update ;; Accepts a time parameter. If time < `elfeed-db-last-update', ;; respond with time. Otherwise don't respond until database ;; updates (long poll). ;;; Code: (require 'cl-lib) (require 'json) (require 'simple-httpd) (require 'elfeed-db) (require 'elfeed-search) (defcustom elfeed-web-enabled nil "If true, serve a web interface Elfeed with simple-httpd." :group 'elfeed :type 'boolean) (defvar elfeed-web-limit 512 "Maximum number of entries to serve at once.") (defvar elfeed-web-data-root (file-name-directory load-file-name) "Location of the static Elfeed web data files.") (defvar elfeed-web-webid-map (make-hash-table :test 'equal) "Track the mapping between entries and IDs.") (defvar elfeed-web-webid-seed (let ((items (list (random) (float-time) (emacs-pid) (system-name)))) (secure-hash 'sha1 (format "%S" items))) "Used to make webids less predictable.") (defun elfeed-web-make-webid (thing) "Compute a unique web ID for THING." (let* ((thing-id (prin1-to-string (aref thing 1))) (keyed (concat thing-id elfeed-web-webid-seed)) (hash (base64-encode-string (secure-hash 'sha1 keyed nil nil t))) (no-slash (replace-regexp-in-string "/" "-" hash)) (no-plus (replace-regexp-in-string "\\+" "_" no-slash)) (webid (substring no-plus 0 8))) (setf (gethash webid elfeed-web-webid-map) thing) webid)) (defun elfeed-web-lookup (webid) "Lookup a thing by its WEBID." (let ((thing (gethash webid elfeed-web-webid-map))) (if thing thing (or (with-elfeed-db-visit (entry _) (when (string= webid (elfeed-web-make-webid entry)) (setf (gethash webid elfeed-web-webid-map) (elfeed-db-return entry)))) (cl-loop for feed hash-values of elfeed-db-feeds when (string= (elfeed-web-make-webid feed) webid) return (setf (gethash webid elfeed-web-webid-map) feed)))))) (defun elfeed-web-for-json (thing) "Prepare THING for JSON serialization." (cl-etypecase thing (elfeed-entry (list :webid (elfeed-web-make-webid thing) :title (elfeed-entry-title thing) :link (elfeed-entry-link thing) :date (* 1000 (elfeed-entry-date thing)) :content (let ((content (elfeed-entry-content thing))) (and content (elfeed-ref-id content))) :contentType (elfeed-entry-content-type thing) :enclosures (or (mapcar #'car (elfeed-entry-enclosures thing)) []) :tags (or (elfeed-entry-tags thing) []) :feed (elfeed-web-for-json (elfeed-entry-feed thing)))) (elfeed-feed (list :webid (elfeed-web-make-webid thing) :url (elfeed-feed-url thing) :title (elfeed-feed-title thing) :author (elfeed-feed-author thing))))) (defmacro with-elfeed-web (&rest body) "Only execute BODY if `elfeed-web-enabled' is true." (declare (indent 0)) `(if (not elfeed-web-enabled) (progn (princ (json-encode '(:error 403))) (httpd-send-header t "application/json" 403)) ,@body)) (defservlet* elfeed/things/:webid application/json () "Return a requested thing (entry or feed)." (with-elfeed-web (princ (json-encode (elfeed-web-for-json (elfeed-web-lookup webid)))))) (defservlet* elfeed/content/:ref text/html () "Serve content-addressable content at REF." (with-elfeed-web (let ((content (elfeed-deref (elfeed-ref--create :id ref)))) (if content (princ content) (princ (json-encode '(:error 404))) (httpd-send-header t "application/json" 404))))) (defservlet* elfeed/search application/json (q) "Perform a search operation with Q and return the results." (with-elfeed-web (let* ((results ()) (modified-q (format "#%d %s" elfeed-web-limit q)) (filter (elfeed-search-parse-filter modified-q)) (count 0)) (with-elfeed-db-visit (entry feed) (when (elfeed-search-filter filter entry feed count) (push entry results) (cl-incf count))) (princ (json-encode (cl-coerce (mapcar #'elfeed-web-for-json (nreverse results)) 'vector)))))) (defvar elfeed-web-waiting () "Clients waiting for an update.") (defservlet* elfeed/update application/json (time) "Return the current :last-update time for the database. If a time parameter is provided don't respond until the time has advanced past it (long poll)." (let ((update-time (ffloor (elfeed-db-last-update)))) (if (= update-time (ffloor (float (string-to-number (or time ""))))) (push (httpd-discard-buffer) elfeed-web-waiting) (princ (json-encode update-time))))) (defservlet* elfeed/mark-all-read application/json () "Marks all entries in the database as read (quick-and-dirty)." (with-elfeed-web (with-elfeed-db-visit (e _) (elfeed-untag e 'unread)) (princ (json-encode t)))) (defservlet* elfeed/tags application/json () "Endpoint for adding and removing tags on zero or more entries. Only PUT requests are accepted, and the content must be a JSON object with any of these properties: add : array of tags to be added remove : array of tags to be removed entries : array of web IDs for entries to be modified The current set of tags for each entry will be returned." (with-elfeed-web (let* ((request (caar httpd-request)) (content (cadr (assoc "Content" httpd-request))) (json (ignore-errors (json-read-from-string content))) (add (cdr (assoc 'add json))) (remove (cdr (assoc 'remove json))) (webids (cdr (assoc 'entries json))) (entries (cl-map 'list #'elfeed-web-lookup webids)) (status (cond ((not (equal request "PUT")) 405) ((null json) 400) ((cl-some #'null entries) 404) (t 200)))) (if (not (eql status 200)) (progn (princ (json-encode `(:error ,status))) (httpd-send-header t "application/json" status)) (cl-loop for entry in entries for webid = (elfeed-web-make-webid entry) do (apply #'elfeed-tag entry (cl-map 'list #'intern add)) do (apply #'elfeed-untag entry (cl-map 'list #'intern remove)) collect (cons webid (elfeed-entry-tags entry)) into result finally (princ (if result (json-encode result) "{}"))))))) (defservlet elfeed text/plain (uri-path _ request) "Serve static files from `elfeed-web-data-root'." (if (not elfeed-web-enabled) (insert "Elfeed web interface is disabled.\n" "Set `elfeed-web-enabled' to true to enable it.") (let ((base "/elfeed/")) (if (< (length uri-path) (length base)) (httpd-redirect t base) (let ((path (substring uri-path (1- (length base))))) (httpd-serve-root t elfeed-web-data-root path request)))))) (defun elfeed-web-update () "Update waiting clients about database changes." (while elfeed-web-waiting (let ((proc (pop elfeed-web-waiting))) (ignore-errors (with-httpd-buffer proc "application/json" (princ (json-encode (ffloor (elfeed-db-last-update))))))))) (add-hook 'elfeed-db-update-hook 'elfeed-web-update) ;;;###autoload (defun elfeed-web-start () "Start the Elfeed web interface server." (interactive) (httpd-start) (setf elfeed-web-enabled t)) (defun elfeed-web-stop () "Stop the Elfeed web interface server." (interactive) (setf elfeed-web-enabled nil)) (provide 'elfeed-web) ;;; elfeed-web.el ends here elfeed-3.3.0/web/elfeed.css0000644000175000017500000000043613566267252015327 0ustar dogslegdogsleg.tag-unread { font-weight: bold; } .no-results { font-style: italic; } img.favicon { display: inline-block; width: 16px; height: 16px; } .entry .title { display: block; } iframe { border: 0; min-height: 1024px; } .entry { margin-bottom: 10px; } elfeed-3.3.0/web/elfeed-web-pkg.el0000644000175000017500000000017613566267252016472 0ustar dogslegdogsleg(define-package "elfeed-web" "3.3.0" "web interface to Elfeed" '((simple-httpd "1.5.1") (elfeed "3.2.0") (emacs "24.3"))) elfeed-3.3.0/README.md0000644000175000017500000003571113566267252014077 0ustar dogslegdogsleg# Elfeed Emacs Web Feed Reader Elfeed is an extensible web feed reader for Emacs, supporting both Atom and RSS. It requires Emacs 24.3 and is available for download from [MELPA](http://melpa.milkbox.net/) or [el-get](https://github.com/dimitri/el-get). Elfeed was inspired by [notmuch](http://notmuchmail.org/). For a longer overview, * [Introducing Elfeed, an Emacs Web Feed Reader](http://nullprogram.com/blog/2013/09/04/). * [Tips and Tricks](http://nullprogram.com/blog/2013/11/26/) * [Read your RSS feeds in Emacs with Elfeed ](http://pragmaticemacs.com/emacs/read-your-rss-feeds-in-emacs-with-elfeed/) * [Scoring Elfeed articles](http://kitchingroup.cheme.cmu.edu/blog/2017/01/05/Scoring-elfeed-articles/) * [Using Emacs 29](https://www.youtube.com/watch?v=pOFqzK1Ymr4), [30](https://www.youtube.com/watch?v=tjnK1rkO7RU), [31](https://www.youtube.com/watch?v=5zuSUbAHH8c) * [Take Elfeed everywhere: Mobile rss reading Emacs-style (for free/cheap)](http://babbagefiles.blogspot.com/2017/03/take-elfeed-everywhere-mobile-rss.html) * [... more ...](http://nullprogram.com/tags/elfeed/) * [... and more ...](http://pragmaticemacs.com/category/elfeed/) [![](http://i.imgur.com/kxgF5AH.png)](http://i.imgur.com/kxgF5AH.png) The database format is stable and is never expected to change. ## Prerequisites **It is *strongly* recommended you have cURL installed**, either in your PATH or configured via `elfeed-curl-program-name`. Elfeed will prefer it to Emacs' own URL-fetching mechanism, `url-retrieve`. It's also essential for running Elfeed on Windows, where `url-retrieve` is broken. Updates using cURL are significantly faster than the built-in method, both for you and the feed hosts. If this is giving you problems, fetching with cURL can be disabled by setting `elfeed-use-curl` to nil. ## Extensions These projects extend Elfeed with additional features: * [elfeed-org](https://github.com/remyhonig/elfeed-org) * [elfeed-goodies](https://github.com/algernon/elfeed-goodies) * [Elfeed Android interface](https://github.com/areina/elfeed-cljsrn) ([Google Play](https://play.google.com/store/apps/details?id=com.elfeedcljsrn)) ## Getting Started Elfeed is broken into a multiple source files, so if you manually install it you will need to add the Elfeed package directory to your `load-path`. If installed via package.el or el-get, this will be done automatically. It is recommended that you make a global binding for `elfeed`. ```el (global-set-key (kbd "C-x w") 'elfeed) ``` Running the interactive function `elfeed` will pop up the `*elfeed-search*` buffer, which will display feed items. * g: refresh view of the feed listing * G: fetch feed updates from the servers * s: update the search filter (see tags) * c: clear the search filter This buffer will be empty until you add your feeds to the `elfeed-feeds` list and initiate an update with `M-x elfeed-update` (or G in the Elfeed buffer). This will populate the Elfeed database with entries. ```el ;; Somewhere in your .emacs file (setq elfeed-feeds '("http://nullprogram.com/feed/" "http://planet.emacsen.org/atom.xml")) ``` Another option for providing a feed list is with an OPML file. Running `M-x elfeed-load-opml` will fill `elfeed-feeds` with feeds listed in an OPML file. When `elfeed-load-opml` is called interactively, it will automatically save the feedlist to your customization file, so you will only need to do this once. If there are a lot of feeds, the initial update will take noticeably longer than normal operation because of the large amount of information being written the database. Future updates will only need to write new or changed data. If updating feeds slows down Emacs too much for you, reduce the number of concurrent fetches via `elfeed-set-max-connections`. If you're getting many "Queue timeout exceeded" errors, increase the fetch timeout via `elfeed-set-timeout`. ~~~el (setf url-queue-timeout 30) ~~~ From the search buffer there are a number of ways to interact with entries. Entries are selected by placing the point over an entry. Multiple entries are selected at once by using an active region. * RET: view selected entry in a buffer * b: open selected entries in your browser (`browse-url`) * y: copy selected entries URL to the clipboard * r: mark selected entries as read * u: mark selected entries as unread * +: add a specific tag to selected entries * -: remove a specific tag from selected entries ## Tags Elfeed maintains a list of arbitrary tags -- symbols attached to an entry. The tag `unread` is treated specially by default, with unread entries appearing in bold. ### Autotagging Tags can automatically be applied to entries discovered in specific feeds through extra syntax in `elfeed-feeds`. Normally this is a list of strings, but an item can also be a list, providing set of "autotags" for a feed's entries. ```el (setq elfeed-feeds '(("http://nullprogram.com/feed/" blog emacs) "http://www.50ply.com/atom.xml" ; no autotagging ("http://nedroid.com/feed/" webcomic))) ``` ### Filter Syntax To make tags useful, the Elfeed entry listing buffer can be filtered by tags. Use `elfeed-search-set-filter` (or s) to update the filter. Use `elfeed-search-clear-filter` to restore the default. Any component of the search string beginning with a `+` or a `-` is treated like a tag. `+` means the tag is required, `-` means the tag must not be present. A component beginning with a `@` indicates an age or a date range. An age is a relative time expression or an absolute date expression. Entries older than this age are filtered out. The age description accepts plain English, but cannot have spaces, so use dashes. For example, `"@2-years-old"`, `"@3-days-ago"` or `"@2019-06-24"`. A date range are two ages seperated by a `--`, e.g. `"@2019-06-20--2019-06-24"` or `"@5-days-ago--1-day-ago"`. The entry must be newer than the first expression but older than the second. The database is date-oriented, so **filters that include an age restriction are significantly more efficient.** A component beginning with a `!` is treated as an "inverse" regular expression. This means that any entry matching this regular expression will be filtered out. The regular expression begins *after* the `!` character. You can read this as "entry not matching `foo`". A component beginning with a `#` limits the total number of entries displayed to the number immediately following the symbol. For example, to limit the display to 20 entries: `#20`. A component beginning with a `=` is a regular expression matching the entry's feed (title or URL). Only entries belonging to a feed that match at least one of the `=` expressions will be shown. All other components are treated as a regular expression, and only entries matching it (title or URL) will be shown. Here are some example filters. * `@6-months-ago +unread` Only show unread entries of the last six months. This is the default filter. * `linu[xs] @1-year-old` Only show entries about Linux or Linus from the last year. * `-unread +youtube #10` Only show the most recent 10 previously-read entries tagged as `youtube`. * `+unread !x?emacs` Only show unread entries not having `emacs` or `xemacs` in the title or link. * `+emacs =http://example.org/feed/` Only show entries tagged as `emacs` from a specific feed. #### Default Search Filter You can set your default search filter by changing the default value of `elfeed-search-filter`. It only changes buffer-locally when you're adjusting the filter within Elfeed. For example, some users prefer to have a space on the end for easier quick searching. (setq-default elfeed-search-filter "@1-week-ago +unread ") ### Tag Hooks The last example assumes you've tagged posts with `youtube`. You probably want to do this sort of thing automatically, either through the "autotags" feature mentioned above, or with the `elfeed-new-entry-hook`. Functions in this hook are called with new entries, allowing them to be manipulated, such as adding tags. ```el ;; Mark all YouTube entries (add-hook 'elfeed-new-entry-hook (elfeed-make-tagger :feed-url "youtube\\.com" :add '(video youtube))) ``` Avoiding tagging old entries as `unread`: ```el ;; Entries older than 2 weeks are marked as read (add-hook 'elfeed-new-entry-hook (elfeed-make-tagger :before "2 weeks ago" :remove 'unread)) ``` Or building your own subset feeds: ```el (add-hook 'elfeed-new-entry-hook (elfeed-make-tagger :feed-url "example\\.com" :entry-title '(not "something interesting") :add 'junk :remove 'unread)) ``` Use `M-x elfeed-apply-hooks-now` to apply `elfeed-new-entry-hook` to all existing entries. Otherwise hooks will only apply to new entries on discovery. ### Custom Tag Faces By default, entries marked `unread` will have bolded titles in the `*elfeed-search*` listing. You can customize how tags affect an entry's appearance by customizing `elfeed-search-face-alist`. For example, this configuration makes entries tagged `important` stand out in red. ~~~el (defface important-elfeed-entry '((t :foreground "#f77")) "Marks an important Elfeed entry.") (push '(important important-elfeed-entry) elfeed-search-face-alist) ~~~ All faces from all tags will be applied to the entry title. The faces will be ordered as they appear in `elfeed-search-face-alist`. ## Bookmarks Filters can be saved and restored using Emacs' built-in [bookmarks feature][bm]. While in the search buffer, use `M-x bookmark-set` to save the current filter, and `M-x bookmark-jump` to restore a saved filter. Emacs automatically persists bookmarks across sessions. [bm]: https://www.gnu.org/software/emacs/manual/html_node/emacs/Bookmarks.html ## Metadata Plist All feed and entry objects have plist where you can store your own arbitrary, [readable values][rd]. These values are automatically persisted in the database. This metadata is accessed using the polymorphic `elfeed-meta` function. It's setf-able. ~~~el (setf (elfeed-meta entry :rating) 4) (elfeed-meta entry :rating) ;; => 4 (setf (elfeed-meta feed :title) "My Better Title") ~~~ Elfeed itself adds some entries to this plist, some for your use, some for its own use. Here are the properties that Elfeed uses: * `:authors` : A list of author plists (`:name`, `:uri`, `:email`). * `:canonical-url` : The final URL for the feed after all redirects. * `:categories` : The feed-supplied categories for this entry. * `:etag` : HTTP Etag header, for conditional GETs. * `:failures` : Number of times this feed has failed to update. * `:last-modified` : HTTP Last-Modified header, for conditional GETs. * `:title` : Overrides the feed-supplied title for display purposes, both for feeds and entries. See also `elfeed-search-set-feed-title` and `elfeed-search-set-entry-title`. This list will grow in time, so you might consider namespacing your own properties to avoid collisions (e.g. `:xyz/rating`), or simply not using keywords as keys. Elfeed will always use keywords without a slash. [rd]: http://nullprogram.com/blog/2013/12/30/ ## Hooks A number of hooks are available to customize the behavior of Elfeed at key points without resorting to advice. * `elfeed-new-entry-hook` : Called each time a new entry it added to the database, allowing for automating tagging and such. * `elfeed-new-entry-parse-hook` : Called with each new entry and the full XML structure from which it was parsed, allowing for additional information to be drawn from the original feed XML. * `elfeed-http-error-hooks` : Allows for special behavior when HTTP errors occur, beyond simply logging the error to `*elfeed-log*` . * `elfeed-parse-error-hooks` : Allows for special behavior when feed parsing fails, beyond logging. * `elfeed-db-update-hook` : Called any time the database has had a major modification. ## Viewing Entries Entries are viewed locally in Emacs by typing `RET` while over an entry in the search listing. The content will be displayed in a separate buffer using `elfeed-show-mode`, rendered using Emacs' built-in shr package. This requires an Emacs compiled with `libxml2` bindings, which provides the necessary HTML parser. Sometimes displaying images can slow down or even crash Emacs. Set `shr-inhibit-images` to disable images if this is a problem. ## Web Interface Elfeed includes a demonstration/toy web interface for remote network access. It's a single-page web application that follows the database live as new entries arrive. It's packaged separately as `elfeed-web`. To fire it up, run `M-x elfeed-web-start` and visit http://localhost:8080/elfeed/ (check your `httpd-port`) with a browser. See the `elfeed-web.el` header for endpoint documentation if you'd like to access the Elfeed database through the web API. It's rough and unfinished -- no keyboard shortcuts, read-only, no authentication, and a narrow entry viewer. This is basically Elfeed's "mobile" interface. Patches welcome. ## Platform Support Summary: Install cURL and most problems disappear for all platforms. I personally only use Elfeed on Linux, but it's occasionally tested on Windows. Unfortunately the Windows port of Emacs is a bit too unstable for parallel feed downloads with `url-retrieve`, not to mention the [tiny, hard-coded, 512 open descriptor limitation][files], so it limits itself to one feed at a time on this platform. [files]: http://msdn.microsoft.com/en-us/library/kdfaxaay%28vs.71%29.aspx If you fetch HTTPS feeds without cURL on *any* platform, it's essential that Emacs is built with the `--with-gnutls` option. Otherwise Emacs runs gnutls in an inferior process, which rarely works well. ## Database Management The database should keep itself under control without any manual intervention, but steps can be taken to minimize the database size if desired. The simplest option is to run the `elfeed-db-compact` command, which will pack the loose-file content database into a single compressed file. This function works well in `kill-emacs-hook`. Going further, a function could be added to `elfeed-new-entry-hook` to strip unwanted/unneeded content from select entries before being stored in the database. For example, for YouTube videos only the entry link is of interest and the regularly-changing entry content could be tossed to save time and storage. ## Status and Roadmap Elfeed is to the point where it can serve 100% of my own web feed needs. My personal selection of about 150 feeds has been acting as my test case as I optimize and add features. Some things I still might want to add: * Database synchronization between computers * Parallel feed fetching via separate Emacs subprocesses ## Motivation As far as I know, outside of Elfeed there does not exist an extensible, text-file configured, power-user web feed client that can handle a reasonable number of feeds. The existing clients I've tried are missing some important capability that limits its usefulness to me. elfeed-3.3.0/xml-query.el0000644000175000017500000002007313566267252015100 0ustar dogslegdogsleg;;; xml-query.el --- query engine complimenting the xml package ;; This is free and unencumbered software released into the public domain. ;;; Commentary: ;; This provides a very rudimentary, jQuery-like, XML selector ;; s-expression language. It operates on the output of the xml ;; package, such as `xml-parse-region' and `xml-parse-file'. It was ;; written to support Elfeed. ;; See the docstring for `xml-query-all'. ;; The macro forms, `xml-query*' and `xml-query-all*', are an order of ;; magnitude faster, but only work on static selectors and need the ;; namespaces to be pre-stripped. ;; Examples: ;; This query grabs the top-level paragraph content from XHTML. ;; (xml-query-all '(html body p *) xhtml) ;; This query extracts all the links from an Atom feed. ;; (xml-query-all '(feed entry link [rel "alternate"] :href) xml) ;;; Code: (require 'cl-lib) (defun xml-query-strip-ns (tag) "Remove the namespace, if any, from TAG." (when (symbolp tag) (let ((name (symbol-name tag))) (if (cl-find ?\: name) (intern (replace-regexp-in-string "^.+:" "" name)) tag)))) (defun xml-query--tag-all (match xml) (cl-loop for (tag attribs . content) in (cl-remove-if-not #'listp xml) when (or (eq tag match) (eq (xml-query-strip-ns tag) match)) collect (cons tag (cons attribs content)))) (defun xml-query--attrib-all (attrib value xml) (cl-loop for (tag attribs . content) in (cl-remove-if-not #'listp xml) when (equal (cdr (assoc attrib attribs)) value) collect (cons tag (cons attribs content)))) (defun xml-query--keyword (matcher xml) (cl-loop with match = (intern (substring (symbol-name matcher) 1)) for (tag attribs . content) in (cl-remove-if-not #'listp xml) when (cdr (assoc match attribs)) collect it)) (defun xml-query--symbol (matcher xml) (xml-query--tag-all matcher xml)) (defun xml-query--vector (matcher xml) (let ((attrib (aref matcher 0)) (value (aref matcher 1))) (xml-query--attrib-all attrib value xml))) (defun xml-query--list (matchers xml) (cl-loop for matcher in matchers append (xml-query-all (if (listp matcher) matcher (list matcher)) xml))) (defun xml-query--append (xml) (cl-loop for (tag attribs . content) in (cl-remove-if-not #'listp xml) append content)) (defun xml-query--stringp (thing) "Return non-nil of THING is a non-blank string." (and (stringp thing) (string-match "[^ \t\r\n]" thing))) (defun xml-query-all (query xml) "Given a list of tags, XML, apply QUERY and return a list of matching tags. A query is a list of matchers. - SYMBOL: filters to matching tags - LIST: each element is a full sub-query, whose results are concatenated - VECTOR: filters to tags with matching attribute, [tag attrib value] - KEYWORD: filters to an attribute value (must be last) - * (an asterisk symbol): filters to content strings (must be last) For example, to find all the 'alternate' link URL in a typical Atom feed: (xml-query-all '(feed entry link [rel \"alternate\"] :href) xml)" (if (null query) xml (cl-destructuring-bind (matcher . rest) query (cond ((keywordp matcher) (xml-query--keyword matcher xml)) ((eq matcher '*) (cl-remove-if-not #'xml-query--stringp (xml-query--append xml))) (:else (let ((matches (cl-etypecase matcher (symbol (xml-query--symbol matcher xml)) (vector (xml-query--vector matcher xml)) (list (xml-query--list matcher xml))))) (cond ((null rest) matches) ((and (or (symbolp (car rest)) (listp (car rest))) (not (keywordp (car rest))) (not (eq '* (car rest)))) (xml-query-all (cdr query) (xml-query--append matches))) (:else (xml-query-all rest matches))))))))) (defun xml-query (query xml) "Like `xml-query-all' but only return the first result." (let ((result (xml-query-all query xml))) (if (xml-query--stringp result) result (car (xml-query-all query xml))))) ;; Macro alternatives: ;; This is a slightly less capable alternative with significantly ;; better performance (x10 speedup) that requires a static selector. ;; The selector is compiled into Lisp code via macro at compile-time, ;; which is then carried through to byte-code by the compiler. In ;; byte-code form, the macro performs no function calls other than ;; `throw' in the case of `xml-query*', where it's invoked less than ;; once per evaluation (only on success). ;; Queries are compiled tail-to-head with a result handler at the ;; deepest level. The generated code makes multiple bindings of the ;; variable "v" as it dives deeper into the query, using the layers of ;; bindings as a breadcrumb stack. ;; For `xml-query*', which has a single result, the whole expression ;; is wrapped in a catch, and the first successful match is thrown to ;; it from the result handler. ;; For `xml-query-all*', the result is pushed into an output list. (defun xml-query--compile-tag (tag subexp subloop-p) `(when (and (consp v) (eq (car v) ',tag)) ,(if subloop-p `(dolist (v (cddr v)) ,subexp) subexp))) (defun xml-query--compile-attrib (pair subexp subloop-p) `(let ((value (cdr (assq ',(aref pair 0) (cadr v))))) (when (equal value ,(aref pair 1)) ,(if subloop-p `(dolist (v (cddr v)) ,subexp) subexp)))) (defun xml-query--compile-keyword (keyword subexp) (let ((attrib (intern (substring (symbol-name keyword) 1)))) `(let ((v (cdr (assq ',attrib (cadr v))))) (when v ,subexp)))) (defun xml-query--compile-star (subexp) `(when (and (stringp v) (string-match "[^ \t\r\n]" v)) ,subexp)) (defun xml-query--compile-top (query input subexp) (let* ((rquery (reverse query)) (prev nil)) (while rquery (let ((matcher (pop rquery)) ;; Should the next item loop over its children? (subloop-p (and (not (null prev)) (not (keywordp prev)) (symbolp prev)))) (cond ((eq '* matcher) (setf subexp (xml-query--compile-star subexp))) ((keywordp matcher) (setf subexp (xml-query--compile-keyword matcher subexp))) ((symbolp matcher) (setf subexp (xml-query--compile-tag matcher subexp subloop-p))) ((vectorp matcher) (setf subexp (xml-query--compile-attrib matcher subexp subloop-p))) ((error "Bad query: %S" query))) (setf prev matcher))) `(dolist (v ,input) ,subexp))) (defun xml-query--compile (query input) (let ((tag (make-symbol "done"))) `(catch ',tag ,(xml-query--compile-top query input `(throw ',tag v))))) (defmacro xml-query* (query sexp) "Like `xml-query' but generate code to execute QUERY on SEXP. Unlike `xml-query', QUERY must be a static, compile-time s-expression. See `xml-query-all*' for more information. QUERY is *not* evaluated, so it should not be quoted." (xml-query--compile query sexp)) (defun xml-query-all--compile (query input) (let ((output (make-symbol "output"))) `(let ((,output ())) ,(xml-query--compile-top query input `(push v ,output)) (nreverse ,output)))) (defmacro xml-query-all* (query sexp) "Like `xml-query-all' but generate code to execute QUERY on SEXP. Unlike `xml-query-all', QUERY must be a static, compile-time s-expression. This macro compiles the query into actual code. The result is faster since the query will be compiled into byte-code rather than \"interpreted\" at run time. Also unlike `xml-query-all', the parsed XML s-expression must also have its namespace pre-stripped. This is accomplished by setting the optional PARSE-NS argument of `xml-parse-region' to symbol-qnames. Sub-expression lists are not supported by this macro. QUERY is *not* evaluated, so it should not be quoted." (xml-query-all--compile query sexp)) (provide 'xml-query) ;;; xml-query.el ends here elfeed-3.3.0/elfeed-csv.el0000644000175000017500000001314513566267252015154 0ustar dogslegdogsleg;;; elfeed-csv.el --- export database to CSV files -*- lexical-binding: t; -*- ;;; Commentary: ;; The `elfeed-csv-export' docstring has a SQL schema recommendation. ;; Given these schemas, these CSV files are trivially imported into a ;; SQLite database using the sqlite3 command line program: ;; sqlite> .mode csv ;; sqlite> .import feeds.csv feeds ;; sqlite> .import entries.csv entries ;; sqlite> .import tags.csv tags ;; Note: nil values won't be imported as NULL, but as empty strings. ;; Here are a few interesting queries to make on your own data: ;; For each tag in your database, compute a histogram of posts with ;; 1-hour bins across the the day (0-23), in your local timezone. ;; SELECT tag, ;; cast(strftime('%H', date, 'unixepoch', 'localtime') AS INT) AS hour, ;; count(id) AS count ;; FROM entries ;; JOIN tags ON tags.entry = entries.id AND tags.feed = entries.feed ;; GROUP BY tag, hour; ;; Like above, but per week-day (0-6). ;; SELECT tag, ;; cast(strftime('%w', date, 'unixepoch', 'localtime') AS INT) AS day, ;; count(id) AS count ;; FROM entries ;; JOIN tags ON tags.entry = entries.id AND tags.feed = entries.feed ;; GROUP BY tag, day; ;; For each feed, compute the number of entries and last entry date. ;; SELECT feeds.title AS title, ;; count(url) AS entry_count, ;; datetime(max(date), 'unixepoch') AS last_entry_date ;; FROM feeds ;; JOIN entries ON feeds.url = entries.feed ;; GROUP BY url ;; ORDER BY max(date) DESC; ;; Compute a histogram of entry title lengths. ;; SELECT length(title) AS length, ;; count(*) AS count ;; FROM entries ;; GROUP BY length ;; ORDER BY length; ;; Again, but this time group by tag. ;; SELECT tag, ;; length(title) AS length, ;; count(*) AS count ;; FROM entries ;; JOIN tags ON tags.entry = entries.id AND tags.feed = entries.feed ;; GROUP BY tag, length ;; ORDER BY length; ;; What's the relationship between title length and time of day of an ;; entry? (Scatter plot this result.) ;; SELECT (date % (24*60*60)) / (24*60*60) AS day_time, ;; length(title) AS length ;; FROM entries ;; JOIN tags ON tags.entry = entries.id AND tags.feed = entries.feed; ;;; Code: (require 'cl-lib) (require 'elfeed-db) (defvar elfeed-csv-nil "" "The string representation to use for nil. Consider let-binding this around your `elfeed-csv-quote' call.") (defun elfeed-csv-quote (sexp) "Return CSV string representation of SEXP." (cond ((null sexp) elfeed-csv-nil) ((not (stringp sexp)) (elfeed-csv-quote (prin1-to-string sexp))) ((string-match-p "[\"\n,]" sexp) (concat "\"" (replace-regexp-in-string "\"" "\"\"" sexp) "\"")) (sexp))) (defun elfeed-csv-insert (seq) "Insert a row of CSV data to the current buffer." (cl-loop for value being the elements of seq for column upfrom 0 when (> column 0) do (insert ",") do (insert (elfeed-csv-quote value)) finally (newline))) (cl-defun elfeed-csv-export (feeds-file entries-file tags-file &key headers-p) "Create separate CSV files for feeds, entries, and tags. These CSV files are intended for an analysis of an Elfeed database. They are suitable for importing as tables into a relational database such as SQLite. Here's the recommended SQL schema, reflecting the structure of the data. CREATE TABLE feeds ( url TEXT PRIMARY KEY, title TEXT, canonical_url TEXT, author TEXT ); CREATE TABLE entries ( id TEXT NOT NULL, feed TEXT NOT NULL REFERENCES feeds (url), title TEXT, link TEXT NOT NULL, date REAL NOT NULL, PRIMARY KEY (id, feed) ); CREATE TABLE tags ( entry TEXT NOT NULL, feed TEXT NOT NULL, tag TEXT NOT NULL, FOREIGN KEY (entry, feed) REFERENCES entries (id, feed) );" (let ((feeds-buffer (generate-new-buffer " *csv-feeds*")) (entries-buffer (generate-new-buffer " *csv-entries*")) (tags-buffer (generate-new-buffer " *csv-tags*")) (seen (make-hash-table :test 'eq))) ;; Write headers (when headers-p (with-current-buffer feeds-buffer (elfeed-csv-insert [url title canonical-url author])) (with-current-buffer entries-buffer (elfeed-csv-insert [id feed title link date])) (with-current-buffer tags-buffer (elfeed-csv-insert [entry feed tag]))) ;; Write data (with-elfeed-db-visit (entry feed) (unless (gethash feed seen) (setf (gethash feed seen) t) (let ((url (elfeed-feed-url feed)) (title (elfeed-feed-title feed)) (canonical-url (elfeed-meta feed :canonical-url)) (author (elfeed-feed-author feed))) (with-current-buffer feeds-buffer (elfeed-csv-insert (list url title canonical-url author))))) (let ((id (cdr (elfeed-entry-id entry))) (feed-id (elfeed-entry-feed-id entry)) (title (elfeed-entry-title entry)) (link (elfeed-entry-link entry)) (date (elfeed-entry-date entry))) (with-current-buffer entries-buffer (elfeed-csv-insert (list id feed-id title link date))) (with-current-buffer tags-buffer (dolist (tag (elfeed-entry-tags entry)) (elfeed-csv-insert (list id feed-id tag)))))) ;; Write files (with-current-buffer tags-buffer (write-region nil nil tags-file nil 0) (kill-buffer)) (with-current-buffer entries-buffer (write-region nil nil entries-file nil 0) (kill-buffer)) (with-current-buffer feeds-buffer (write-region nil nil feeds-file nil 0) (kill-buffer)))) (provide 'elfeed-csv) ;;; elfeed-csv.el ends here elfeed-3.3.0/elfeed-db.el0000644000175000017500000006141213566267252014746 0ustar dogslegdogsleg;;; elfeed-db.el --- database and model for elfeed -*- lexical-binding: t; -*- ;; This is free and unencumbered software released into the public domain. ;;; Commentary: ;; Elfeed is aware of two type of things: feeds and entries. All dates ;; are stored as floating point epoch seconds. ;; Feeds are keyed by their user-provided feed URL, which acts as the ;; feed identity regardless of any other stated identity. Feeds have a ;; list of entries. ;; Entries are keyed in order of preference by id (Atom), guid (RSS), ;; or link. To avoid circular references, entries refer to their ;; parent feeds by URL. ;; Feed content is stored in a content-addressable loose-file ;; database, very similar to an unpacked Git object database. Entries ;; have references to items in this database (elfeed-ref), keeping the ;; actual entry struct memory footprint small. Most importantly, this ;; keeps the core index small so that it can quickly be written as a ;; whole to the filesystem. The wire format is just the s-expression ;; print form of the top-level hash table. ;; The database can be compacted into a small number of compressed ;; files with the interactive function `elfeed-db-compact'. This could ;; be used as a kill-emacs hook. ;; An AVL tree containing all database entries ordered by date is ;; maintained as part of the database. We almost always want to look ;; at entries ordered by date and this step accomplished that very ;; efficiently with the AVL tree. This is the reasoning behind the ;; `with-elfeed-db-visit' interface. ;; Unfortunately there's a nasty bug (bug#15190) in the reader that ;; makes hash tables and `print-circle' incompatible. It's been fixed ;; in trunk, but many users will likely be stuck with this bug for the ;; next few years. This means the database format can't exploit ;; circular references. ;; Entry and feed objects can have arbitrary metadata attached, ;; automatically stored in the database. The setf-able `elfeed-meta' ;; function is used to access these. ;;; Code: (require 'cl-lib) (require 'avl-tree) (require 'elfeed-lib) (defcustom elfeed-db-directory "~/.elfeed" "Directory where elfeed will store its database." :group 'elfeed :type 'directory) (defvar elfeed-db nil "The core database for elfeed.") (defvar elfeed-db-feeds nil "Feeds hash table, part of `elfeed-db'.") (defvar elfeed-db-entries nil "Entries hash table, part of `elfeed-db'.") (defvar elfeed-db-index nil "Collection of all entries sorted by date, part of `elfeed-db'.") (defvar elfeed-db-version ;; If records are avaiable (Emacs 26), use the newer database format (if (functionp 'record) 4 "0.0.3") "The database version this version of Elfeed expects to use.") (defvar elfeed-new-entry-hook () "Functions in this list are called with the new entry as its argument. This is a chance to add custom tags to new entries.") (defvar elfeed-db-update-hook () "Functions in this list are called with no arguments any time the :last-update time is updated.") (defvar elfeed-db-unload-hook () "Hook to run immediately after `elfeed-db-unload'.") ;; Data model: (cl-defstruct (elfeed-feed (:constructor elfeed-feed--create)) "A web feed, contains elfeed-entry structs." id url title author meta) (cl-defstruct (elfeed-entry (:constructor elfeed-entry--create)) "A single entry from a feed, normalized towards Atom." id title link date content content-type enclosures tags feed-id meta) (defun elfeed-entry-merge (a b) "Merge B into A, preserving A's tags. Return true if an actual update occurred, not counting content." (setf (elfeed-entry-tags b) (elfeed-entry-tags a) (elfeed-entry-content a) (elfeed-entry-content b)) (cl-loop for (key value) on (elfeed-entry-meta b) by #'cddr do (setf (elfeed-entry-meta a) (plist-put (elfeed-entry-meta a) key value))) (not (zerop (cl-loop for i from 1 below (1- (length a)) for part-a = (aref a i) for part-b = (aref b i) count (not (equal part-a part-b)) do (setf (aref a i) part-b))))) (defun elfeed-db-get-feed (id) "Get/create the feed for ID." (elfeed-db-ensure) (let ((feed (gethash id elfeed-db-feeds))) (or feed (setf (gethash id elfeed-db-feeds) (elfeed-feed--create :id id))))) (defun elfeed-db-get-entry (id) "Get the entry for ID." (elfeed-db-ensure) (gethash id elfeed-db-entries)) (defun elfeed-db-compare (a b) "Return true if entry A is newer than entry B." (let* ((entry-a (elfeed-db-get-entry a)) (entry-b (elfeed-db-get-entry b)) (date-a (elfeed-entry-date entry-a)) (date-b (elfeed-entry-date entry-b))) (if (= date-a date-b) (string< (prin1-to-string b) (prin1-to-string a)) (> date-a date-b)))) (defun elfeed-db-set-update-time () "Update the database last-update time." (setf elfeed-db (plist-put elfeed-db :last-update (float-time))) (run-hooks 'elfeed-db-update-hook)) (defun elfeed-db-add (entries) "Add ENTRIES to the database." (elfeed-db-ensure) (cl-loop for entry in entries for id = (elfeed-entry-id entry) for original = (gethash id elfeed-db-entries) for new-date = (elfeed-entry-date entry) for original-date = (and original (elfeed-entry-date original)) do (elfeed-deref-entry entry) when original count (if (= new-date original-date) (elfeed-entry-merge original entry) (avl-tree-delete elfeed-db-index id) (prog1 (elfeed-entry-merge original entry) (avl-tree-enter elfeed-db-index id))) into change-count else count (setf (gethash id elfeed-db-entries) entry) into change-count and do (progn (avl-tree-enter elfeed-db-index id) (cl-loop for hook in elfeed-new-entry-hook do (funcall hook entry))) finally (unless (zerop change-count) (elfeed-db-set-update-time))) :success) (defun elfeed-entry-feed (entry) "Get the feed struct for ENTRY." (elfeed-db-get-feed (elfeed-entry-feed-id entry))) (defun elfeed-normalize-tags (tags &rest more-tags) "Return the normalized tag list for TAGS." (let ((all (apply #'append tags (nconc more-tags (list ()))))) (cl-delete-duplicates (cl-sort all #'string< :key #'symbol-name)))) (defun elfeed-tag-1 (entry &rest tags) "Add TAGS to ENTRY." (let ((current (elfeed-entry-tags entry))) (setf (elfeed-entry-tags entry) (elfeed-normalize-tags (append tags current))))) (defun elfeed-untag-1 (entry &rest tags) "Remove TAGS from ENTRY." (setf (elfeed-entry-tags entry) (cl-loop for tag in (elfeed-entry-tags entry) unless (memq tag tags) collect tag))) (defun elfeed-tag (entry-or-entry-list &rest tags) "Add TAGS to ENTRY-OR-ENTRY-LIST and run `elfeed-tag-hooks'." (let* ((entries (if (elfeed-entry-p entry-or-entry-list) (list entry-or-entry-list) entry-or-entry-list))) (run-hook-with-args 'elfeed-tag-hooks entries tags) (cl-loop for entry in entries do (apply #'elfeed-tag-1 entry tags)))) (defun elfeed-untag (entry-or-entry-list &rest tags) "Remove TAGS from ENTRY-OR-ENTRY-LIST and run `elfeed-untag-hooks'." (let* ((entries (if (elfeed-entry-p entry-or-entry-list) (list entry-or-entry-list) entry-or-entry-list))) (run-hook-with-args 'elfeed-untag-hooks entries tags) (cl-loop for entry in entries do (apply #'elfeed-untag-1 entry tags)))) (defun elfeed-tagged-p (tag entry) "Return true if ENTRY is tagged by TAG." (memq tag (elfeed-entry-tags entry))) (defun elfeed-db-last-update () "Return the last database update time in (`float-time') seconds." (elfeed-db-ensure) (or (plist-get elfeed-db :last-update) 0)) (defmacro with-elfeed-db-visit (entry-and-feed &rest body) "Visit each entry in the database from newest to oldest. Use `elfeed-db-return' to exit early and optionally return data. (with-elfeed-db-visit (entry feed) (do-something entry) (when (some-date-criteria-p entry) (elfeed-db-return)))" (declare (indent defun)) `(catch 'elfeed-db-done (prog1 nil (elfeed-db-ensure) (avl-tree-mapc (lambda (id) (let* ((,(cl-first entry-and-feed) (elfeed-db-get-entry id)) (,(cl-second entry-and-feed) (elfeed-entry-feed ,(cl-first entry-and-feed)))) ,@body)) elfeed-db-index)))) (defun elfeed-feed-entries (feed-or-id) "Return a list of all entries for a particular feed. The FEED-OR-ID may be a feed struct or a feed ID (url)." (let ((feed-id (if (elfeed-feed-p feed-or-id) (elfeed-feed-id feed-or-id) feed-or-id))) (let ((entries)) (with-elfeed-db-visit (entry feed) (when (equal (elfeed-feed-id feed) feed-id) (push entry entries))) (nreverse entries)))) (defun elfeed-apply-hooks-now () "Apply `elfeed-new-entry-hook' to all entries in the database." (interactive) (with-elfeed-db-visit (entry _) (cl-loop for hook in elfeed-new-entry-hook do (funcall hook entry)))) (defmacro elfeed-db-return (&optional value) "Use this to exit early and return VALUE from `with-elfeed-db-visit'." `(throw 'elfeed-db-done ,value)) (defun elfeed-db-get-all-tags () "Return a list of all tags currently in the database." (let ((table (make-hash-table :test 'eq))) (with-elfeed-db-visit (e _) (dolist (tag (elfeed-entry-tags e)) (setf (gethash tag table) tag))) (let ((tags ())) (maphash (lambda (k _) (push k tags)) table) (cl-sort tags #'string< :key #'symbol-name)))) ;; Saving and Loading: (defun elfeed-db-save () "Write the database index to the filesystem." (elfeed-db-ensure) (setf elfeed-db (plist-put elfeed-db :version elfeed-db-version)) (mkdir elfeed-db-directory t) (let ((coding-system-for-write 'utf-8)) (with-temp-file (expand-file-name "index" elfeed-db-directory) (let ((standard-output (current-buffer)) (print-level nil) (print-length nil) (print-circle nil)) (princ (format ";;; Elfeed Database Index (version %s)\n\n" elfeed-db-version)) (when (eql elfeed-db-version 4) ;; Put empty dummy index in front (princ ";; Dummy index for backwards compatablity:\n") (prin1 (elfeed-db--dummy)) (princ "\n\n;; Real index:\n")) (prin1 elfeed-db) :success)))) (defun elfeed-db-save-safe () "Run `elfeed-db-save' without triggering any errors, for use as a safe hook." (ignore-errors (elfeed-db-save))) (defun elfeed-db-upgrade (db) "Upgrade the database from a previous format." (if (not (vectorp (plist-get db :index))) db ; Database is already in record format (let* ((new-db (elfeed-db--empty)) ;; Dynamically bind for other functions (elfeed-db-feeds (plist-get new-db :feeds)) (elfeed-db-entries (plist-get new-db :entries)) (elfeed-db-index (plist-get new-db :index))) ;; Fix up feeds (cl-loop with table = (plist-get new-db :feeds) for feed hash-values of (plist-get db :feeds) for id = (aref feed 1) for fixed = (elfeed-feed--create :id id :url (aref feed 2) :title (aref feed 3) :author (aref feed 4) :meta (aref feed 5)) do (setf (gethash id table) fixed)) ;; Fix up entries (cl-loop with table = (plist-get new-db :entries) with index = (plist-get new-db :index) for entry hash-values of (plist-get db :entries) for id = (aref entry 1) for content = (aref entry 5) for fixed = (elfeed-entry--create :id id :title (aref entry 2) :link (aref entry 3) :date (aref entry 4) :content (if (vectorp content) (elfeed-ref--create :id (aref content 1)) content) :content-type (aref entry 6) :enclosures (aref entry 7) :tags (aref entry 8) :feed-id (aref entry 9) :meta (aref entry 10)) do (setf (gethash id table) fixed) do (avl-tree-enter index id)) (plist-put new-db :last-update (plist-get db :last-update))))) (defun elfeed-db--empty () "Create an empty database object." `(:version ,elfeed-db-version :feeds ,(make-hash-table :test 'equal) :entries ,(make-hash-table :test 'equal) ;; Compiler may warn about this (bug#15327): :index ,(avl-tree-create #'elfeed-db-compare))) (defun elfeed-db--dummy () "Create an empty dummy database for Emacs 25 and earlier." (list :version "0.0.3" :feeds #s(hash-table size 65 test equal rehash-size 1.5 rehash-threshold 0.8 data ()) :entries #s(hash-table size 65 test equal rehash-size 1.5 rehash-threshold 0.8 data ()) :index [cl-struct-avl-tree- [nil nil nil 0] elfeed-db-compare])) ;; To cope with the incompatible struct changes in Emacs 26, Elfeed ;; uses version 4 of the database format when run under Emacs 26. This ;; version saves a dummy, empty index in front of the real database. A ;; user going from Emacs 26 to Emacs 25 will quietly load an empty ;; index since it's unreasonable to downgrade (would require rewriting ;; the Emacs reader from scratch). (defun elfeed-db-load () "Load the database index from the filesystem." (let ((index (expand-file-name "index" elfeed-db-directory)) (enable-local-variables nil)) ; don't set local variables from index! (if (not (file-exists-p index)) (setf elfeed-db (elfeed-db--empty)) ;; Override the default value for major-mode. There is no ;; preventing find-file-noselect from starting the default major ;; mode while also having it handle buffer conversion. Some ;; major modes crash Emacs when enabled in large buffers (e.g. ;; org-mode). This includes the Elfeed index, so we must not let ;; this happen. (cl-letf (((default-value 'major-mode) 'fundamental-mode)) (with-current-buffer (find-file-noselect index :nowarn) (goto-char (point-min)) (if (eql elfeed-db-version 4) ;; May need to skip over dummy database (let ((db-1 (read (current-buffer))) (db-2 (ignore-errors (read (current-buffer))))) (setf elfeed-db (or db-2 db-1))) ;; Just load first database (setf elfeed-db (read (current-buffer)))) (kill-buffer)))) ;; Perform an upgrade if necessary and possible (unless (equal (plist-get elfeed-db :version) elfeed-db-version) (ignore-errors (copy-file index (concat index ".backup"))) (message "Upgrading Elfeed index for Emacs 26 ...") (setf elfeed-db (elfeed-db-upgrade elfeed-db)) (message "Elfeed index upgrade complete.")) (setf elfeed-db-feeds (plist-get elfeed-db :feeds) elfeed-db-entries (plist-get elfeed-db :entries) elfeed-db-index (plist-get elfeed-db :index) ;; Internal function use required for security! (avl-tree--cmpfun elfeed-db-index) #'elfeed-db-compare))) (defun elfeed-db-unload () "Unload the database so that it can be operated on externally. Runs `elfeed-db-unload-hook' after unloading the database." (interactive) (elfeed-db-save) (setf elfeed-db nil elfeed-db-feeds nil elfeed-db-entries nil elfeed-db-index nil) (run-hooks 'elfeed-db-unload-hook)) (defun elfeed-db-ensure () "Ensure that the database has been loaded." (when (null elfeed-db) (elfeed-db-load))) (defun elfeed-db-size () "Return a count of the number of entries in the database." (let ((count-table (hash-table-count elfeed-db-entries)) (count-tree (avl-tree-size elfeed-db-index))) (if (= count-table count-tree) count-table (error "Elfeed database error: entry count mismatch.")))) ;; Metadata: (defun elfeed-meta--plist (thing) "Get the metadata plist for THING." (cl-typecase thing (elfeed-feed (elfeed-feed-meta thing)) (elfeed-entry (elfeed-entry-meta thing)) (otherwise (error "Don't know how to access metadata on %S" thing)))) (defun elfeed-meta--set-plist (thing plist) "Set the metadata plist on THING to PLIST." (cl-typecase thing (elfeed-feed (setf (elfeed-feed-meta thing) plist)) (elfeed-entry (setf (elfeed-entry-meta thing) plist)) (otherwise (error "Don't know how to access metadata on %S" thing)))) (defun elfeed-db--plist-fixup (plist) "Remove nil values from PLIST." (cl-loop for (k v) on plist by #'cddr when (not (null v)) collect k and collect v)) (defun elfeed-meta (thing key &optional default) "Access metadata for THING (entry, feed) under KEY." (or (plist-get (elfeed-meta--plist thing) key) default)) (defun elfeed-meta--put (thing key value) "Set metadata to VALUE on THING under KEY." (when (not (elfeed-readable-p value)) (error "New value must be readable.")) (let ((new-plist (plist-put (elfeed-meta--plist thing) key value))) (prog1 value (elfeed-meta--set-plist thing (elfeed-db--plist-fixup new-plist))))) (gv-define-setter elfeed-meta (value thing key &optional _default) `(elfeed-meta--put ,thing ,key ,value)) ;; Filesystem storage: (defvar elfeed-ref-archive nil "Index of archived/packed content.") (defvar elfeed-ref-cache nil "Temporary storage of the full archive content.") (cl-defstruct (elfeed-ref (:constructor elfeed-ref--create)) id) (defun elfeed-ref--file (ref) "Determine the storage filename for REF." (let* ((id (elfeed-ref-id ref)) (root (expand-file-name "data" elfeed-db-directory)) (subdir (expand-file-name (substring id 0 2) root))) (expand-file-name id subdir))) (cl-defun elfeed-ref-archive-filename (&optional (suffix "")) "Return the base filename of the archive files." (concat (expand-file-name "data/archive" elfeed-db-directory) suffix)) (defun elfeed-ref-archive-load () "Load the archived ref index." (let ((archive-index (elfeed-ref-archive-filename ".index"))) (if (file-exists-p archive-index) (with-temp-buffer (insert-file-contents archive-index) (setf elfeed-ref-archive (read (current-buffer)))) (setf elfeed-ref-archive :empty)))) (defun elfeed-ref-archive-ensure () "Ensure that the archive index is loaded." (when (null elfeed-ref-archive) (elfeed-ref-archive-load))) (defun elfeed-ref-exists-p (ref) "Return true if REF can be dereferenced." (elfeed-ref-archive-ensure) (or (and (hash-table-p elfeed-ref-archive) (not (null (gethash (elfeed-ref-id ref) elfeed-ref-archive)))) (file-exists-p (elfeed-ref--file ref)))) (defun elfeed-deref (ref) "Fetch the content behind the reference, or nil if non-existent." (elfeed-ref-archive-ensure) (if (not (elfeed-ref-p ref)) ref (let ((index (and (hash-table-p elfeed-ref-archive) (gethash (elfeed-ref-id ref) elfeed-ref-archive))) (archive-file (elfeed-ref-archive-filename ".gz")) (coding-system-for-read 'utf-8)) (if (and index (file-exists-p archive-file)) (progn (when (null elfeed-ref-cache) (with-temp-buffer (insert-file-contents archive-file) (setf elfeed-ref-cache (buffer-string))) ;; Clear cache on next turn. (run-at-time 0 nil (lambda () (setf elfeed-ref-cache nil)))) (substring elfeed-ref-cache (car index) (cdr index))) (let ((file (elfeed-ref--file ref))) (when (file-exists-p file) (with-temp-buffer (insert-file-contents file) (buffer-string)))))))) (defun elfeed-ref (content) "Create a reference to CONTENT, to be persistently stored." (if (elfeed-ref-p content) content (let* ((id (secure-hash 'sha1 (encode-coding-string content 'utf-8 t))) (ref (elfeed-ref--create :id id)) (file (elfeed-ref--file ref))) (prog1 ref (unless (elfeed-ref-exists-p ref) (mkdir (file-name-directory file) t) (let ((coding-system-for-write 'utf-8) ;; Content data loss is a tolerable risk. ;; Fsync will occur soon on index write anyway. (write-region-inhibit-fsync t)) (with-temp-file file (insert content)))))))) (defun elfeed-deref-entry (entry) "Move ENTRY's content to filesystem storage. Return the entry." (let ((content (elfeed-entry-content entry))) (prog1 entry (when (stringp content) (setf (elfeed-entry-content entry) (elfeed-ref content)))))) (defun elfeed-ref-delete (ref) "Remove the content behind REF from the database." (ignore-errors (delete-file (elfeed-ref--file ref)))) (defun elfeed-db-gc-empty-feeds () "Remove feeds with no entries from the database." (let ((seen (make-hash-table :test 'equal))) (with-elfeed-db-visit (entry feed) (setf (gethash (elfeed-feed-id feed) seen) feed)) (maphash (lambda (id _) (unless (gethash id seen) (remhash id elfeed-db-feeds))) elfeed-db-feeds))) (defun elfeed-db-gc (&optional stats-p) "Clean up unused content from the content database. If STATS is true, return the space cleared in bytes." (elfeed-db-gc-empty-feeds) (let* ((data (expand-file-name "data" elfeed-db-directory)) (dirs (directory-files data t "^[0-9a-z]\\{2\\}$")) (ids (cl-mapcan (lambda (d) (directory-files d nil nil t)) dirs)) (table (make-hash-table :test 'equal))) (dolist (id ids) (setf (gethash id table) nil)) (with-elfeed-db-visit (entry _) (let ((content (elfeed-entry-content entry))) (when (elfeed-ref-p content) (setf (gethash (elfeed-ref-id content) table) t)))) (cl-loop for id hash-keys of table using (hash-value used) for used-p = (or used (member id '("." ".."))) when (and (not used-p) stats-p) sum (let* ((ref (elfeed-ref--create :id id)) (file (elfeed-ref--file ref))) (* 1.0 (nth 7 (file-attributes file)))) unless used-p do (elfeed-ref-delete (elfeed-ref--create :id id)) finally (cl-loop for dir in dirs when (elfeed-directory-empty-p dir) do (delete-directory dir))))) (defun elfeed-db-pack () "Pack all content into a single archive for efficient storage." (let ((coding-system-for-write 'utf-8) (next-archive (make-hash-table :test 'equal)) (packed ())) (make-directory (expand-file-name "data" elfeed-db-directory) t) (with-temp-file (elfeed-ref-archive-filename ".gz") (with-elfeed-db-visit (entry _) (let ((ref (elfeed-entry-content entry)) (start (1- (point)))) (when (elfeed-ref-p ref) (let ((content (elfeed-deref ref))) (when content (push ref packed) (insert content) (setf (gethash (elfeed-ref-id ref) next-archive) (cons start (1- (point)))))))))) (with-temp-file (elfeed-ref-archive-filename ".index") (let ((standard-output (current-buffer)) (print-level nil) (print-length nil) (print-circle nil)) (prin1 next-archive))) (setf elfeed-ref-cache nil) (setf elfeed-ref-archive next-archive) (mapc #'elfeed-ref-delete packed) :success)) (defun elfeed-db-compact () "Minimize the Elfeed database storage size on the filesystem. This requires that auto-compression-mode can handle gzip-compressed files, so the gzip program must be in your PATH." (interactive) (unless (elfeed-gzip-supported-p) (error "aborting compaction: gzip auto-compression-mode unsupported")) (elfeed-db-pack) (elfeed-db-gc)) (defun elfeed-db-gc-safe () "Run `elfeed-db-gc' without triggering any errors, for use as a safe hook." (ignore-errors (elfeed-db-gc))) (unless noninteractive (add-hook 'kill-emacs-hook #'elfeed-db-gc-safe :append) (add-hook 'kill-emacs-hook #'elfeed-db-save-safe)) (provide 'elfeed-db) ;;; elfeed-db.el ends here elfeed-3.3.0/elfeed-curl.el0000644000175000017500000005112213566267252015323 0ustar dogslegdogsleg;;; elfeed-curl.el --- curl backend for Elfeed -*- lexical-binding: t; -*- ;;; Comments: ;; An alternative to `url-retrieve' and `url-queue' that fetches URLs ;; using the curl command line program. ;; The API is three functions: ;; * `elfeed-curl-retrieve' ;; * `elfeed-curl-retrieve-synchronously' ;; * `elfeed-curl-enqueue' ;; And has four buffer-local variables for use in callbacks: ;; * `elfeed-curl-headers' ;; * `elfeed-curl-status-code' ;; * `elfeed-curl-error-message' ;; * `elfeed-curl-location' ;; The buffer delivered to callbacks may contain multiple requests. It ;; will be narrowed to the specific content for the current request. ;; It's vitally important that callbacks do not kill the buffer ;; because it may be needed for other callbacks. It also means the ;; buffer won't necessarily be around when the callback returns. ;; Callbacks should also avoid editing the buffer, though this ;; generally shouldn't impact other requests. ;; Sometimes Elfeed asks curl to retrieve multiple requests and ;; deliver them concatenated. Due to the possibility of HTTP/1.0 being ;; involved — and other ambiguous-length protocols — there's no ;; perfectly unambiguous way to split the output. To work around this, ;; I use curl's --write-out to insert a randomly-generated token after ;; each request. It's highly unlikely (1 in ~1e38) that this token ;; will appear in content, so I can use it to identify the end of each ;; request. ;;; Code: (require 'url) (require 'cl-lib) (require 'elfeed-lib) (require 'elfeed-log) (defcustom elfeed-curl-program-name "curl" "Name/path by which to invoke the curl program." :group 'elfeed :type 'string) (defcustom elfeed-curl-max-connections 16 "Maximum number of concurrent fetches." :group 'elfeed :type 'integer) (defcustom elfeed-curl-timeout 30 "Maximum number of seconds a fetch is allowed to take once started." :group 'elfeed :type 'integer) (defcustom elfeed-curl-extra-arguments () "A list of additional arguments to pass to cURL. These extra arguments are appended after Elfeed's own arguments, and care must be taken to not interfere with Elfeed's needs. The guideline is to avoid arguments that change anything about cURL's output format." :group 'elfeed :type '(repeat string)) (defvar elfeed-curl-queue () "List of pending curl requests.") (defvar elfeed-curl-queue-active 0 "Number of concurrent requests currently active.") (defvar-local elfeed-curl-headers nil "Alist of HTTP response headers.") (defvar-local elfeed-curl-status-code nil "Numeric HTTP response code, nil for non-HTTP protocols.") (defvar-local elfeed-curl-error-message nil "Human-friendly message describing the error.") (defvar-local elfeed-curl-location nil "Actual URL fetched (after any redirects).") (defvar-local elfeed-curl--regions () "List of markers bounding separate requests.") (defvar-local elfeed-curl--requests () "List of URL / callback pairs for the current buffer.") (defvar-local elfeed-curl--token nil "Unique token that splits requests.") (defvar-local elfeed-curl--refcount nil "Number of callbacks waiting on the current buffer.") (defvar elfeed-curl--error-codes '((1 . "Unsupported protocol.") (2 . "Failed to initialize.") (3 . "URL malformed. The syntax was not correct.") (4 . "A feature or option that was needed to perform the desired request was not enabled or was explicitly disabled at build-time.") (5 . "Couldn't resolve proxy. The given proxy host could not be resolved.") (6 . "Couldn't resolve host. The given remote host was not resolved.") (7 . "Failed to connect to host.") (8 . "FTP weird server reply. The server sent data curl couldn't parse.") (9 . "FTP access denied.") (11 . "FTP weird PASS reply.") (13 . "FTP weird PASV reply.") (14 . "FTP weird 227 format.") (15 . "FTP can't get host.") (16 . "A problem was detected in the HTTP2 framing layer.") (17 . "FTP couldn't set binary.") (18 . "Partial file. Only a part of the file was transferred.") (19 . "FTP couldn't download/access the given file, the RETR (or similar) command failed.") (21 . "FTP quote error. A quote command returned error from the server.") (22 . "HTTP page not retrieved.") (23 . "Write error.") (25 . "FTP couldn't STOR file.") (26 . "Read error. Various reading problems.") (27 . "Out of memory. A memory allocation request failed.") (28 . "Operation timeout.") (30 . "FTP PORT failed.") (31 . "FTP couldn't use REST.") (33 . "HTTP range error. The range \"command\" didn't work.") (34 . "HTTP post error. Internal post-request generation error.") (35 . "SSL connect error. The SSL handshaking failed.") (36 . "FTP bad download resume.") (37 . "FILE couldn't read file.") (38 . "LDAP bind operation failed.") (39 . "LDAP search failed.") (41 . "Function not found. A required LDAP function was not found.") (42 . "Aborted by callback.") (43 . "Internal error. A function was called with a bad parameter.") (45 . "Interface error. A specified outgoing interface could not be used.") (47 . "Too many redirects.") (48 . "Unknown option specified to libcurl.") (49 . "Malformed telnet option.") (51 . "The peer's SSL certificate or SSH MD5 fingerprint was not OK.") (52 . "The server didn't reply anything, which here is considered an error.") (53 . "SSL crypto engine not found.") (54 . "Cannot set SSL crypto engine as default.") (55 . "Failed sending network data.") (56 . "Failure in receiving network data.") (58 . "Problem with the local certificate.") (59 . "Couldn't use specified SSL cipher.") (60 . "Peer certificate cannot be authenticated with known CA certificates.") (61 . "Unrecognized transfer encoding.") (62 . "Invalid LDAP URL.") (63 . "Maximum file size exceeded.") (64 . "Requested FTP SSL level failed.") (65 . "Sending the data requires a rewind that failed.") (66 . "Failed to initialise SSL Engine.") (67 . "The user name, password, or similar was not accepted and curl failed to log in.") (68 . "File not found on TFTP server.") (69 . "Permission problem on TFTP server.") (70 . "Out of disk space on TFTP server.") (71 . "Illegal TFTP operation.") (72 . "Unknown TFTP transfer ID.") (73 . "File already exists (TFTP).") (74 . "No such user (TFTP).") (75 . "Character conversion failed.") (76 . "Character conversion functions required.") (77 . "Problem with reading the SSL CA cert (path? access rights?).") (78 . "The resource referenced in the URL does not exist.") (79 . "An unspecified error occurred during the SSH session.") (80 . "Failed to shut down the SSL connection.") (82 . "Could not load CRL file, missing or wrong format (added in 7.19.0).") (83 . "Issuer check failed (added in 7.19.0).") (84 . "The FTP PRET command failed") (85 . "RTSP: mismatch of CSeq numbers") (86 . "RTSP: mismatch of Session Identifiers") (87 . "unable to parse FTP file list") (88 . "FTP chunk callback reported error") (89 . "No connection available, the session will be queued") (90 . "SSL public key does not matched pinned public key"))) (defvar elfeed-curl--capabilities-cache (make-hash-table :test 'eq :weakness 'key) "Used to avoid invoking curl more than once for version info.") (defun elfeed-curl-get-capabilities () "Return capabilities plist for the curl at `elfeed-curl-program-name'. :version -- cURL's version string :compression -- non-nil if --compressed is supported" (let* ((cache elfeed-curl--capabilities-cache) (cache-value (gethash elfeed-curl-program-name cache))) (if cache-value cache-value (with-temp-buffer (call-process elfeed-curl-program-name nil t nil "--version") (let ((version (progn (setf (point) (point-min)) (when (re-search-forward "[.0-9]+" nil t) (match-string 0)))) (compression (progn (setf (point) (point-min)) (not (null (re-search-forward "libz\\>" nil t)))))) (setf (gethash elfeed-curl-program-name cache) `(:version ,version :compression ,compression))))))) (defun elfeed-curl-get-version () "Return the version of curl for `elfeed-curl-program-name'." (plist-get (elfeed-curl-get-capabilities) :version)) (make-obsolete 'elfeed-curl-get-version 'elfeed-curl-get-capabilities "3.0.1") (defun elfeed-curl--token () "Return a unique, random string that prints as a symbol without escapes. This token is used to split requests. The % is excluded since it's special to --write-out." (let* ((token (make-string 22 ?=)) (set "!$&*+-/0123456789:<>@ABCDEFGHIJKLMNOPQRSTUVWXYZ^_\ abcdefghijklmnopqrstuvwxyz|~")) (prog1 token ; workaround bug#16206 (dotimes (i (- (length token) 2)) (setf (aref token (1+ i)) (aref set (cl-random (length set)))))))) (defun elfeed-curl--parse-write-out () "Parse curl's write-out (-w) messages into `elfeed-curl--regions'." (widen) (setf (point) (point-max) elfeed-curl--regions ()) (while (> (point) (point-min)) (search-backward elfeed-curl--token) (cl-decf (point)) (let ((end (point))) (cl-destructuring-bind (_ . header) (read (current-buffer)) (setf (point) end) ;; Find next sentinel token (if (search-backward elfeed-curl--token nil t) (search-forward ")" nil t) (setf (point) (point-min))) (let* ((header-start (point)) (header-end (+ (point) header)) (content-start (+ (point) header)) (content-end end) (regions (list header-start header-end content-start content-end)) (markers (cl-loop for p in regions for marker = (make-marker) collect (set-marker marker p)))) (push markers elfeed-curl--regions)))))) (defun elfeed-curl--narrow (kind n) "Narrow to Nth region of KIND (:header, :content)." (let ((region (nth n elfeed-curl--regions))) (cl-destructuring-bind (h-start h-end c-start c-end) region (cl-ecase kind (:header (narrow-to-region h-start h-end)) (:content (narrow-to-region c-start c-end)))))) (defun elfeed-curl--parse-headers () "Parse the current HTTP response headers into buffer-locals. Sets `elfeed-curl-headers'and `elfeed-curl-status-code'. Use `elfeed-curl--narrow' to select a header." (when (> (- (point-max) (point-min)) 0) (setf (point) (point-max)) (re-search-backward "HTTP/[.0-9]+ +\\([0-9]+\\)") (setf elfeed-curl-status-code (string-to-number (match-string 1))) (cl-loop initially (setf (point) (point-max)) while (re-search-backward "^\\([^:]+\\): +\\([^\r\n]+\\)" nil t) for key = (downcase (match-string 1)) for value = (match-string 2) collect (cons key value) into headers finally (setf elfeed-curl-headers headers)))) (defun elfeed-curl--decode () "Try to decode the buffer based on the headers." (let ((content-type (cdr (assoc "Content-Type" elfeed-curl-headers)))) (if (and content-type (string-match "charset=\\(.+\\)" content-type)) (decode-coding-region (point-min) (point-max) (coding-system-from-name (match-string 1 content-type))) (decode-coding-region (point-min) (point-max) 'utf-8)))) (defun elfeed-curl--final-location (location headers) "Given start LOCATION and HEADERS, find the final location." (cl-loop for (key . value) in headers when (equal key "location") do (setf location (elfeed-update-location location value)) finally return location)) (defun elfeed-curl--args (url token &optional headers method data) "Build an argument list for curl for URL. URL can be a string or a list of URL strings." (let* ((args ()) (capabilities (elfeed-curl-get-capabilities))) (push "--disable" args) (when (plist-get capabilities :compression) (push "--compressed" args)) (push "--silent" args) (push "--location" args) (push (format "-w(%s . %%{size_header})" token) args) (push (format "-m%s" elfeed-curl-timeout) args) (push "-D-" args) (dolist (header headers) (cl-destructuring-bind (key . value) header (push (format "-H%s: %s" key value) args))) (when method (push (format "-X%s" method) args)) (when data (push (format "-d%s" data) args)) (setf args (nconc (reverse elfeed-curl-extra-arguments) args)) (if (listp url) (nconc (nreverse args) url) (nreverse (cons url args))))) (defun elfeed-curl--prepare-response (url n) "Prepare response N for delivery to user." (elfeed-curl--narrow :header n) (elfeed-curl--parse-headers) (setf elfeed-curl-location (elfeed-curl--final-location url elfeed-curl-headers)) (elfeed-curl--narrow :content n) (elfeed-curl--decode) (current-buffer)) (cl-defun elfeed-curl-retrieve-synchronously (url &key headers method data) "Retrieve the contents for URL and return a new buffer with them. HEADERS is an alist of additional headers to add to the HTTP request. METHOD is the HTTP method to use. DATA is the content to include in the request." (with-current-buffer (generate-new-buffer " *curl*") (setf elfeed-curl--token (elfeed-curl--token)) (let ((args (elfeed-curl--args url elfeed-curl--token headers method data)) (coding-system-for-read 'binary)) (apply #'call-process elfeed-curl-program-name nil t nil args)) (elfeed-curl--parse-write-out) (elfeed-curl--prepare-response url 0))) (defun elfeed-curl--call-callback (buffer n url cb) "Prepare the buffer for callback N and call it." (let ((result nil)) (with-current-buffer buffer (setf elfeed-curl-error-message "unable to parse curl response") (unwind-protect (progn (elfeed-curl--prepare-response url n) (if (and (>= elfeed-curl-status-code 400) (<= elfeed-curl-status-code 599)) (setf elfeed-curl-error-message (format "HTTP %d" elfeed-curl-status-code)) (setf result t elfeed-curl-error-message nil))) ;; Always call callback (unwind-protect (funcall cb result) ;; Always clean up (when (zerop (cl-decf elfeed-curl--refcount)) (kill-buffer))))))) (defun elfeed-curl--fail-callback (buffer cb) "Inform the callback the request failed." (with-current-buffer buffer (unwind-protect (funcall cb nil) (when (zerop (cl-decf elfeed-curl--refcount)) (kill-buffer))))) (defun elfeed-curl--sentinel (process status) "Manage the end of a curl process' life." (let ((buffer (process-buffer process))) (with-current-buffer buffer ;; Fire off callbacks in separate interpreter turns so they can ;; each fail in isolation from each other. (if (equal status "finished\n") (cl-loop with handler = #'elfeed-curl--call-callback initially do (elfeed-curl--parse-write-out) for (url . cb) in elfeed-curl--requests for n upfrom 0 do (run-at-time 0 nil handler buffer n url cb)) (if (string-match "exited abnormally with code \\([0-9]+\\)" status) (let* ((code (string-to-number (match-string 1 status))) (message (cdr (assoc code elfeed-curl--error-codes)))) (setf elfeed-curl-error-message (format "(%d) %s" code (or message "Unknown curl error!")))) (setf elfeed-curl-error-message status)) (cl-loop with handler = #'elfeed-curl--fail-callback for (_ . cb) in elfeed-curl--requests do (run-at-time 0 nil handler buffer cb)))))) (cl-defun elfeed-curl-retrieve (url cb &key headers method data) "Retrieve URL contents asynchronously, calling CB with one status argument. The callback must *not* kill the buffer! The destination buffer is set at the current buffer for the callback. HEADERS is an alist of additional headers to add to HTTP requests. METHOD is the HTTP method to use. DATA is the content to include in the request. URL can be a list of URLs, which will fetch them all in the same curl process. In this case, CB can also be either a list of the same length, or just a single function to be called once for each URL in the list. Headers will be common to all requests. A TCP or DNS failure in one will cause all to fail, but 4xx and 5xx results will not." (with-current-buffer (generate-new-buffer " *curl*") (setf elfeed-curl--token (elfeed-curl--token)) (let* ((coding-system-for-read 'binary) (process-connection-type nil) (args (elfeed-curl--args url elfeed-curl--token headers method data)) (process (apply #'start-process "elfeed-curl" (current-buffer) elfeed-curl-program-name args))) (prog1 process (if (listp url) (progn (when (functionp cb) (setf cb (make-list (length url) cb))) (setf elfeed-curl--requests (cl-mapcar #'cons url cb) elfeed-curl--refcount (length url))) (push (cons url cb) elfeed-curl--requests) (setf elfeed-curl--refcount 1)) (setf (process-sentinel process) #'elfeed-curl--sentinel))))) (defun elfeed-curl--request-key (url headers method data) "Try to fetch URLs with matching keys at the same time." (unless (listp url) (let* ((urlobj (url-generic-parse-url url))) (list (url-type urlobj) (url-host urlobj) (url-portspec urlobj) headers method data)))) (defun elfeed-curl--queue-consolidate (queue-in) "Group compatible requests together and return a new queue. Compatible means the requests have the same protocol, domain, port, headers, method, and body, allowing them to be used safely in the same curl invocation." (let ((table (make-hash-table :test 'equal)) (keys ()) (queue-out ())) (dolist (entry queue-in) (cl-destructuring-bind (url _ headers method data) entry (let* ((key (elfeed-curl--request-key url headers method data))) (push key keys) (push entry (gethash key table nil))))) (dolist (key (nreverse keys)) (let ((entry (gethash key table))) (when entry (let ((rotated (list (nreverse (cl-mapcar #'car entry)) (nreverse (cl-mapcar #'cadr entry)) (cl-caddar entry) (elt (car entry) 3) (elt (car entry) 4)))) (push rotated queue-out) (setf (gethash key table) nil))))) (nreverse queue-out))) (defun elfeed-curl--queue-wrap (cb) "Wrap the curl CB so that it operates the queue." (lambda (status) (cl-decf elfeed-curl-queue-active) (elfeed-curl--run-queue) (funcall cb status))) (defvar elfeed-curl--run-queue-queued nil "Non-nil if run-queue has already been queued for the next turn.") (defun elfeed-curl--run-queue () "Possibly fire off some new requests." (when elfeed-curl--run-queue-queued (setf elfeed-curl--run-queue-queued nil ;; Try to consolidate the new requests. elfeed-curl-queue (elfeed-curl--queue-consolidate elfeed-curl-queue))) (while (and (< elfeed-curl-queue-active elfeed-curl-max-connections) (> (length elfeed-curl-queue) 0)) (cl-destructuring-bind (url cb headers method data) (pop elfeed-curl-queue) (elfeed-log 'debug "retrieve %s" url) (cl-incf elfeed-curl-queue-active 1) (elfeed-curl-retrieve url (if (functionp cb) (elfeed-curl--queue-wrap cb) (cons (elfeed-curl--queue-wrap (car cb)) (cdr cb))) :headers headers :method method :data data)))) (cl-defun elfeed-curl-enqueue (url cb &key headers method data) "Just like `elfeed-curl-retrieve', but restricts concurrent fetches." (unless (or (stringp url) (and (listp url) (cl-every #'stringp url))) ;; Signal error synchronously instead of asynchronously in the timer (signal 'wrong-type-argument (list 'string-p-or-string-list-p url))) (let ((entry (list url cb headers method data))) (setf elfeed-curl-queue (nconc elfeed-curl-queue (list entry))) (unless elfeed-curl--run-queue-queued (run-at-time 0 nil #'elfeed-curl--run-queue) (setf elfeed-curl--run-queue-queued t)))) (provide 'elfeed-curl) ;;; elfeed-curl.el ends here