#+BEGIN_SRC emacs-lisp :tangle yes
(if (>= emacs-major-version 24)
(progn
- (add-to-list 'load-path "~/.emacs.d/elpa/elfeed-20180916.1338")
+ (add-to-list 'load-path "~/.emacs.d/elpa/elfeed-20181127.1943")
(add-to-list 'load-path "~/.emacs.d/elpa/elfeed-org-20181015.1100")
(require 'elfeed-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.")
- (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))
- (version (plist-get capabilities :version)))
- (unless (version< version "7.33.0")
- (push "--http1.1" args)) ; too many broken HTTP/2 servers
- (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)
- "Turn a time expression into a number of seconds. Uses
-`timer-duration' but allows a bit more flair."
- (if (numberp time)
- time
- (when (string-match-p "[[:alpha:]]" time)
- (let ((clean (replace-regexp-in-string "\\(ago\\|old\\|-\\)" " " time)))
- (timer-duration clean)))))
-
-(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 "[\n\t]+" " " (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"
- (save-match-data
- (let ((re "^\\([0-9]\\{4\\}\\)-?\\([0-9]\\{2\\}\\)-?\\([0-9]\\{2\\}\\)?$")
- (clean (elfeed-cleanup string)))
- (when (string-match re clean)
- (let ((year (string-to-number (match-string 1 clean)))
- (month (string-to-number (match-string 2 clean)))
- (day (string-to-number (or (match-string 3 clean) "1"))))
- (when (and (>= year 1900) (< year 2200))
- (float-time (encode-time 0 0 0 day 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))
- (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" "20180916.1338" "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)
-
-(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-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))
-
-(defvar elfeed-search-mode-map
- (let ((map (make-sparse-keymap)))
- (prog1 map
- (suppress-keymap map)
- (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 "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)))
- "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 ())
- (after nil)
- (matches ())
- (not-matches ())
- (limit nil)
- (feeds ()))
- (cl-loop for element in (split-string filter)
- for type = (aref element 0)
- do (cl-case type
- (?+
- (let ((symbol (intern (substring element 1))))
- (unless (eq '## symbol)
- (push symbol must-have))))
- (?-
- (let ((symbol (intern (substring element 1))))
- (unless (eq '## symbol)
- (push symbol must-not-have))))
- (?@ (setf after (elfeed-time-duration (substring element 1))))
- (?! (let ((re (substring element 1)))
- (when (elfeed-valid-regexp-p re)
- (push re not-matches))))
- (?# (setf limit (string-to-number (substring element 1))))
- (?= (let ((url (substring element 1)))
- (push url feeds)))
- (otherwise (when (elfeed-valid-regexp-p element)
- (push element matches)))))
- `(,@(when after
- (list :after after))
- ,@(when must-have
- (list :must-have must-have))
- ,@(when must-not-have
- (list :must-not-have must-not-have))
- ,@(when matches
- (list :matches matches))
- ,@(when not-matches
- (list :not-matches not-matches))
- ,@(when limit
- (list :limit limit))
- ,@(when feeds
- (list :feeds feeds)))))
-
-(defun elfeed-search--recover-units (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-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))
- (must-have (plist-get filter :must-have))
- (must-not-have (plist-get filter :must-not-have))
- (matches (plist-get filter :matches))
- (not-matches (plist-get filter :not-matches))
- (limit (plist-get filter :limit))
- (feeds (plist-get filter :feeds)))
- (when after
- (push (elfeed-search--recover-units after) output))
- (dolist (tag must-have)
- (push (format "+%S" tag) output))
- (dolist (tag must-not-have)
- (push (format "-%S" tag) output))
- (dolist (re matches)
- (push re output))
- (dolist (re not-matches)
- (push (concat "!" re) output))
- (when limit
- (push (format "#%d" limit) output))
- (dolist (feed feeds)
- (push (format "=%s" feed) output))
- (mapconcat #'identity (nreverse output) " "))))
-
-(defun elfeed-search-filter (filter entry feed &optional count)
- "Return non-nil if ENTRY and FEED pass FILTER.
-
-COUNT is the total number of entries collected so far, for
-filtering against a limit filter (ex. #10).
-
-See `elfeed-search-set-filter' for format/syntax documentation.
-This function must *only* be called within the body of
-`with-elfeed-db-visit' because it may perform a non-local exit."
- (let ((after (plist-get filter :after))
- (must-have (plist-get filter :must-have))
- (must-not-have (plist-get filter :must-not-have))
- (matches (plist-get filter :matches))
- (not-matches (plist-get filter :not-matches))
- (limit (plist-get filter :limit))
- (feeds (plist-get filter :feeds)))
- (let* ((tags (elfeed-entry-tags entry))
- (date (elfeed-entry-date entry))
- (age (- (float-time) date))
- (title (or (elfeed-meta entry :title) (elfeed-entry-title entry)))
- (link (elfeed-entry-link entry))
- (feed-title
- (or (elfeed-meta feed :title) (elfeed-feed-title feed) ""))
- (feed-id (elfeed-feed-id feed)))
- (when (or (and after (> age after))
- (and limit (<= limit 0))
- (and limit count (>= count limit)))
- (elfeed-db-return))
- (and (cl-every (lambda (tag) (memq tag tags)) must-have)
- (cl-notany (lambda (tag) (memq tag tags)) must-not-have)
- (or (null matches)
- (cl-every
- (lambda (m)
- (or (and title (string-match-p m title))
- (and link (string-match-p m link))))
- matches))
- (cl-notany (lambda (m)
- (or (and title (string-match-p m title))
- (and link (string-match-p m link))))
- not-matches)
- (or (null feeds)
- (cl-some (lambda (f)
- (or (string-match-p f feed-id)
- (string-match-p f feed-title)))
- feeds))))))
-
-(defun elfeed-search-compile-filter (filter)
- "Compile FILTER into a lambda function for `byte-compile'.
-
-Executing a filter in bytecode form is generally faster than
-\"interpreting\" the filter with `elfeed-search-filter'."
- (let ((after (plist-get filter :after))
- (must-have (plist-get filter :must-have))
- (must-not-have (plist-get filter :must-not-have))
- (matches (plist-get filter :matches))
- (not-matches (plist-get filter :not-matches))
- (limit (plist-get filter :limit))
- (feeds (plist-get filter :feeds)))
- `(lambda (,(if (or after matches not-matches must-have must-not-have)
- 'entry
- '_entry)
- ,(if feeds
- 'feed
- '_feed)
- ,(if limit
- 'count
- '_count))
- (let* (,@(when after
- '((date (elfeed-entry-date entry))
- (age (- (float-time) date))))
- ,@(when (or must-have must-not-have)
- '((tags (elfeed-entry-tags entry))))
- ,@(when (or matches not-matches)
- '((title (or (elfeed-meta entry :title)
- (elfeed-entry-title entry)))
- (link (elfeed-entry-link entry))))
- ,@(when feeds
- '((feed-id (elfeed-feed-id feed))
- (feed-title (or (elfeed-meta feed :title)
- (elfeed-feed-title feed) "")))))
- ,@(when after
- `((when (> age ,after)
- (elfeed-db-return))))
- ,@(when limit
- `((when (>= count ,limit)
- (elfeed-db-return))))
- (and ,@(cl-loop for forbid in must-not-have
- collect `(not (memq ',forbid tags)))
- ,@(cl-loop for forbid in must-have
- collect `(memq ',forbid tags))
- ,@(cl-loop for regex in matches collect
- `(or (string-match-p ,regex title)
- (string-match-p ,regex link)))
- ,@(cl-loop for regex in not-matches collect
- `(not
- (or (string-match-p ,regex title)
- (string-match-p ,regex link))))
- ,@(when feeds
- `((or ,@(cl-loop
- for regex in feeds
- collect `(string-match-p ,regex feed-id)
- collect `(string-match-p ,regex feed-title))))))))))
-
-(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-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. No posts older
-than this are allowed. Ex. \"@3-days-ago\" or \"@1-year-old\".
-
-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 (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 (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 (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 (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 (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)
- (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 "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-expose #'elfeed-show-tag 'unread))
- (define-key map "+" 'elfeed-show-tag)
- (define-key map "-" 'elfeed-show-untag)
- (define-key map (kbd "SPC") 'scroll-up-command)
- (define-key map (kbd "DEL") 'scroll-down-command)
- (define-key map "\t" 'shr-next-link)
- (define-key map [tab] 'shr-next-link)
- (define-key map "\e\t" 'shr-previous-link)
- (define-key map [backtab] 'shr-previous-link)
- (define-key map [mouse-2] 'shr-browse-url)
- (define-key map "A" 'elfeed-show-add-enclosure-to-playlist)
- (define-key map "P" 'elfeed-show-play-enclosure)))
- "Keymap for `elfeed-show-mode'.")
-
-(defun elfeed-show-mode ()
- "Mode for displaying Elfeed feed entries.
-\\{elfeed-show-mode-map}"
- (interactive)
- (kill-all-local-variables)
- (use-local-map elfeed-show-mode-map)
- (setq major-mode 'elfeed-show-mode
- mode-name "elfeed-show"
- buffer-read-only t)
- (buffer-disable-undo)
- (make-local-variable 'elfeed-show-entry)
- (run-mode-hooks 'elfeed-show-mode-hook))
-
-(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-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)))
- (author (elfeed-meta elfeed-show-entry :author))
- (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 (and author elfeed-show-entry-author)
- (insert (format (propertize "Author: %s\n" 'face 'message-header-name)
- (propertize author '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))
-
-(defun elfeed-show-entry (entry)
- "Display ENTRY in the current buffer."
- (let ((buff (get-buffer-create "*elfeed-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-show-play-enclosure (&optional entry enclosure-index)
- "Play enclosure number ENCLOSURE-INDEX from ENTRY using emms.
-If ENTRY is nil use the elfeed-show-entry variable.
-If ENCLOSURE-INDEX is nil ask for the enclosure number."
- (interactive)
- (require 'emms) ;; optional
- (let* ((entry (or entry elfeed-show-entry))
- (enclosure-index (or enclosure-index
- (elfeed--get-enclosure-num
- "Enclosure to play" entry)))
- (url-enclosure (car (elt (elfeed-entry-enclosures entry)
- (- enclosure-index 1)))))
- (with-no-warnings ;; due to lazy (require)
- (with-current-emms-playlist
- (let ((old-pos (point-max)))
- (emms-add-url url-enclosure)
- (goto-char old-pos)
- ;; if we're sitting on a group name, move forward
- (unless (emms-playlist-track-at (point))
- (emms-playlist-next))
- (emms-playlist-select (point)))
- ;; FIXME: is there a better way of doing this?
- (emms-stop)
- (emms-start)))))
-
-(defun elfeed-show-add-enclosure-to-playlist (&optional entry enclosure-index)
- "Play enclosure number ENCLOSURE-INDEX from ENTRY using emms.
-If ENTRY is nil use the elfeed-show-entry variable.
-If ENCLOSURE-INDEX is nil ask for the enclosure number."
- (interactive)
- (require 'emms) ;; optional
- (let* ((entry (or entry elfeed-show-entry))
- (enclosure-index (or enclosure-index
- (elfeed--get-enclosure-num
- "Enclosure to add" entry)))
- (url-enclosure (car (elt (elfeed-entry-enclosures entry)
- (- enclosure-index 1)))))
- (with-no-warnings ;; due to lazy (require )
- (emms-add-url url-enclosure))))
-
-(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.1.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))
-
-(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)))
- (author (elfeed-cleanup (xml-query* (feed author name *) 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) author)
- (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
- (author-name (or (xml-query* (author name *) entry)
- ;; Dublin Core
- (xml-query* (creator *) entry)))
- (author-email (xml-query* (author email *) entry))
- (author (cond ((and author-name author-email)
- (format "%s <%s>" author-name author-email))
- (author-name)))
- (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 author
- (list :author author))
- ,@(when categories
- (list :categories categories))))))
- (dolist (hook elfeed-new-entry-parse-hook)
- (funcall hook :atom entry db-entry))
- db-entry))))
-
-(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)))
- (author (or (xml-query* (author *) item)
- ;; Dublin Core
- (xml-query* (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 author
- (list :author author))
- ,@(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-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.")
+ (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)))
+ (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)
+ "Turn a time expression into a number of seconds. Uses
+`timer-duration' but allows a bit more flair."
+ (if (numberp time)
+ time
+ (when (string-match-p "[[:alpha:]]" time)
+ (let ((clean (replace-regexp-in-string "\\(ago\\|old\\|-\\)" " " time)))
+ (timer-duration clean)))))
+
+(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 "[\n\t]+" " " (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"
+ (save-match-data
+ (let ((re "^\\([0-9]\\{4\\}\\)-?\\([0-9]\\{2\\}\\)-?\\([0-9]\\{2\\}\\)?$")
+ (clean (elfeed-cleanup string)))
+ (when (string-match re clean)
+ (let ((year (string-to-number (match-string 1 clean)))
+ (month (string-to-number (match-string 2 clean)))
+ (day (string-to-number (or (match-string 3 clean) "1"))))
+ (when (and (>= year 1900) (< year 2200))
+ (float-time (encode-time 0 0 0 day 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))
+ (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" "20181127.1943" "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)
+
+(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-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))
+
+(defvar elfeed-search-mode-map
+ (let ((map (make-sparse-keymap)))
+ (prog1 map
+ (suppress-keymap map)
+ (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 "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)))
+ "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 ())
+ (after nil)
+ (matches ())
+ (not-matches ())
+ (limit nil)
+ (feeds ()))
+ (cl-loop for element in (split-string filter)
+ for type = (aref element 0)
+ do (cl-case type
+ (?+
+ (let ((symbol (intern (substring element 1))))
+ (unless (eq '## symbol)
+ (push symbol must-have))))
+ (?-
+ (let ((symbol (intern (substring element 1))))
+ (unless (eq '## symbol)
+ (push symbol must-not-have))))
+ (?@ (setf after (elfeed-time-duration (substring element 1))))
+ (?! (let ((re (substring element 1)))
+ (when (elfeed-valid-regexp-p re)
+ (push re not-matches))))
+ (?# (setf limit (string-to-number (substring element 1))))
+ (?= (let ((url (substring element 1)))
+ (push url feeds)))
+ (otherwise (when (elfeed-valid-regexp-p element)
+ (push element matches)))))
+ `(,@(when after
+ (list :after after))
+ ,@(when must-have
+ (list :must-have must-have))
+ ,@(when must-not-have
+ (list :must-not-have must-not-have))
+ ,@(when matches
+ (list :matches matches))
+ ,@(when not-matches
+ (list :not-matches not-matches))
+ ,@(when limit
+ (list :limit limit))
+ ,@(when feeds
+ (list :feeds feeds)))))
+
+(defun elfeed-search--recover-units (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-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))
+ (must-have (plist-get filter :must-have))
+ (must-not-have (plist-get filter :must-not-have))
+ (matches (plist-get filter :matches))
+ (not-matches (plist-get filter :not-matches))
+ (limit (plist-get filter :limit))
+ (feeds (plist-get filter :feeds)))
+ (when after
+ (push (elfeed-search--recover-units after) output))
+ (dolist (tag must-have)
+ (push (format "+%S" tag) output))
+ (dolist (tag must-not-have)
+ (push (format "-%S" tag) output))
+ (dolist (re matches)
+ (push re output))
+ (dolist (re not-matches)
+ (push (concat "!" re) output))
+ (when limit
+ (push (format "#%d" limit) output))
+ (dolist (feed feeds)
+ (push (format "=%s" feed) output))
+ (mapconcat #'identity (nreverse output) " "))))
+
+(defun elfeed-search-filter (filter entry feed &optional count)
+ "Return non-nil if ENTRY and FEED pass FILTER.
+
+COUNT is the total number of entries collected so far, for
+filtering against a limit filter (ex. #10).
+
+See `elfeed-search-set-filter' for format/syntax documentation.
+This function must *only* be called within the body of
+`with-elfeed-db-visit' because it may perform a non-local exit."
+ (let ((after (plist-get filter :after))
+ (must-have (plist-get filter :must-have))
+ (must-not-have (plist-get filter :must-not-have))
+ (matches (plist-get filter :matches))
+ (not-matches (plist-get filter :not-matches))
+ (limit (plist-get filter :limit))
+ (feeds (plist-get filter :feeds)))
+ (let* ((tags (elfeed-entry-tags entry))
+ (date (elfeed-entry-date entry))
+ (age (- (float-time) date))
+ (title (or (elfeed-meta entry :title) (elfeed-entry-title entry)))
+ (link (elfeed-entry-link entry))
+ (feed-title
+ (or (elfeed-meta feed :title) (elfeed-feed-title feed) ""))
+ (feed-id (elfeed-feed-id feed)))
+ (when (or (and after (> age after))
+ (and limit (<= limit 0))
+ (and limit count (>= count limit)))
+ (elfeed-db-return))
+ (and (cl-every (lambda (tag) (memq tag tags)) must-have)
+ (cl-notany (lambda (tag) (memq tag tags)) must-not-have)
+ (or (null matches)
+ (cl-every
+ (lambda (m)
+ (or (and title (string-match-p m title))
+ (and link (string-match-p m link))))
+ matches))
+ (cl-notany (lambda (m)
+ (or (and title (string-match-p m title))
+ (and link (string-match-p m link))))
+ not-matches)
+ (or (null feeds)
+ (cl-some (lambda (f)
+ (or (string-match-p f feed-id)
+ (string-match-p f feed-title)))
+ feeds))))))
+
+(defun elfeed-search-compile-filter (filter)
+ "Compile FILTER into a lambda function for `byte-compile'.
+
+Executing a filter in bytecode form is generally faster than
+\"interpreting\" the filter with `elfeed-search-filter'."
+ (let ((after (plist-get filter :after))
+ (must-have (plist-get filter :must-have))
+ (must-not-have (plist-get filter :must-not-have))
+ (matches (plist-get filter :matches))
+ (not-matches (plist-get filter :not-matches))
+ (limit (plist-get filter :limit))
+ (feeds (plist-get filter :feeds)))
+ `(lambda (,(if (or after matches not-matches must-have must-not-have)
+ 'entry
+ '_entry)
+ ,(if feeds
+ 'feed
+ '_feed)
+ ,(if limit
+ 'count
+ '_count))
+ (let* (,@(when after
+ '((date (elfeed-entry-date entry))
+ (age (- (float-time) date))))
+ ,@(when (or must-have must-not-have)
+ '((tags (elfeed-entry-tags entry))))
+ ,@(when (or matches not-matches)
+ '((title (or (elfeed-meta entry :title)
+ (elfeed-entry-title entry)))
+ (link (elfeed-entry-link entry))))
+ ,@(when feeds
+ '((feed-id (elfeed-feed-id feed))
+ (feed-title (or (elfeed-meta feed :title)
+ (elfeed-feed-title feed) "")))))
+ ,@(when after
+ `((when (> age ,after)
+ (elfeed-db-return))))
+ ,@(when limit
+ `((when (>= count ,limit)
+ (elfeed-db-return))))
+ (and ,@(cl-loop for forbid in must-not-have
+ collect `(not (memq ',forbid tags)))
+ ,@(cl-loop for forbid in must-have
+ collect `(memq ',forbid tags))
+ ,@(cl-loop for regex in matches collect
+ `(or (string-match-p ,regex title)
+ (string-match-p ,regex link)))
+ ,@(cl-loop for regex in not-matches collect
+ `(not
+ (or (string-match-p ,regex title)
+ (string-match-p ,regex link))))
+ ,@(when feeds
+ `((or ,@(cl-loop
+ for regex in feeds
+ collect `(string-match-p ,regex feed-id)
+ collect `(string-match-p ,regex feed-title))))))))))
+
+(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-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. No posts older
+than this are allowed. Ex. \"@3-days-ago\" or \"@1-year-old\".
+
+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 (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 (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 (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 (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 (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)
+ (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 "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-expose #'elfeed-show-tag 'unread))
+ (define-key map "+" 'elfeed-show-tag)
+ (define-key map "-" 'elfeed-show-untag)
+ (define-key map (kbd "SPC") 'scroll-up-command)
+ (define-key map (kbd "DEL") 'scroll-down-command)
+ (define-key map "\t" 'shr-next-link)
+ (define-key map [tab] 'shr-next-link)
+ (define-key map "\e\t" 'shr-previous-link)
+ (define-key map [backtab] 'shr-previous-link)
+ (define-key map [mouse-2] 'shr-browse-url)
+ (define-key map "A" 'elfeed-show-add-enclosure-to-playlist)
+ (define-key map "P" 'elfeed-show-play-enclosure)))
+ "Keymap for `elfeed-show-mode'.")
+
+(defun elfeed-show-mode ()
+ "Mode for displaying Elfeed feed entries.
+\\{elfeed-show-mode-map}"
+ (interactive)
+ (kill-all-local-variables)
+ (use-local-map elfeed-show-mode-map)
+ (setq major-mode 'elfeed-show-mode
+ mode-name "elfeed-show"
+ buffer-read-only t)
+ (buffer-disable-undo)
+ (make-local-variable 'elfeed-show-entry)
+ (run-mode-hooks 'elfeed-show-mode-hook))
+
+(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-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)))
+ (author (elfeed-meta elfeed-show-entry :author))
+ (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 (and author elfeed-show-entry-author)
+ (insert (format (propertize "Author: %s\n" 'face 'message-header-name)
+ (propertize author '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))
+
+(defun elfeed-show-entry (entry)
+ "Display ENTRY in the current buffer."
+ (let ((buff (get-buffer-create "*elfeed-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-show-play-enclosure (&optional entry enclosure-index)
+ "Play enclosure number ENCLOSURE-INDEX from ENTRY using emms.
+If ENTRY is nil use the elfeed-show-entry variable.
+If ENCLOSURE-INDEX is nil ask for the enclosure number."
+ (interactive)
+ (require 'emms) ;; optional
+ (let* ((entry (or entry elfeed-show-entry))
+ (enclosure-index (or enclosure-index
+ (elfeed--get-enclosure-num
+ "Enclosure to play" entry)))
+ (url-enclosure (car (elt (elfeed-entry-enclosures entry)
+ (- enclosure-index 1)))))
+ (with-no-warnings ;; due to lazy (require)
+ (with-current-emms-playlist
+ (let ((old-pos (point-max)))
+ (emms-add-url url-enclosure)
+ (goto-char old-pos)
+ ;; if we're sitting on a group name, move forward
+ (unless (emms-playlist-track-at (point))
+ (emms-playlist-next))
+ (emms-playlist-select (point)))
+ ;; FIXME: is there a better way of doing this?
+ (emms-stop)
+ (emms-start)))))
+
+(defun elfeed-show-add-enclosure-to-playlist (&optional entry enclosure-index)
+ "Play enclosure number ENCLOSURE-INDEX from ENTRY using emms.
+If ENTRY is nil use the elfeed-show-entry variable.
+If ENCLOSURE-INDEX is nil ask for the enclosure number."
+ (interactive)
+ (require 'emms) ;; optional
+ (let* ((entry (or entry elfeed-show-entry))
+ (enclosure-index (or enclosure-index
+ (elfeed--get-enclosure-num
+ "Enclosure to add" entry)))
+ (url-enclosure (car (elt (elfeed-entry-enclosures entry)
+ (- enclosure-index 1)))))
+ (with-no-warnings ;; due to lazy (require )
+ (emms-add-url url-enclosure))))
+
+(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.1.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))
+
+(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)))
+ (author (elfeed-cleanup (xml-query* (feed author name *) 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) author)
+ (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
+ (author-name (or (xml-query* (author name *) entry)
+ ;; Dublin Core
+ (xml-query* (creator *) entry)))
+ (author-email (xml-query* (author email *) entry))
+ (author (cond ((and author-name author-email)
+ (format "%s <%s>" author-name author-email))
+ (author-name)))
+ (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 author
+ (list :author author))
+ ,@(when categories
+ (list :categories categories))))))
+ (dolist (hook elfeed-new-entry-parse-hook)
+ (funcall hook :atom entry db-entry))
+ db-entry))))
+
+(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)))
+ (author (or (xml-query* (author *) item)
+ ;; Dublin Core
+ (xml-query* (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 author
+ (list :author author))
+ ,@(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
projects / emacsconfig.git / commitdiff