#+BEGIN_SRC emacs-lisp
(if (>= emacs-major-version 24)
(progn
- (add-to-list 'load-path "~/.emacs.d/elpa/elfeed-20191227.426")
- (add-to-list 'load-path "~/.emacs.d/elpa/elfeed-org-20181015.1100")
+ (add-to-list 'load-path "~/.emacs.d/elpa/elfeed-20210822.2129")
+ (add-to-list 'load-path "~/.emacs.d/elpa/elfeed-org-20221118.852")
(require 'elfeed-org)
(elfeed-org)
(setq rmh-elfeed-org-files (list "~/org/elfeed.org"))))
+++ /dev/null
-;;; elfeed-autoloads.el --- automatically extracted autoloads
-;;
-;;; Code:
-
-(add-to-list 'load-path (directory-file-name
- (or (file-name-directory #$) (car load-path))))
-
-\f
-;;;### (autoloads nil "elfeed" "elfeed.el" (0 0 0 0))
-;;; Generated autoloads from elfeed.el
-
-(autoload 'elfeed-update "elfeed" "\
-Update all the feeds in `elfeed-feeds'.
-
-\(fn)" t nil)
-
-(autoload 'elfeed "elfeed" "\
-Enter elfeed.
-
-\(fn)" t nil)
-
-(autoload 'elfeed-load-opml "elfeed" "\
-Load feeds from an OPML file into `elfeed-feeds'.
-When called interactively, the changes to `elfeed-feeds' are
-saved to your customization file.
-
-\(fn FILE)" t nil)
-
-(autoload 'elfeed-export-opml "elfeed" "\
-Export the current feed listing to OPML-formatted FILE.
-
-\(fn FILE)" t nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "elfeed" '("elfeed-")))
-
-;;;***
-\f
-;;;### (autoloads nil "elfeed-csv" "elfeed-csv.el" (0 0 0 0))
-;;; Generated autoloads from elfeed-csv.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "elfeed-csv" '("elfeed-csv-")))
-
-;;;***
-\f
-;;;### (autoloads nil "elfeed-curl" "elfeed-curl.el" (0 0 0 0))
-;;; Generated autoloads from elfeed-curl.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "elfeed-curl" '("elfeed-curl-")))
-
-;;;***
-\f
-;;;### (autoloads nil "elfeed-db" "elfeed-db.el" (0 0 0 0))
-;;; Generated autoloads from elfeed-db.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "elfeed-db" '("elfeed-" "with-elfeed-db-visit")))
-
-;;;***
-\f
-;;;### (autoloads nil "elfeed-lib" "elfeed-lib.el" (0 0 0 0))
-;;; Generated autoloads from elfeed-lib.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "elfeed-lib" '("elfeed-")))
-
-;;;***
-\f
-;;;### (autoloads nil "elfeed-link" "elfeed-link.el" (0 0 0 0))
-;;; Generated autoloads from elfeed-link.el
-
-(autoload 'elfeed-link-store-link "elfeed-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-<prop>. See `elfeed-entry--create' for the list
-of available props.
-
-\(fn)" nil nil)
-
-(autoload 'elfeed-link-open "elfeed-link" "\
-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.
-
-\(fn FILTER-OR-ID)" nil nil)
-
-(eval-after-load 'org `(funcall ',(lambda nil (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))))))
-
-;;;***
-\f
-;;;### (autoloads nil "elfeed-log" "elfeed-log.el" (0 0 0 0))
-;;; Generated autoloads from elfeed-log.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "elfeed-log" '("elfeed-log")))
-
-;;;***
-\f
-;;;### (autoloads nil "elfeed-search" "elfeed-search.el" (0 0 0 0))
-;;; Generated autoloads from elfeed-search.el
-
-(autoload 'elfeed-search-bookmark-handler "elfeed-search" "\
-Jump to an elfeed-search bookmarked location.
-
-\(fn RECORD)" nil nil)
-
-(autoload 'elfeed-search-desktop-restore "elfeed-search" "\
-Restore the state of an elfeed-search buffer on desktop restore.
-
-\(fn FILE-NAME BUFFER-NAME SEARCH-FILTER)" nil nil)
-
-(add-to-list 'desktop-buffer-mode-handlers '(elfeed-search-mode . elfeed-search-desktop-restore))
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "elfeed-search" '("elfeed-s")))
-
-;;;***
-\f
-;;;### (autoloads nil "elfeed-show" "elfeed-show.el" (0 0 0 0))
-;;; Generated autoloads from elfeed-show.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "elfeed-show" '("elfeed-")))
-
-;;;***
-\f
-;;;### (autoloads nil "xml-query" "xml-query.el" (0 0 0 0))
-;;; Generated autoloads from xml-query.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "xml-query" '("xml-query")))
-
-;;;***
-\f
-;;;### (autoloads nil nil ("elfeed-pkg.el") (0 0 0 0))
-
-;;;***
-\f
-;; Local Variables:
-;; version-control: never
-;; no-byte-compile: t
-;; no-update-autoloads: t
-;; coding: utf-8
-;; End:
-;;; elfeed-autoloads.el ends here
+++ /dev/null
-;;; 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
+++ /dev/null
-;;; 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
+++ /dev/null
-;;; 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
+++ /dev/null
-;;; 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 "</%s>" 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 "<html></html>")
- (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
+++ /dev/null
-;;; 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-<prop>. 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
+++ /dev/null
-;;; 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
+++ /dev/null
-(define-package "elfeed" "20191227.426" "an Emacs Atom/RSS feed reader"
- '((emacs "24.3")))
-;; Local Variables:
-;; no-byte-compile: t
-;; End:
+++ /dev/null
-;;; 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 ())
- (not-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))))
- (?~ (let ((re (substring element 1)))
- (when (elfeed-valid-regexp-p re)
- (push re not-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))
- ,@(when not-feeds
- (list :not-feeds not-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))
- (not-feeds (plist-get filter :not-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))
- (dolist (feed not-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))
- (not-feeds (plist-get filter :not-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))
- (cl-notany (lambda (f)
- (or (string-match-p f feed-id)
- (string-match-p f feed-title)))
- not-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))
- (not-feeds (plist-get filter :not-feeds)))
- `(lambda (,(if (or after matches not-matches must-have must-not-have)
- 'entry
- '_entry)
- ,(if (or feeds not-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 (or feeds not-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 not-feeds
- `((not
- (or ,@(cl-loop
- for regex in not-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
+++ /dev/null
-;;; 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 "c" #'elfeed-kill-link-url-at-point)
- (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 <base> to work around libxml-parse-html-region bug
- (when base-url
- (insert (format "<base href=\"%s\">" 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 "<a href=\"%s\">%s</a>" 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)))
-
-(defun elfeed-kill-link-url-at-point ()
- "Get link URL at point and store in kill-ring."
- (interactive)
- (let ((url (or (elfeed-get-link-at-point)
- (elfeed-get-url-at-point))))
- (if url
- (progn (kill-new url) (message url))
- (call-interactively 'shr-copy-url))))
-
-(provide 'elfeed-show)
-
-;;; elfeed-show.el ends here
+++ /dev/null
-;;; 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 <wellonsNOSPAMnullprogram.com>
-;; 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 <regex>), 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 "<?xml version=\"1.0\"?>\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
+++ /dev/null
-;;; 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
--- /dev/null
+# 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)
+ * [Elfeed Rules!](https://noonker.github.io/posts/2020-04-22-elfeed/) ([reddit](https://old.reddit.com/r/emacs/comments/g6oowz/elfeed_rules/))
+ * [Elfeed with Tiny Tiny RSS](https://codingquark.com/emacs/2020/04/19/elfeed-protocol-ttrss.html) ([hn](https://news.ycombinator.com/item?id=22915200))
+ * [Open Emacs elfeed links in the background](http://xenodium.com/open-emacs-elfeed-links-in-background/)
+ * [Using Emacs 72](https://cestlaz.github.io/post/using-emacs-72-customizing-elfeed/)
+ * [Lazy Elfeed](https://karthinks.com/blog/lazy-elfeed/)
+ * [Using Elfeed to View Videos](https://joshrollinswrites.com/help-desk-head-desk/20200611/)
+ * [Manage podcasts in Emacs with Elfeed and Bongo](https://protesilaos.com/codelog/2020-09-11-emacs-elfeed-bongo/)
+ * [... more ...](http://nullprogram.com/tags/elfeed/)
+ * [... and more ...](http://pragmaticemacs.com/category/elfeed/)
+
+[](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-protocol](https://github.com/fasheng/elfeed-protocol)
+* [elfeed-score](https://github.com/sp1ff/elfeed-score)
+* [Elfeed Android interface](https://github.com/areina/elfeed-cljsrn)
+ ([Google Play](https://play.google.com/store/apps/details?id=com.elfeedcljsrn))
+* [elfeed-dashboard](https://github.com/Manoj321/elfeed-dashboard)
+
+## 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.
+
+ * <kbd>g</kbd>: refresh view of the feed listing
+ * <kbd>G</kbd>: fetch feed updates from the servers
+ * <kbd>s</kbd>: update the search filter (see tags)
+ * <kbd>c</kbd>: 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 <kbd>G</kbd> 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/"
+ "https://planet.emacslife.com/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.
+
+ * <kbd>RET</kbd>: view selected entry in a buffer
+ * <kbd>b</kbd>: open selected entries in your browser (`browse-url`)
+ * <kbd>y</kbd>: copy selected entries URL to the clipboard
+ * <kbd>r</kbd>: mark selected entries as read
+ * <kbd>u</kbd>: mark selected entries as unread
+ * <kbd>+</kbd>: add a specific tag to selected entries
+ * <kbd>-</kbd>: 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 <kbd>s</kbd>) 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
+matches at least one of the `=` expressions will be shown.
+
+A component beginning with a `~` is a regular expression matching the
+entry's feed (title or URL). Only entries belonging to a feed that
+matches none 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.
--- /dev/null
+;;; elfeed-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*-
+;;
+;;; Code:
+
+(add-to-list 'load-path (directory-file-name
+ (or (file-name-directory #$) (car load-path))))
+
+\f
+;;;### (autoloads nil "elfeed" "elfeed.el" (0 0 0 0))
+;;; Generated autoloads from elfeed.el
+
+(autoload 'elfeed-update "elfeed" "\
+Update all the feeds in `elfeed-feeds'." t nil)
+
+(autoload 'elfeed "elfeed" "\
+Enter elfeed." t nil)
+
+(autoload 'elfeed-load-opml "elfeed" "\
+Load feeds from an OPML file into `elfeed-feeds'.
+When called interactively, the changes to `elfeed-feeds' are
+saved to your customization file.
+
+\(fn FILE)" t nil)
+
+(autoload 'elfeed-export-opml "elfeed" "\
+Export the current feed listing to OPML-formatted FILE.
+
+\(fn FILE)" t nil)
+
+(register-definition-prefixes "elfeed" '("elfeed-"))
+
+;;;***
+\f
+;;;### (autoloads nil "elfeed-csv" "elfeed-csv.el" (0 0 0 0))
+;;; Generated autoloads from elfeed-csv.el
+
+(register-definition-prefixes "elfeed-csv" '("elfeed-csv-"))
+
+;;;***
+\f
+;;;### (autoloads nil "elfeed-curl" "elfeed-curl.el" (0 0 0 0))
+;;; Generated autoloads from elfeed-curl.el
+
+(register-definition-prefixes "elfeed-curl" '("elfeed-curl-"))
+
+;;;***
+\f
+;;;### (autoloads nil "elfeed-db" "elfeed-db.el" (0 0 0 0))
+;;; Generated autoloads from elfeed-db.el
+
+(register-definition-prefixes "elfeed-db" '("elfeed-" "with-elfeed-db-visit"))
+
+;;;***
+\f
+;;;### (autoloads nil "elfeed-lib" "elfeed-lib.el" (0 0 0 0))
+;;; Generated autoloads from elfeed-lib.el
+
+(register-definition-prefixes "elfeed-lib" '("elfeed-"))
+
+;;;***
+\f
+;;;### (autoloads nil "elfeed-link" "elfeed-link.el" (0 0 0 0))
+;;; Generated autoloads from elfeed-link.el
+
+(autoload 'elfeed-link-store-link "elfeed-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-<prop>. See `elfeed-entry--create' for the list
+of available props." nil nil)
+
+(autoload 'elfeed-link-open "elfeed-link" "\
+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.
+
+\(fn FILTER-OR-ID)" nil nil)
+
+(eval-after-load 'org `(funcall ',(lambda nil (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))))))
+
+;;;***
+\f
+;;;### (autoloads nil "elfeed-log" "elfeed-log.el" (0 0 0 0))
+;;; Generated autoloads from elfeed-log.el
+
+(register-definition-prefixes "elfeed-log" '("elfeed-log"))
+
+;;;***
+\f
+;;;### (autoloads nil "elfeed-search" "elfeed-search.el" (0 0 0 0))
+;;; Generated autoloads from elfeed-search.el
+
+(autoload 'elfeed-search-bookmark-handler "elfeed-search" "\
+Jump to an elfeed-search bookmarked location.
+
+\(fn RECORD)" nil nil)
+
+(autoload 'elfeed-search-desktop-restore "elfeed-search" "\
+Restore the state of an elfeed-search buffer on desktop restore.
+
+\(fn FILE-NAME BUFFER-NAME SEARCH-FILTER)" nil nil)
+
+(add-to-list 'desktop-buffer-mode-handlers '(elfeed-search-mode . elfeed-search-desktop-restore))
+
+(register-definition-prefixes "elfeed-search" '("elfeed-s"))
+
+;;;***
+\f
+;;;### (autoloads nil "elfeed-show" "elfeed-show.el" (0 0 0 0))
+;;; Generated autoloads from elfeed-show.el
+
+(autoload 'elfeed-show-bookmark-handler "elfeed-show" "\
+Show the bookmarked entry saved in the `RECORD'.
+
+\(fn RECORD)" nil nil)
+
+(register-definition-prefixes "elfeed-show" '("elfeed-"))
+
+;;;***
+\f
+;;;### (autoloads nil "xml-query" "xml-query.el" (0 0 0 0))
+;;; Generated autoloads from xml-query.el
+
+(register-definition-prefixes "xml-query" '("xml-query"))
+
+;;;***
+\f
+;;;### (autoloads nil nil ("elfeed-pkg.el") (0 0 0 0))
+
+;;;***
+\f
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; coding: utf-8
+;; End:
+;;; elfeed-autoloads.el ends here
--- /dev/null
+;;; 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
--- /dev/null
+;;; 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
+:protocols -- symbol list of supported protocols
+:features -- string list of supported features"
+ (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))))
+ (protocols
+ (progn
+ (setf (point) (point-min))
+ (when (re-search-forward "^Protocols: \\(.*\\)$" nil t)
+ (mapcar #'intern (split-string (match-string 1))))))
+ (features
+ (progn
+ (setf (point) (point-min))
+ (when (re-search-forward "^Features: \\(.*\\)$")
+ (split-string (match-string 1))))))
+ (setf (gethash elfeed-curl-program-name cache)
+ (list :version version
+ :compression (not (null (member "libz" features)))
+ :protocols protocols
+ :features features)))))))
+
+(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-http-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 protocol)
+ "Prepare response N for delivery to user."
+ (elfeed-curl--narrow :header n)
+ (when (eq protocol 'http)
+ (elfeed-curl--parse-http-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 (elfeed-curl--protocol-type url))))
+
+(defun elfeed-curl--protocol-type (url)
+ (let ((scheme (intern (or (url-type (url-generic-parse-url url)) "nil"))))
+ (cl-case scheme
+ ((https nil) 'http)
+ (otherwise scheme))))
+
+(defun elfeed-curl--call-callback (buffer n url cb)
+ "Prepare the buffer for callback N and call it."
+ (let ((result nil)
+ (protocol (elfeed-curl--protocol-type url)))
+ (with-current-buffer buffer
+ (setf elfeed-curl-error-message "unable to parse curl response")
+ (unwind-protect
+ (progn
+ (elfeed-curl--prepare-response url n protocol)
+ (cond ((eq protocol 'file)
+ ;; No status code is returned by curl for file:// urls
+ (setf result t
+ elfeed-curl-error-message nil))
+ ((eq protocol 'gopher)
+ (setf result t
+ elfeed-curl-error-message nil
+ elfeed-curl-status-code nil))
+ ((and (>= elfeed-curl-status-code 400)
+ (<= elfeed-curl-status-code 599))
+ (setf elfeed-curl-error-message
+ (format "HTTP %d" elfeed-curl-status-code)))
+ (t
+ (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))
+ (set-process-query-on-exit-flag process nil)
+ (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
--- /dev/null
+;;; 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
--- /dev/null
+;;; 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 'cl-lib)
+(require 'thingatpt)
+(require 'time-date)
+(require 'url-parse)
+(require 'url-util)
+(require 'xml)
+
+(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 "</%s>" 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 "<html></html>")
+ (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 (if (fboundp 'thing-at-point-url-at-point)
+ (thing-at-point-url-at-point)
+ (with-no-warnings (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
--- /dev/null
+;;; 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-<prop>. See `elfeed-entry--create' for the list
+of available props."
+ (cond ((derived-mode-p 'elfeed-search-mode)
+ (funcall (if (fboundp 'org-link-store-props)
+ #'org-link-store-props
+ (with-no-warnings #'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
--- /dev/null
+;;; 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
--- /dev/null
+(define-package "elfeed" "20210822.2129" "an Emacs Atom/RSS feed reader"
+ '((emacs "24.3"))
+ :commit "162d7d545ed41c27967d108c04aa31f5a61c8e16" :authors
+ '(("Christopher Wellons" . "wellonsNOSPAMnullprogram.com"))
+ :maintainer
+ '("Christopher Wellons" . "wellonsNOSPAMnullprogram.com")
+ :url "https://github.com/skeeto/elfeed")
+;; Local Variables:
+;; no-byte-compile: t
+;; End:
--- /dev/null
+;;; 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 last entry."
+ (interactive)
+ (setf (point) (point-max))
+ (forward-line -1))
+
+(defun elfeed-search-first-entry ()
+ "Place point on first 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))))))
+
+(defun elfeed-search--header ()
+ "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
+ ;; Provide format string via symbol value slot so that it will
+ ;; not be %-construct interpolated. The symbol is uninterned
+ ;; so that it's not *really* a global variable.
+ header-line-format
+ (let ((symbol (make-symbol "dummy")))
+ (put symbol 'risky-local-variable t)
+ `(:eval
+ (prog1 ',symbol
+ (set ',symbol (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 ())
+ (not-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))))
+ (?~ (let ((re (substring element 1)))
+ (when (elfeed-valid-regexp-p re)
+ (push re not-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))
+ ,@(when not-feeds
+ (list :not-feeds not-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 ()))
+ (cl-destructuring-bind (&key after before
+ must-have must-not-have
+ matches not-matches
+ feeds not-feeds
+ limit &allow-other-keys)
+ filter
+ (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))
+ (dolist (feed not-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."
+ (cl-destructuring-bind (&key must-have must-not-have
+ matches not-matches
+ feeds not-feeds
+ after limit &allow-other-keys)
+ filter
+ (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))
+ (cl-notany (lambda (f)
+ (or (string-match-p f feed-id)
+ (string-match-p f feed-title)))
+ not-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'."
+ (cl-destructuring-bind (&key after before
+ must-have must-not-have
+ matches not-matches
+ feeds not-feeds
+ limit &allow-other-keys)
+ filter
+ `(lambda (,(if (or after matches not-matches must-have must-not-have)
+ 'entry
+ '_entry)
+ ,(if (or feeds not-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 (or feeds not-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 not-feeds
+ `((not
+ (or ,@(cl-loop
+ for regex in not-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"))
+ (setf elfeed-search-last-update (float-time))))
+ (when (zerop (buffer-size))
+ ;; If nothing changed, force a header line update
+ (force-mode-line-update))
+ (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 ((buffer (current-buffer))
+ (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)))
+ ;; `browse-url' could have switched to another buffer if eww or another
+ ;; internal browser is used, but the remainder of the functions needs to
+ ;; run in the elfeed buffer.
+ (with-current-buffer buffer
+ (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
--- /dev/null
+;;; 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 'bookmark)
+(bookmark-maybe-load-default-file)
+
+(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.")
+
+(defcustom elfeed-show-entry-switch #'switch-to-buffer
+ "Function used to display the feed entry buffer."
+ :group 'elfeed
+ :type '(choice (function-item switch-to-buffer)
+ (function-item pop-to-buffer)
+ function))
+
+(defcustom elfeed-show-entry-delete #'elfeed-kill-buffer
+ "Function called when quitting from the elfeed-entry buffer.
+Called without arguments."
+ :group 'elfeed
+ :type '(choice (function-item elfeed-kill-buffer)
+ (function-item delete-window)
+ function))
+
+(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 "c" #'elfeed-kill-link-url-at-point)
+ (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)
+ (set (make-local-variable 'bookmark-make-record-function)
+ #'elfeed-show-bookmark-make-record)
+ (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 <base> to work around libxml-parse-html-region bug
+ (when base-url
+ (insert (format "<base href=\"%s\">" 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 "<a href=\"%s\">%s</a>" 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."
+ (cl-destructuring-bind (&key name uri email &allow-other-keys)
+ author
+ (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)
+ (when elfeed-search-remain-on-entry (forward-line 1))
+ (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)
+ (when elfeed-search-remain-on-entry (forward-line 1))
+ (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)))
+
+(defun elfeed-kill-link-url-at-point ()
+ "Get link URL at point and store in kill-ring."
+ (interactive)
+ (let ((url (or (elfeed-get-link-at-point)
+ (elfeed-get-url-at-point))))
+ (if url
+ (progn (kill-new url) (message url))
+ (call-interactively 'shr-copy-url))))
+
+;; Bookmarks
+
+;;;###autoload
+(defun elfeed-show-bookmark-handler (record)
+ "Show the bookmarked entry saved in the `RECORD'."
+ (let* ((id (bookmark-prop-get record 'id))
+ (entry (elfeed-db-get-entry id))
+ (position (bookmark-get-position record)))
+ (elfeed-show-entry entry)
+ (goto-char position)))
+
+(defun elfeed-show-bookmark-make-record ()
+ "Save the current position and the entry into a bookmark."
+ (let ((id (elfeed-entry-id elfeed-show-entry))
+ (position (point))
+ (title (elfeed-entry-title elfeed-show-entry)))
+ `(,(format "elfeed entry \"%s\"" title)
+ (id . ,id)
+ (location . ,title)
+ (position . ,position)
+ (handler . elfeed-show-bookmark-handler))))
+
+(provide 'elfeed-show)
+
+;;; elfeed-show.el ends here
--- /dev/null
+;;; 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 <wellonsNOSPAMnullprogram.com>
+;; URL: https://github.com/skeeto/elfeed
+
+;;; Commentary:
+
+;; Elfeed is a web feed client for Emacs, inspired by notmuch. See
+;; the README for full documentation.
+
+;;; 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.4.1")
+
+(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 <regex>), 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 "<?xml version=\"1.0\"?>\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
--- /dev/null
+;;; 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
+++ /dev/null
-;;; elfeed-org-autoloads.el --- automatically extracted autoloads
-;;
-;;; Code:
-
-(add-to-list 'load-path (directory-file-name
- (or (file-name-directory #$) (car load-path))))
-
-\f
-;;;### (autoloads nil "elfeed-org" "elfeed-org.el" (0 0 0 0))
-;;; Generated autoloads from elfeed-org.el
-
-(autoload 'elfeed-org "elfeed-org" "\
-Hook up rmh-elfeed-org to read the `org-mode' configuration when elfeed is run.
-
-\(fn)" t nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "elfeed-org" '("elfeed-org-" "rmh-elfeed-org-")))
-
-;;;***
-\f
-;; Local Variables:
-;; version-control: never
-;; no-byte-compile: t
-;; no-update-autoloads: t
-;; coding: utf-8
-;; End:
-;;; elfeed-org-autoloads.el ends here
+++ /dev/null
-;;; -*- no-byte-compile: t -*-
-(define-package "elfeed-org" "20181015.1100" "Configure elfeed with one or more org-mode files" '((elfeed "1.1.1") (org "8.2.7") (dash "2.10.0") (s "1.9.0") (cl-lib "0.5")) :commit "607b8bf4923a995260a072559b77bee188614a06" :keywords '("news") :authors '(("Remy Honig" . "remyhonigNOSPAMgmail.com")) :maintainer '("Remy Honig" . "remyhonigNOSPAMgmail.com") :url "https://github.com/remyhonig/elfeed-org")
+++ /dev/null
-;;; elfeed-org.el --- Configure elfeed with one or more org-mode files
-
-;; Copyright (C) 2014 Remy Honig
-
-;; Author : Remy Honig <remyhonigNOSPAMgmail.com>
-;; Package-Requires : ((elfeed "1.1.1") (org "8.2.7") (dash "2.10.0") (s "1.9.0") (cl-lib "0.5"))
-;; Package-Version: 20181015.1100
-;; URL : https://github.com/remyhonig/elfeed-org
-;; Version : 20170423.1
-;; Keywords : news
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;; Maintaining tags for all rss feeds is cumbersome using the regular
-;; flat list where there is no hierarchy and tag names are duplicated
-;; a lot. Org-mode makes the book keeping of tags and feeds much
-;; easier. Tags get inherited from parent headlines. Multiple files
-;; can be specified to separate your private from your work feeds for
-;; example. You may also use tagging rules to tag feeds by entry-title
-;; keywords. See https://github.com/remyhonig/elfeed-org for usage.
-
-;;; Code:
-
-(require 'elfeed)
-(require 'org)
-(require 'dash)
-(require 's)
-(require 'cl-lib)
-(require 'xml)
-
-
-(defgroup elfeed-org nil
- "Configure the Elfeed RSS reader with an Orgmode file"
- :group 'comm)
-
-
-(defcustom rmh-elfeed-org-tree-id "elfeed"
- "The tag or ID property on the trees containing the RSS feeds."
- :group 'elfeed-org
- :type 'string)
-
-(defcustom rmh-elfeed-org-ignore-tag "ignore"
- "The tag on the feed trees that will be ignored."
- :group 'elfeed-org
- :type 'string)
-
-(defcustom rmh-elfeed-org-auto-ignore-invalid-feeds nil
- "Tag feeds to ignore them when a feed could not loaded."
- :group 'elfeed-org
- :type 'bool)
-
-(defcustom rmh-elfeed-org-files (list "~/.emacs.d/elfeed.org")
- "The files where we look to find trees with the `rmh-elfeed-org-tree-id'."
- :group 'elfeed-org
- :type '(repeat (file :tag "org-mode file")))
-
-(defvar elfeed-org-new-entry-hook nil
- "List of new-entry tagger hooks created by elfeed-org.")
-
-(defun rmh-elfeed-org-check-configuration-file (file)
- "Make sure FILE exists."
- (when (not (file-exists-p file))
- (error "Elfeed-org cannot open %s. Make sure it exists or customize the variable \'rmh-elfeed-org-files\'"
- (abbreviate-file-name file))))
-
-(defun rmh-elfeed-org-is-headline-contained-in-elfeed-tree ()
- "Is any ancestor a headline with the elfeed tree id.
-Return t if it does or nil if it does not."
- (let ((result nil))
- (save-excursion
- (while (and (not result) (org-up-heading-safe))
- (setq result (member rmh-elfeed-org-tree-id (org-get-tags))))
- result)))
-
-(defun rmh-elfeed-org-mark-feed-ignore (url)
- "Set tag `rmh-elfeed-org-ignore-tag' to headlines containing the feed URL."
- (dolist (org-file rmh-elfeed-org-files)
- (with-current-buffer (find-file-noselect
- (expand-file-name org-file))
- (org-mode)
- (goto-char (point-min))
- (while (and
- (search-forward url nil t)
- ;; Prefer outline-on-heading-p because org-on-heading-p
- ;; is obsolete but org-at-heading-p was only introduced
- ;; in org 9.0:
- (outline-on-heading-p t)
- (rmh-elfeed-org-is-headline-contained-in-elfeed-tree))
- (org-toggle-tag rmh-elfeed-org-ignore-tag 'on))
- (elfeed-log 'info "elfeed-org tagged '%s' in file '%s' with '%s' to be ignored" url org-file rmh-elfeed-org-ignore-tag))))
-
-
-(defun rmh-elfeed-org-import-trees (tree-id)
- "Get trees with \":ID:\" property or tag of value TREE-ID.
-Return trees with TREE-ID as the value of the id property or
-with a tag of the same value. Setting an \":ID:\" property is not
-recommended but I support it for backward compatibility of
-current users."
- (org-element-map
- (org-element-parse-buffer)
- 'headline
- (lambda (h)
- (when (or (member tree-id (org-element-property :tags h))
- (equal tree-id (org-element-property :ID h))) h))))
-
-
-(defun rmh-elfeed-org-convert-tree-to-headlines (parsed-org)
- "Get the inherited tags from PARSED-ORG structure if MATCH-FUNC is t.
-The algorithm to gather inherited tags depends on the tree being
-visited depth first by `org-element-map'. The reason I don't use
-`org-get-tags-at' for this is that I can reuse the parsed org
-structure and I am not dependent on the setting of
-`org-use-tag-inheritance' or an org buffer being present at
-all. Which in my opinion makes the process more traceable."
- (let* ((tags '())
- (level 1))
- (org-element-map parsed-org 'headline
- (lambda (h)
- (let* ((current-level (org-element-property :level h))
- (delta-level (- current-level level))
- (delta-tags (--map (intern (substring-no-properties it))
- (org-element-property :tags h)))
- (heading (org-element-property :raw-value h)))
- ;; update the tags stack when we visit a parent or sibling
- (unless (> delta-level 0)
- (let ((drop-num (+ 1 (- delta-level))))
- (setq tags (-drop drop-num tags))))
- ;; save current level to compare with next heading that will be visited
- (setq level current-level)
- ;; save the tags that might apply to potential children of the current heading
- (push (-concat (-first-item tags) delta-tags) tags)
- ;; return the heading and inherited tags
- (-concat (list heading)
- (-first-item tags)))))))
-
-;; TODO: mark wrongly formatted feeds (PoC for unretrievable feeds)
-(defun rmh-elfeed-org-flag-headlines (parsed-org)
- "Flag headlines in PARSED-ORG if they don't have a valid value."
- (org-element-map parsed-org 'headline
- (lambda (h)
- (let ((tags (org-element-property :tags h)))
- (org-element-put-property h :tags (push "_flag_" tags))))))
-
-
-(defun rmh-elfeed-org-filter-relevant (list)
- "Filter relevant entries from the LIST."
- (-filter
- (lambda (entry)
- (and
- (string-match "\\(http\\|entry-title\\)" (car entry))
- (not (member (intern rmh-elfeed-org-ignore-tag) entry))))
- list))
-
-
-(defun rmh-elfeed-org-cleanup-headlines (headlines tree-id)
- "In all HEADLINES given remove the TREE-ID."
- (mapcar (lambda (e) (delete tree-id e)) headlines))
-
-
-(defun rmh-elfeed-org-import-headlines-from-files (files tree-id)
- "Visit all FILES and return the headlines stored under tree tagged TREE-ID or with the \":ID:\" TREE-ID in one list."
- (-distinct (-mapcat (lambda (file)
- (with-current-buffer (find-file-noselect (expand-file-name file))
- (org-mode)
- (rmh-elfeed-org-cleanup-headlines
- (rmh-elfeed-org-filter-relevant
- (rmh-elfeed-org-convert-tree-to-headlines
- (rmh-elfeed-org-import-trees tree-id)))
- (intern tree-id))))
- files)))
-
-
-(defun rmh-elfeed-org-convert-headline-to-tagger-params (tagger-headline)
- "Add new entry hooks for tagging configured with the found headline in TAGGER-HEADLINE."
- (list
- (s-trim (s-chop-prefix "entry-title:" (car tagger-headline)))
- (cdr tagger-headline)))
-
-
-(defun rmh-elfeed-org-export-entry-hook (tagger-params)
- "Export TAGGER-PARAMS to the proper `elfeed' structure."
- (add-hook 'elfeed-org-new-entry-hook
- (elfeed-make-tagger
- :entry-title (nth 0 tagger-params)
- :add (nth 1 tagger-params))))
-
-(defun rmh-elfeed-org-export-feed (headline)
- "Export HEADLINE to the proper `elfeed' structure."
- (if (and (stringp (car (last headline)))
- (> (length headline) 1))
- (progn
- (add-to-list 'elfeed-feeds (butlast headline))
- (let ((feed (elfeed-db-get-feed (car headline))))
- (setf (elfeed-meta feed :title) (car (last headline)))
- (elfeed-meta feed :title)))
- (add-to-list 'elfeed-feeds headline)))
-
-(defun rmh-elfeed-org-process (files tree-id)
- "Process headlines and taggers from FILES with org headlines with TREE-ID."
-
- ;; Warn if configuration files are missing
- (-each files 'rmh-elfeed-org-check-configuration-file)
-
- ;; Clear elfeed structures
- (setq elfeed-feeds nil)
- (setq elfeed-org-new-entry-hook nil)
-
- ;; Convert org structure to elfeed structure and register taggers and subscriptions
- (let* ((headlines (rmh-elfeed-org-import-headlines-from-files files tree-id))
- (subscriptions (rmh-elfeed-org-filter-subscriptions headlines))
- (taggers (rmh-elfeed-org-filter-taggers headlines))
- (elfeed-taggers (-map 'rmh-elfeed-org-convert-headline-to-tagger-params taggers))
- (elfeed-tagger-hooks (-map 'rmh-elfeed-org-export-entry-hook elfeed-taggers)))
- (-each subscriptions 'rmh-elfeed-org-export-feed)
- (-each taggers 'rmh-elfeed-org-export-entry-hook))
-
- ;; Tell user what we did
- (elfeed-log 'info "elfeed-org loaded %i feeds, %i rules"
- (length elfeed-feeds)
- (length elfeed-org-new-entry-hook)))
-
-(defun elfeed-org-run-new-entry-hook (entry)
- "Run ENTRY through elfeed-org taggers."
- (--each elfeed-org-new-entry-hook
- (funcall it entry)))
-
-(defun rmh-elfeed-org-filter-taggers (headlines)
- "Filter tagging rules from the HEADLINES in the tree."
- (-non-nil (-map
- (lambda (headline)
- (when (s-starts-with? "entry-title" (car headline)) headline))
- headlines)))
-
-(defun rmh-elfeed-org-filter-subscriptions (headlines)
- "Filter subscriptions to rss feeds from the HEADLINES in the tree."
- (-non-nil (-map
- (lambda (headline)
- (let* ((text (car headline))
- (link-and-title (s-match "^\\[\\[\\(http.+?\\)\\]\\[\\(.+?\\)\\]\\]" text))
- (hyperlink (s-match "^\\[\\[\\(http.+?\\)\\]\\(?:\\[.+?\\]\\)?\\]" text)))
- (cond ((s-starts-with? "http" text) headline)
- (link-and-title (-concat (list (nth 1 hyperlink))
- (cdr headline)
- (list (nth 2 link-and-title))))
- (hyperlink (-concat (list (nth 1 hyperlink)) (cdr headline))))))
- headlines)))
-
-
-(defun rmh-elfeed-org-convert-opml-to-org (xml level)
- "Convert OPML content to Org format.
-Argument XML content of the OPML file.
-Argument LEVEL current level in the tree."
- (cl-loop for (tag attr . content) in (cl-remove-if-not #'listp xml)
- when (and (not (assoc 'xmlUrl attr)) (assoc 'title attr))
- concat (format "%s %s\n" (make-string level ?*) (cdr it))
- when (assoc 'xmlUrl attr)
- concat (format "%s [[%s][%s]]\n" (make-string level ?*)
- (cdr it) (cdr (assoc 'title attr)))
- concat (rmh-elfeed-org-convert-opml-to-org content (+ 1 level))))
-
-(defun elfeed-org-import-opml (opml-file)
- "Import feeds from OPML file to a temporary Org buffer.
-Argument OPML-FILE filename of the OPML file."
- (interactive "FInput OPML file: ")
- (let* ((xml (xml-parse-file opml-file))
- (content (rmh-elfeed-org-convert-opml-to-org xml 0)))
- (with-current-buffer (get-buffer-create "*Imported Org Feeds*")
- (erase-buffer)
- (insert (format "* Imported Feeds :%s:\n" rmh-elfeed-org-tree-id))
- (insert content)
- (org-mode)
- (pop-to-buffer (current-buffer)))))
-
-
-(defun rmh-elfeed-org-convert-org-to-opml (org-buffer)
- "Convert Org buffer content to OPML format.
-Argument ORG-BUFFER the buffer to write the OPML content to."
- (let (need-ends
- opml-body)
- (with-current-buffer org-buffer
- (org-mode)
- (org-element-map (rmh-elfeed-org-import-trees
- rmh-elfeed-org-tree-id) 'headline
- (lambda (h)
- (let* ((current-level (org-element-property :level h))
- (tags (org-element-property :tags h))
- (heading (org-element-property :raw-value h))
- (link-and-title (s-match "^\\[\\[\\(http.+?\\)\\]\\[\\(.+?\\)\\]\\]" heading))
- (hyperlink (s-match "^\\[\\[\\(http.+?\\)\\]\\(?:\\[.+?\\]\\)?\\]" heading))
- url
- title
- opml-outline)
- ;; fill missing end outlines
- (while (and (car need-ends) (>= (car need-ends) current-level))
- (let* ((level (pop need-ends)))
- (setq opml-body (concat opml-body (format " %s</outline>\n"
- (make-string (* 2 level) ? ))))))
-
- (cond ((s-starts-with? "http" heading)
- (setq url heading)
- (setq title (or (elfeed-feed-title (elfeed-db-get-feed heading)) "Unknown")))
- (link-and-title (setq url (nth 1 link-and-title))
- (setq title (nth 2 link-and-title)))
- (hyperlink (setq url (nth 1 hyperlink))
- (setq title (or (elfeed-feed-title (elfeed-db-get-feed (nth 1 hyperlink))) "Unknown")))
- (t (setq title heading)))
- (if url
- (setq opml-outline (format " %s<outline title=\"%s\" xmlUrl=\"%s\"/>\n"
- (make-string (* 2 current-level) ? )
- title (xml-escape-string url)))
- (unless (s-starts-with? "entry-title" heading)
- (unless (member rmh-elfeed-org-tree-id tags)
- ;; insert category title only when it is neither the top
- ;; level elfeed node nor the entry-title node
- (progn
- (push current-level need-ends)
- (setq opml-outline (format " %s<outline title=\"%s\">\n"
- (make-string (* 2 current-level) ? )
- title))))))
- (setq opml-body (concat opml-body opml-outline))))))
-
- ;; fill missing end outlines at end
- (while (car need-ends)
- (let* ((level (pop need-ends)))
- (setq opml-body (concat opml-body (format " %s</outline>\n"
- (make-string (* 2 level) ? ))))))
- opml-body))
-
-(defun elfeed-org-export-opml ()
- "Export Org feeds under `rmh-elfeed-org-files' to a temporary OPML buffer.
-The first level elfeed node will be ignored. The user may need edit the output
-because most of Feed/RSS readers only support trees of 2 levels deep."
- (interactive)
- (let ((opml-body (cl-loop for org-file in rmh-elfeed-org-files
- concat (rmh-elfeed-org-convert-org-to-opml
- (find-file-noselect (expand-file-name org-file))))))
- (with-current-buffer (get-buffer-create "*Exported OPML Feeds*")
- (erase-buffer)
- (insert "<?xml version=\"1.0\"?>\n")
- (insert "<opml version=\"1.0\">\n")
- (insert " <head>\n")
- (insert " <title>Elfeed-Org Export</title>\n")
- (insert " </head>\n")
- (insert " <body>\n")
- (insert opml-body)
- (insert " </body>\n")
- (insert "</opml>\n")
- (xml-mode)
- (pop-to-buffer (current-buffer)))))
-
-
-;;;###autoload
-(defun elfeed-org ()
- "Hook up rmh-elfeed-org to read the `org-mode' configuration when elfeed is run."
- (interactive)
- (elfeed-log 'info "elfeed-org is set up to handle elfeed configuration")
- ;; Use an advice to load the configuration.
- (defadvice elfeed (before configure-elfeed activate)
- "Load all feed settings before elfeed is started."
- (rmh-elfeed-org-process rmh-elfeed-org-files rmh-elfeed-org-tree-id))
- (add-hook 'elfeed-new-entry-hook #'elfeed-org-run-new-entry-hook)
- (add-hook 'elfeed-http-error-hooks (lambda (url status)
- (when rmh-elfeed-org-auto-ignore-invalid-feeds
- (rmh-elfeed-org-mark-feed-ignore url))))
- (add-hook 'elfeed-parse-error-hooks (lambda (url error)
- (when rmh-elfeed-org-auto-ignore-invalid-feeds
- (rmh-elfeed-org-mark-feed-ignore url)))))
-
-
-(provide 'elfeed-org)
-;;; elfeed-org.el ends here
--- /dev/null
+;;; elfeed-org-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*-
+;;
+;;; Code:
+
+(add-to-list 'load-path (directory-file-name
+ (or (file-name-directory #$) (car load-path))))
+
+\f
+;;;### (autoloads nil "elfeed-org" "elfeed-org.el" (0 0 0 0))
+;;; Generated autoloads from elfeed-org.el
+
+(autoload 'elfeed-org "elfeed-org" "\
+Hook up rmh-elfeed-org to read the `org-mode' configuration when elfeed is run." t nil)
+
+(register-definition-prefixes "elfeed-org" '("elfeed-org-" "rmh-elfeed-"))
+
+;;;***
+\f
+;;;### (autoloads nil nil ("elfeed-org-pkg.el") (0 0 0 0))
+
+;;;***
+\f
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; coding: utf-8
+;; End:
+;;; elfeed-org-autoloads.el ends here
--- /dev/null
+(define-package "elfeed-org" "20221118.852" "Configure elfeed with one or more org-mode files"
+ '((elfeed "1.1.1")
+ (org "8.2.7")
+ (dash "2.10.0")
+ (s "1.9.0")
+ (cl-lib "0.5"))
+ :commit "3242ec0519800a58f20480c8a6e3b3337d137084" :authors
+ '(("Remy Honig" . "remyhonigNOSPAMgmail.com"))
+ :maintainers
+ '(("Remy Honig" . "remyhonigNOSPAMgmail.com"))
+ :maintainer
+ '("Remy Honig" . "remyhonigNOSPAMgmail.com")
+ :keywords
+ '("news")
+ :url "https://github.com/remyhonig/elfeed-org")
+;; Local Variables:
+;; no-byte-compile: t
+;; End:
--- /dev/null
+;;; elfeed-org.el --- Configure elfeed with one or more org-mode files
+
+;; Copyright (C) 2014 Remy Honig
+
+;; Author : Remy Honig <remyhonigNOSPAMgmail.com>
+;; Package-Requires : ((elfeed "1.1.1") (org "8.2.7") (dash "2.10.0") (s "1.9.0") (cl-lib "0.5"))
+;; URL : https://github.com/remyhonig/elfeed-org
+;; Version : 20170423.1
+;; Keywords : news
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;; Maintaining tags for all rss feeds is cumbersome using the regular
+;; flat list where there is no hierarchy and tag names are duplicated
+;; a lot. Org-mode makes the book keeping of tags and feeds much
+;; easier. Tags get inherited from parent headlines. Multiple files
+;; can be specified to separate your private from your work feeds for
+;; example. You may also use tagging rules to tag feeds by entry-title
+;; keywords. See https://github.com/remyhonig/elfeed-org for usage.
+
+;;; Code:
+
+(require 'elfeed)
+(require 'org)
+(require 'org-element)
+(require 'dash)
+(require 's)
+(require 'cl-lib)
+(require 'xml)
+
+
+(defgroup elfeed-org nil
+ "Configure the Elfeed RSS reader with an Orgmode file"
+ :group 'comm)
+
+
+(defcustom rmh-elfeed-org-tree-id "elfeed"
+ "The tag or ID property on the trees containing the RSS feeds."
+ :group 'elfeed-org
+ :type 'string)
+
+(defcustom rmh-elfeed-org-ignore-tag "ignore"
+ "The tag on the feed trees that will be ignored."
+ :group 'elfeed-org
+ :type 'string)
+
+(defcustom rmh-elfeed-org-auto-ignore-invalid-feeds nil
+ "Tag feeds to ignore them when a feed could not loaded."
+ :group 'elfeed-org
+ :type 'bool)
+
+(defcustom rmh-elfeed-org-files (list (locate-user-emacs-file "elfeed.org"))
+ "The files where we look to find trees with the `rmh-elfeed-org-tree-id'."
+ :group 'elfeed-org
+ :type '(repeat (file :tag "org-mode file")))
+
+(defvar elfeed-org-new-entry-hook nil
+ "List of new-entry tagger hooks created by elfeed-org.")
+
+(defun rmh-elfeed-org-check-configuration-file (file)
+ "Make sure FILE exists."
+ (when (not (file-exists-p file))
+ (error "Elfeed-org cannot open %s. Make sure it exists or customize the variable \'rmh-elfeed-org-files\'"
+ (abbreviate-file-name file))))
+
+(defun rmh-elfeed-org-is-headline-contained-in-elfeed-tree ()
+ "Is any ancestor a headline with the elfeed tree id.
+Return t if it does or nil if it does not."
+ (let ((result nil))
+ (save-excursion
+ (while (and (not result) (org-up-heading-safe))
+ (setq result (member rmh-elfeed-org-tree-id (org-get-tags))))
+ result)))
+
+(defun rmh-elfeed-org-mark-feed-ignore (url)
+ "Set tag `rmh-elfeed-org-ignore-tag' to headlines containing the feed URL."
+ (dolist (org-file rmh-elfeed-org-files)
+ (with-current-buffer (find-file-noselect
+ (expand-file-name org-file))
+ (org-mode)
+ (goto-char (point-min))
+ (while (and
+ (search-forward url nil t)
+ ;; Prefer outline-on-heading-p because org-on-heading-p
+ ;; is obsolete but org-at-heading-p was only introduced
+ ;; in org 9.0:
+ (outline-on-heading-p t)
+ (rmh-elfeed-org-is-headline-contained-in-elfeed-tree))
+ (org-toggle-tag rmh-elfeed-org-ignore-tag 'on))
+ (elfeed-log 'info "elfeed-org tagged '%s' in file '%s' with '%s' to be ignored" url org-file rmh-elfeed-org-ignore-tag))))
+
+
+(defun rmh-elfeed-org-import-trees (tree-id)
+ "Get trees with \":ID:\" property or tag of value TREE-ID.
+Return trees with TREE-ID as the value of the id property or
+with a tag of the same value. Setting an \":ID:\" property is not
+recommended but I support it for backward compatibility of
+current users."
+ (org-element-map
+ (org-element-parse-buffer)
+ 'headline
+ (lambda (h)
+ (when (or (member tree-id (org-element-property :tags h))
+ (equal tree-id (org-element-property :ID h))) h))))
+
+
+(defun rmh-elfeed-org-convert-tree-to-headlines (parsed-org)
+ "Get the inherited tags from PARSED-ORG structure if MATCH-FUNC is t.
+The algorithm to gather inherited tags depends on the tree being
+visited depth first by `org-element-map'. The reason I don't use
+`org-get-tags-at' for this is that I can reuse the parsed org
+structure and I am not dependent on the setting of
+`org-use-tag-inheritance' or an org buffer being present at
+all. Which in my opinion makes the process more traceable."
+ (let* ((tags '())
+ (level 1))
+ (org-element-map parsed-org 'headline
+ (lambda (h)
+ (pcase-let*
+ ((current-level (org-element-property :level h))
+ (delta-level (- current-level level))
+ (delta-tags (--map (intern (substring-no-properties it))
+ (org-element-property :tags h)))
+ (heading (org-element-property :raw-value h))
+ (`(,link ,description)
+ (org-element-map (org-element-property :title h) 'link
+ (lambda (link)
+ (list
+ (org-element-property :raw-link link)
+ (when (and (org-element-property :contents-begin link)
+ (org-element-property :contents-end link))
+ (buffer-substring
+ (org-element-property :contents-begin link)
+ (org-element-property :contents-end link)))))
+ nil t)))
+ ;; update the tags stack when we visit a parent or sibling
+ (unless (> delta-level 0)
+ (let ((drop-num (+ 1 (- delta-level))))
+ (setq tags (-drop drop-num tags))))
+ ;; save current level to compare with next heading that will be visited
+ (setq level current-level)
+ ;; save the tags that might apply to potential children of the current heading
+ (push (-concat (-first-item tags) delta-tags) tags)
+ ;; return the heading and inherited tags
+ (if (and link description)
+ (-concat (list link)
+ (-first-item tags)
+ (list description))
+ (-concat (list (if link link heading))
+ (-first-item tags))))))))
+
+;; TODO: mark wrongly formatted feeds (PoC for unretrievable feeds)
+(defun rmh-elfeed-org-flag-headlines (parsed-org)
+ "Flag headlines in PARSED-ORG if they don't have a valid value."
+ (org-element-map parsed-org 'headline
+ (lambda (h)
+ (let ((tags (org-element-property :tags h)))
+ (org-element-put-property h :tags (push "_flag_" tags))))))
+
+
+(defun rmh-elfeed-org-filter-relevant (list)
+ "Filter relevant entries from the LIST."
+ (-filter
+ (lambda (entry)
+ (and
+ (string-match "\\(http\\|gopher\\|file\\|entry-title\\)" (car entry))
+ (not (member (intern rmh-elfeed-org-ignore-tag) entry))))
+ list))
+
+
+(defun rmh-elfeed-org-cleanup-headlines (headlines tree-id)
+ "In all HEADLINES given remove the TREE-ID."
+ (mapcar (lambda (e) (delete tree-id e)) headlines))
+
+
+(defun rmh-elfeed-org-import-headlines-from-files (files tree-id)
+ "Visit all FILES and return the headlines stored under tree tagged TREE-ID or with the \":ID:\" TREE-ID in one list."
+ (-distinct (-mapcat (lambda (file)
+ (with-current-buffer (find-file-noselect (expand-file-name file))
+ (org-mode)
+ (rmh-elfeed-org-cleanup-headlines
+ (rmh-elfeed-org-filter-relevant
+ (rmh-elfeed-org-convert-tree-to-headlines
+ (rmh-elfeed-org-import-trees tree-id)))
+ (intern tree-id))))
+ files)))
+
+
+(defun rmh-elfeed-org-convert-headline-to-tagger-params (tagger-headline)
+ "Add new entry hooks for tagging configured with the found headline in TAGGER-HEADLINE."
+ (list
+ (s-trim (s-chop-prefix "entry-title:" (car tagger-headline)))
+ (cdr tagger-headline)))
+
+
+(defun rmh-elfeed-org-export-entry-hook (tagger-params)
+ "Export TAGGER-PARAMS to the proper `elfeed' structure."
+ (add-hook 'elfeed-org-new-entry-hook
+ (elfeed-make-tagger
+ :entry-title (nth 0 tagger-params)
+ :add (nth 1 tagger-params))))
+
+(defun rmh-elfeed-org-export-feed (headline)
+ "Export HEADLINE to the proper `elfeed' structure."
+ (if (and (stringp (car (last headline)))
+ (> (length headline) 1))
+ (progn
+ (add-to-list 'elfeed-feeds (butlast headline))
+ (let ((feed (elfeed-db-get-feed (car headline)))
+ (title (substring-no-properties (car (last headline)))))
+ (setf (elfeed-meta feed :title) title)
+ (elfeed-meta feed :title)))
+ (add-to-list 'elfeed-feeds headline)))
+
+(defun rmh-elfeed-org-process (files tree-id)
+ "Process headlines and taggers from FILES with org headlines with TREE-ID."
+
+ ;; Warn if configuration files are missing
+ (-each files 'rmh-elfeed-org-check-configuration-file)
+
+ ;; Clear elfeed structures
+ (setq elfeed-feeds nil)
+ (setq elfeed-org-new-entry-hook nil)
+
+ ;; Convert org structure to elfeed structure and register taggers and subscriptions
+ (let* ((headlines (rmh-elfeed-org-import-headlines-from-files files tree-id))
+ (taggers (rmh-elfeed-org-filter-taggers headlines))
+ (elfeed-taggers (-map 'rmh-elfeed-org-convert-headline-to-tagger-params taggers))
+ (elfeed-tagger-hooks (-map 'rmh-elfeed-org-export-entry-hook elfeed-taggers)))
+ (-each headlines 'rmh-elfeed-org-export-feed)
+ (-each taggers 'rmh-elfeed-org-export-entry-hook))
+
+ ;; Tell user what we did
+ (elfeed-log 'info "elfeed-org loaded %i feeds, %i rules"
+ (length elfeed-feeds)
+ (length elfeed-org-new-entry-hook)))
+
+(defun elfeed-org-run-new-entry-hook (entry)
+ "Run ENTRY through elfeed-org taggers."
+ (--each elfeed-org-new-entry-hook
+ (funcall it entry)))
+
+(defun rmh-elfeed-apply-autotags-now-advice ()
+ "Make entry title matching rules works with `elfeed-apply-autotags-now'."
+ (interactive)
+ (let* ((headlines (rmh-elfeed-org-import-headlines-from-files
+ rmh-elfeed-org-files rmh-elfeed-org-tree-id))
+ (subscriptions (rmh-elfeed-org-filter-subscriptions headlines))
+ (taggers (rmh-elfeed-org-filter-taggers headlines))
+ (elfeed-taggers (-map 'rmh-elfeed-org-convert-headline-to-tagger-params taggers))
+ (entry-match-taggers (-map (lambda (tagger-params)
+ (elfeed-make-tagger
+ :entry-title (nth 0 tagger-params)
+ :add (nth 1 tagger-params))) elfeed-taggers)))
+ (with-elfeed-db-visit (entry feed)
+ (dolist (tagger entry-match-taggers)
+ (funcall tagger entry)))))
+
+(defun rmh-elfeed-org-filter-taggers (headlines)
+ "Filter tagging rules from the HEADLINES in the tree."
+ (-non-nil (-map
+ (lambda (headline)
+ (when (s-starts-with? "entry-title" (car headline)) headline))
+ headlines)))
+
+(defun rmh-elfeed-org-convert-opml-to-org (xml level)
+ "Convert OPML content to Org format.
+Argument XML content of the OPML file.
+Argument LEVEL current level in the tree."
+ (cl-loop for (tag attr . content) in (cl-remove-if-not #'listp xml)
+ when (and (not (assoc 'xmlUrl attr)) (assoc 'title attr))
+ concat (format "%s %s\n" (make-string level ?*) (cdr it))
+ when (assoc 'xmlUrl attr)
+ concat (format "%s [[%s][%s]]\n" (make-string level ?*)
+ (cdr it) (cdr (assoc 'title attr)))
+ concat (rmh-elfeed-org-convert-opml-to-org content (+ 1 level))))
+
+(defun elfeed-org-import-opml (opml-file)
+ "Import feeds from OPML file to a temporary Org buffer.
+Argument OPML-FILE filename of the OPML file."
+ (interactive "FInput OPML file: ")
+ (let* ((xml (xml-parse-file opml-file))
+ (content (rmh-elfeed-org-convert-opml-to-org xml 0)))
+ (with-current-buffer (get-buffer-create "*Imported Org Feeds*")
+ (erase-buffer)
+ (insert (format "* Imported Feeds :%s:\n" rmh-elfeed-org-tree-id))
+ (insert content)
+ (org-mode)
+ (pop-to-buffer (current-buffer)))))
+
+
+(defun rmh-elfeed-org-convert-org-to-opml (org-buffer)
+ "Convert Org buffer content to OPML format.
+Argument ORG-BUFFER the buffer to write the OPML content to."
+ (let (need-ends
+ opml-body)
+ (with-current-buffer org-buffer
+ (org-mode)
+ (org-element-map (rmh-elfeed-org-import-trees
+ rmh-elfeed-org-tree-id) 'headline
+ (lambda (h)
+ (let* ((current-level (org-element-property :level h))
+ (tags (org-element-property :tags h))
+ (heading (org-element-property :raw-value h))
+ (link-and-title (s-match "^\\[\\[\\(http.+?\\)\\]\\[\\(.+?\\)\\]\\]" heading))
+ (hyperlink (s-match "^\\[\\[\\(http.+?\\)\\]\\(?:\\[.+?\\]\\)?\\]" heading))
+ url
+ title
+ opml-outline)
+ ;; fill missing end outlines
+ (while (and (car need-ends) (>= (car need-ends) current-level))
+ (let* ((level (pop need-ends)))
+ (setq opml-body (concat opml-body (format " %s</outline>\n"
+ (make-string (* 2 level) ? ))))))
+
+ (cond ((s-starts-with? "http" heading)
+ (setq url heading)
+ (setq title (or (elfeed-feed-title (elfeed-db-get-feed heading)) "Unknown")))
+ (link-and-title (setq url (nth 1 link-and-title))
+ (setq title (nth 2 link-and-title)))
+ (hyperlink (setq url (nth 1 hyperlink))
+ (setq title (or (elfeed-feed-title (elfeed-db-get-feed (nth 1 hyperlink))) "Unknown")))
+ (t (setq title heading)))
+ (if url
+ (setq opml-outline (format " %s<outline title=\"%s\" xmlUrl=\"%s\"/>\n"
+ (make-string (* 2 current-level) ? )
+ (xml-escape-string title)
+ (xml-escape-string url)))
+ (unless (s-starts-with? "entry-title" heading)
+ (unless (member rmh-elfeed-org-tree-id tags)
+ ;; insert category title only when it is neither the top
+ ;; level elfeed node nor the entry-title node
+ (progn
+ (push current-level need-ends)
+ (setq opml-outline (format " %s<outline title=\"%s\">\n"
+ (make-string (* 2 current-level) ? )
+ (xml-escape-string title)))))))
+ (setq opml-body (concat opml-body opml-outline))))))
+
+ ;; fill missing end outlines at end
+ (while (car need-ends)
+ (let* ((level (pop need-ends)))
+ (setq opml-body (concat opml-body (format " %s</outline>\n"
+ (make-string (* 2 level) ? ))))))
+ opml-body))
+
+(defun elfeed-org-export-opml ()
+ "Export Org feeds under `rmh-elfeed-org-files' to a temporary OPML buffer.
+The first level elfeed node will be ignored. The user may need edit the output
+because most of Feed/RSS readers only support trees of 2 levels deep."
+ (interactive)
+ (let ((opml-body (cl-loop for org-file in rmh-elfeed-org-files
+ concat (rmh-elfeed-org-convert-org-to-opml
+ (find-file-noselect (expand-file-name org-file))))))
+ (with-current-buffer (get-buffer-create "*Exported OPML Feeds*")
+ (erase-buffer)
+ (insert "<?xml version=\"1.0\"?>\n")
+ (insert "<opml version=\"1.0\">\n")
+ (insert " <head>\n")
+ (insert " <title>Elfeed-Org Export</title>\n")
+ (insert " </head>\n")
+ (insert " <body>\n")
+ (insert opml-body)
+ (insert " </body>\n")
+ (insert "</opml>\n")
+ (xml-mode)
+ (pop-to-buffer (current-buffer)))))
+
+
+;;;###autoload
+(defun elfeed-org ()
+ "Hook up rmh-elfeed-org to read the `org-mode' configuration when elfeed is run."
+ (interactive)
+ (elfeed-log 'info "elfeed-org is set up to handle elfeed configuration")
+ ;; Use an advice to load the configuration.
+ (defadvice elfeed (before configure-elfeed activate)
+ "Load all feed settings before elfeed is started."
+ (rmh-elfeed-org-process rmh-elfeed-org-files rmh-elfeed-org-tree-id))
+ (add-hook 'elfeed-new-entry-hook #'elfeed-org-run-new-entry-hook)
+ (advice-add 'elfeed-apply-autotags-now :after #'rmh-elfeed-apply-autotags-now-advice)
+ (add-hook 'elfeed-http-error-hooks (lambda (url status)
+ (when rmh-elfeed-org-auto-ignore-invalid-feeds
+ (rmh-elfeed-org-mark-feed-ignore url))))
+ (add-hook 'elfeed-parse-error-hooks (lambda (url error)
+ (when rmh-elfeed-org-auto-ignore-invalid-feeds
+ (rmh-elfeed-org-mark-feed-ignore url)))))
+
+
+(provide 'elfeed-org)
+;;; elfeed-org.el ends here
projects / emacsconfig.git / commitdiff