From: Andreas Gerler Date: Fri, 31 Jan 2020 16:20:12 +0000 (+0100) Subject: update elfeed X-Git-Url: http://git.bundesbrandschatzamt.de/?a=commitdiff_plain;h=1c0b159a22f7616f5a64143b4c688a3813e44e6c;p=emacsconfig.git update elfeed --- diff --git a/bba.org b/bba.org index 0998be2f..bf04b449 100644 --- a/bba.org +++ b/bba.org @@ -2457,7 +2457,7 @@ necessary. #+BEGIN_SRC emacs-lisp :tangle yes (if (>= emacs-major-version 24) (progn - (add-to-list 'load-path "~/.emacs.d/elpa/elfeed-20190903.1137") + (add-to-list 'load-path "~/.emacs.d/elpa/elfeed-20191227.426") (add-to-list 'load-path "~/.emacs.d/elpa/elfeed-org-20181015.1100") (require 'elfeed-org) (elfeed-org) diff --git a/elpa/elfeed-20190903.1137/elfeed-autoloads.el b/elpa/elfeed-20190903.1137/elfeed-autoloads.el deleted file mode 100644 index 2ff865f6..00000000 --- a/elpa/elfeed-20190903.1137/elfeed-autoloads.el +++ /dev/null @@ -1,88 +0,0 @@ -;;; elfeed-autoloads.el --- automatically extracted autoloads -;; -;;; Code: -(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path)))) - -;;;### (autoloads nil "elfeed" "elfeed.el" (23994 46772 779889 431000)) -;;; 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) - -;;;*** - -;;;### (autoloads nil "elfeed-link" "elfeed-link.el" (23994 46772 -;;;;;; 776361 167000)) -;;; 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-. 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)))))) - -;;;*** - -;;;### (autoloads nil "elfeed-search" "elfeed-search.el" (23994 46772 -;;;;;; 775272 903000)) -;;; 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)) - -;;;*** - -;;;### (autoloads nil nil ("elfeed-csv.el" "elfeed-curl.el" "elfeed-db.el" -;;;;;; "elfeed-lib.el" "elfeed-log.el" "elfeed-pkg.el" "elfeed-show.el" -;;;;;; "xml-query.el") (23994 46772 783267 598000)) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; End: -;;; elfeed-autoloads.el ends here diff --git a/elpa/elfeed-20190903.1137/elfeed-csv.el b/elpa/elfeed-20190903.1137/elfeed-csv.el deleted file mode 100644 index ae1f1457..00000000 --- a/elpa/elfeed-20190903.1137/elfeed-csv.el +++ /dev/null @@ -1,176 +0,0 @@ -;;; 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 diff --git a/elpa/elfeed-20190903.1137/elfeed-curl.el b/elpa/elfeed-20190903.1137/elfeed-curl.el deleted file mode 100644 index 9e3308d8..00000000 --- a/elpa/elfeed-20190903.1137/elfeed-curl.el +++ /dev/null @@ -1,503 +0,0 @@ -;;; elfeed-curl.el --- curl backend for Elfeed -*- lexical-binding: t; -*- - -;;; Comments: - -;; An alternative to `url-retrieve' and `url-queue' that fetches URLs -;; using the curl command line program. - -;; The API is three functions: - -;; * `elfeed-curl-retrieve' -;; * `elfeed-curl-retrieve-synchronously' -;; * `elfeed-curl-enqueue' - -;; And has four buffer-local variables for use in callbacks: - -;; * `elfeed-curl-headers' -;; * `elfeed-curl-status-code' -;; * `elfeed-curl-error-message' -;; * `elfeed-curl-location' - -;; The buffer delivered to callbacks may contain multiple requests. It -;; will be narrowed to the specific content for the current request. -;; It's vitally important that callbacks do not kill the buffer -;; because it may be needed for other callbacks. It also means the -;; buffer won't necessarily be around when the callback returns. -;; Callbacks should also avoid editing the buffer, though this -;; generally shouldn't impact other requests. - -;; Sometimes Elfeed asks curl to retrieve multiple requests and -;; deliver them concatenated. Due to the possibility of HTTP/1.0 being -;; involved — and other ambiguous-length protocols — there's no -;; perfectly unambiguous way to split the output. To work around this, -;; I use curl's --write-out to insert a randomly-generated token after -;; each request. It's highly unlikely (1 in ~1e38) that this token -;; will appear in content, so I can use it to identify the end of each -;; request. - -;;; Code: - -(require 'url) -(require 'cl-lib) -(require 'elfeed-lib) -(require 'elfeed-log) - -(defcustom elfeed-curl-program-name "curl" - "Name/path by which to invoke the curl program." - :group 'elfeed - :type 'string) - -(defcustom elfeed-curl-max-connections 16 - "Maximum number of concurrent fetches." - :group 'elfeed - :type 'integer) - -(defcustom elfeed-curl-timeout 30 - "Maximum number of seconds a fetch is allowed to take once started." - :group 'elfeed - :type 'integer) - -(defcustom elfeed-curl-extra-arguments () - "A list of additional arguments to pass to cURL. -These extra arguments are appended after Elfeed's own arguments, -and care must be taken to not interfere with Elfeed's needs. The -guideline is to avoid arguments that change anything about cURL's -output format." - :group 'elfeed - :type '(repeat string)) - -(defvar elfeed-curl-queue () - "List of pending curl requests.") - -(defvar elfeed-curl-queue-active 0 - "Number of concurrent requests currently active.") - -(defvar-local elfeed-curl-headers nil - "Alist of HTTP response headers.") - -(defvar-local elfeed-curl-status-code nil - "Numeric HTTP response code, nil for non-HTTP protocols.") - -(defvar-local elfeed-curl-error-message nil - "Human-friendly message describing the error.") - -(defvar-local elfeed-curl-location nil - "Actual URL fetched (after any redirects).") - -(defvar-local elfeed-curl--regions () - "List of markers bounding separate requests.") - -(defvar-local elfeed-curl--requests () - "List of URL / callback pairs for the current buffer.") - -(defvar-local elfeed-curl--token nil - "Unique token that splits requests.") - -(defvar-local elfeed-curl--refcount nil - "Number of callbacks waiting on the current buffer.") - -(defvar elfeed-curl--error-codes - '((1 . "Unsupported protocol.") - (2 . "Failed to initialize.") - (3 . "URL malformed. The syntax was not correct.") - (4 . "A feature or option that was needed to perform the desired request was not enabled or was explicitly disabled at build-time.") - (5 . "Couldn't resolve proxy. The given proxy host could not be resolved.") - (6 . "Couldn't resolve host. The given remote host was not resolved.") - (7 . "Failed to connect to host.") - (8 . "FTP weird server reply. The server sent data curl couldn't parse.") - (9 . "FTP access denied.") - (11 . "FTP weird PASS reply.") - (13 . "FTP weird PASV reply.") - (14 . "FTP weird 227 format.") - (15 . "FTP can't get host.") - (16 . "A problem was detected in the HTTP2 framing layer.") - (17 . "FTP couldn't set binary.") - (18 . "Partial file. Only a part of the file was transferred.") - (19 . "FTP couldn't download/access the given file, the RETR (or similar) command failed.") - (21 . "FTP quote error. A quote command returned error from the server.") - (22 . "HTTP page not retrieved.") - (23 . "Write error.") - (25 . "FTP couldn't STOR file.") - (26 . "Read error. Various reading problems.") - (27 . "Out of memory. A memory allocation request failed.") - (28 . "Operation timeout.") - (30 . "FTP PORT failed.") - (31 . "FTP couldn't use REST.") - (33 . "HTTP range error. The range \"command\" didn't work.") - (34 . "HTTP post error. Internal post-request generation error.") - (35 . "SSL connect error. The SSL handshaking failed.") - (36 . "FTP bad download resume.") - (37 . "FILE couldn't read file.") - (38 . "LDAP bind operation failed.") - (39 . "LDAP search failed.") - (41 . "Function not found. A required LDAP function was not found.") - (42 . "Aborted by callback.") - (43 . "Internal error. A function was called with a bad parameter.") - (45 . "Interface error. A specified outgoing interface could not be used.") - (47 . "Too many redirects.") - (48 . "Unknown option specified to libcurl.") - (49 . "Malformed telnet option.") - (51 . "The peer's SSL certificate or SSH MD5 fingerprint was not OK.") - (52 . "The server didn't reply anything, which here is considered an error.") - (53 . "SSL crypto engine not found.") - (54 . "Cannot set SSL crypto engine as default.") - (55 . "Failed sending network data.") - (56 . "Failure in receiving network data.") - (58 . "Problem with the local certificate.") - (59 . "Couldn't use specified SSL cipher.") - (60 . "Peer certificate cannot be authenticated with known CA certificates.") - (61 . "Unrecognized transfer encoding.") - (62 . "Invalid LDAP URL.") - (63 . "Maximum file size exceeded.") - (64 . "Requested FTP SSL level failed.") - (65 . "Sending the data requires a rewind that failed.") - (66 . "Failed to initialise SSL Engine.") - (67 . "The user name, password, or similar was not accepted and curl failed to log in.") - (68 . "File not found on TFTP server.") - (69 . "Permission problem on TFTP server.") - (70 . "Out of disk space on TFTP server.") - (71 . "Illegal TFTP operation.") - (72 . "Unknown TFTP transfer ID.") - (73 . "File already exists (TFTP).") - (74 . "No such user (TFTP).") - (75 . "Character conversion failed.") - (76 . "Character conversion functions required.") - (77 . "Problem with reading the SSL CA cert (path? access rights?).") - (78 . "The resource referenced in the URL does not exist.") - (79 . "An unspecified error occurred during the SSH session.") - (80 . "Failed to shut down the SSL connection.") - (82 . "Could not load CRL file, missing or wrong format (added in 7.19.0).") - (83 . "Issuer check failed (added in 7.19.0).") - (84 . "The FTP PRET command failed") - (85 . "RTSP: mismatch of CSeq numbers") - (86 . "RTSP: mismatch of Session Identifiers") - (87 . "unable to parse FTP file list") - (88 . "FTP chunk callback reported error") - (89 . "No connection available, the session will be queued") - (90 . "SSL public key does not matched pinned public key"))) - -(defvar elfeed-curl--capabilities-cache - (make-hash-table :test 'eq :weakness 'key) - "Used to avoid invoking curl more than once for version info.") - -(defun elfeed-curl-get-capabilities () - "Return capabilities plist for the curl at `elfeed-curl-program-name'. -:version -- cURL's version string -:compression -- non-nil if --compressed is supported" - (let* ((cache elfeed-curl--capabilities-cache) - (cache-value (gethash elfeed-curl-program-name cache))) - (if cache-value - cache-value - (with-temp-buffer - (call-process elfeed-curl-program-name nil t nil "--version") - (let ((version - (progn - (setf (point) (point-min)) - (when (re-search-forward "[.0-9]+" nil t) - (match-string 0)))) - (compression - (progn - (setf (point) (point-min)) - (not (null (re-search-forward "libz\\>" nil t)))))) - (setf (gethash elfeed-curl-program-name cache) - `(:version ,version :compression ,compression))))))) - -(defun elfeed-curl-get-version () - "Return the version of curl for `elfeed-curl-program-name'." - (plist-get (elfeed-curl-get-capabilities) :version)) -(make-obsolete 'elfeed-curl-get-version 'elfeed-curl-get-capabilities "3.0.1") - -(defun elfeed-curl--token () - "Return a unique, random string that prints as a symbol without escapes. -This token is used to split requests. The % is excluded since -it's special to --write-out." - (let* ((token (make-string 22 ?=)) - (set "!$&*+-/0123456789:<>@ABCDEFGHIJKLMNOPQRSTUVWXYZ^_\ -abcdefghijklmnopqrstuvwxyz|~")) - (prog1 token ; workaround bug#16206 - (dotimes (i (- (length token) 2)) - (setf (aref token (1+ i)) (aref set (cl-random (length set)))))))) - -(defun elfeed-curl--parse-write-out () - "Parse curl's write-out (-w) messages into `elfeed-curl--regions'." - (widen) - (setf (point) (point-max) - elfeed-curl--regions ()) - (while (> (point) (point-min)) - (search-backward elfeed-curl--token) - (cl-decf (point)) - (let ((end (point))) - (cl-destructuring-bind (_ . header) (read (current-buffer)) - (setf (point) end) - ;; Find next sentinel token - (if (search-backward elfeed-curl--token nil t) - (search-forward ")" nil t) - (setf (point) (point-min))) - (let* ((header-start (point)) - (header-end (+ (point) header)) - (content-start (+ (point) header)) - (content-end end) - (regions (list header-start header-end - content-start content-end)) - (markers (cl-loop for p in regions - for marker = (make-marker) - collect (set-marker marker p)))) - (push markers elfeed-curl--regions)))))) - -(defun elfeed-curl--narrow (kind n) - "Narrow to Nth region of KIND (:header, :content)." - (let ((region (nth n elfeed-curl--regions))) - (cl-destructuring-bind (h-start h-end c-start c-end) region - (cl-ecase kind - (:header (narrow-to-region h-start h-end)) - (:content (narrow-to-region c-start c-end)))))) - -(defun elfeed-curl--parse-headers () - "Parse the current HTTP response headers into buffer-locals. -Sets `elfeed-curl-headers'and `elfeed-curl-status-code'. -Use `elfeed-curl--narrow' to select a header." - (when (> (- (point-max) (point-min)) 0) - (setf (point) (point-max)) - (re-search-backward "HTTP/[.0-9]+ +\\([0-9]+\\)") - (setf elfeed-curl-status-code (string-to-number (match-string 1))) - (cl-loop initially (setf (point) (point-max)) - while (re-search-backward "^\\([^:]+\\): +\\([^\r\n]+\\)" nil t) - for key = (downcase (match-string 1)) - for value = (match-string 2) - collect (cons key value) into headers - finally (setf elfeed-curl-headers headers)))) - -(defun elfeed-curl--decode () - "Try to decode the buffer based on the headers." - (let ((content-type (cdr (assoc "Content-Type" elfeed-curl-headers)))) - (if (and content-type (string-match "charset=\\(.+\\)" content-type)) - (decode-coding-region (point-min) (point-max) - (coding-system-from-name - (match-string 1 content-type))) - (decode-coding-region (point-min) (point-max) 'utf-8)))) - -(defun elfeed-curl--final-location (location headers) - "Given start LOCATION and HEADERS, find the final location." - (cl-loop for (key . value) in headers - when (equal key "location") - do (setf location (elfeed-update-location location value)) - finally return location)) - -(defun elfeed-curl--args (url token &optional headers method data) - "Build an argument list for curl for URL. -URL can be a string or a list of URL strings." - (let* ((args ()) - (capabilities (elfeed-curl-get-capabilities))) - (push "--disable" args) - (when (plist-get capabilities :compression) - (push "--compressed" args)) - (push "--silent" args) - (push "--location" args) - (push (format "-w(%s . %%{size_header})" token) args) - (push (format "-m%s" elfeed-curl-timeout) args) - (push "-D-" args) - (dolist (header headers) - (cl-destructuring-bind (key . value) header - (push (format "-H%s: %s" key value) args))) - (when method (push (format "-X%s" method) args)) - (when data (push (format "-d%s" data) args)) - (setf args (nconc (reverse elfeed-curl-extra-arguments) args)) - (if (listp url) - (nconc (nreverse args) url) - (nreverse (cons url args))))) - -(defun elfeed-curl--prepare-response (url n) - "Prepare response N for delivery to user." - (elfeed-curl--narrow :header n) - (elfeed-curl--parse-headers) - (setf elfeed-curl-location - (elfeed-curl--final-location url elfeed-curl-headers)) - (elfeed-curl--narrow :content n) - (elfeed-curl--decode) - (current-buffer)) - -(cl-defun elfeed-curl-retrieve-synchronously (url &key headers method data) - "Retrieve the contents for URL and return a new buffer with them. - -HEADERS is an alist of additional headers to add to the HTTP request. -METHOD is the HTTP method to use. -DATA is the content to include in the request." - (with-current-buffer (generate-new-buffer " *curl*") - (setf elfeed-curl--token (elfeed-curl--token)) - (let ((args (elfeed-curl--args url elfeed-curl--token headers method data)) - (coding-system-for-read 'binary)) - (apply #'call-process elfeed-curl-program-name nil t nil args)) - (elfeed-curl--parse-write-out) - (elfeed-curl--prepare-response url 0))) - -(defun elfeed-curl--call-callback (buffer n url cb) - "Prepare the buffer for callback N and call it." - (let ((result nil)) - (with-current-buffer buffer - (setf elfeed-curl-error-message "unable to parse curl response") - (unwind-protect - (progn - (elfeed-curl--prepare-response url n) - (if (and (>= elfeed-curl-status-code 400) - (<= elfeed-curl-status-code 599)) - (setf elfeed-curl-error-message - (format "HTTP %d" elfeed-curl-status-code)) - (setf result t - elfeed-curl-error-message nil))) - ;; Always call callback - (unwind-protect - (funcall cb result) - ;; Always clean up - (when (zerop (cl-decf elfeed-curl--refcount)) - (kill-buffer))))))) - -(defun elfeed-curl--fail-callback (buffer cb) - "Inform the callback the request failed." - (with-current-buffer buffer - (unwind-protect - (funcall cb nil) - (when (zerop (cl-decf elfeed-curl--refcount)) - (kill-buffer))))) - -(defun elfeed-curl--sentinel (process status) - "Manage the end of a curl process' life." - (let ((buffer (process-buffer process))) - (with-current-buffer buffer - ;; Fire off callbacks in separate interpreter turns so they can - ;; each fail in isolation from each other. - (if (equal status "finished\n") - (cl-loop with handler = #'elfeed-curl--call-callback - initially do (elfeed-curl--parse-write-out) - for (url . cb) in elfeed-curl--requests - for n upfrom 0 - do (run-at-time 0 nil handler buffer n url cb)) - (if (string-match "exited abnormally with code \\([0-9]+\\)" status) - (let* ((code (string-to-number (match-string 1 status))) - (message (cdr (assoc code elfeed-curl--error-codes)))) - (setf elfeed-curl-error-message - (format "(%d) %s" code - (or message "Unknown curl error!")))) - (setf elfeed-curl-error-message status)) - (cl-loop with handler = #'elfeed-curl--fail-callback - for (_ . cb) in elfeed-curl--requests - do (run-at-time 0 nil handler buffer cb)))))) - -(cl-defun elfeed-curl-retrieve (url cb &key headers method data) - "Retrieve URL contents asynchronously, calling CB with one status argument. - -The callback must *not* kill the buffer! - -The destination buffer is set at the current buffer for the -callback. - -HEADERS is an alist of additional headers to add to HTTP requests. -METHOD is the HTTP method to use. -DATA is the content to include in the request. - -URL can be a list of URLs, which will fetch them all in the same -curl process. In this case, CB can also be either a list of the -same length, or just a single function to be called once for each -URL in the list. Headers will be common to all requests. A TCP or -DNS failure in one will cause all to fail, but 4xx and 5xx -results will not." - (with-current-buffer (generate-new-buffer " *curl*") - (setf elfeed-curl--token (elfeed-curl--token)) - (let* ((coding-system-for-read 'binary) - (process-connection-type nil) - (args (elfeed-curl--args url elfeed-curl--token headers method data)) - (process (apply #'start-process "elfeed-curl" (current-buffer) - elfeed-curl-program-name args))) - (prog1 process - (if (listp url) - (progn - (when (functionp cb) - (setf cb (make-list (length url) cb))) - (setf elfeed-curl--requests (cl-mapcar #'cons url cb) - elfeed-curl--refcount (length url))) - (push (cons url cb) elfeed-curl--requests) - (setf elfeed-curl--refcount 1)) - (setf (process-sentinel process) #'elfeed-curl--sentinel))))) - -(defun elfeed-curl--request-key (url headers method data) - "Try to fetch URLs with matching keys at the same time." - (unless (listp url) - (let* ((urlobj (url-generic-parse-url url))) - (list (url-type urlobj) - (url-host urlobj) - (url-portspec urlobj) - headers - method - data)))) - -(defun elfeed-curl--queue-consolidate (queue-in) - "Group compatible requests together and return a new queue. -Compatible means the requests have the same protocol, domain, -port, headers, method, and body, allowing them to be used safely -in the same curl invocation." - (let ((table (make-hash-table :test 'equal)) - (keys ()) - (queue-out ())) - (dolist (entry queue-in) - (cl-destructuring-bind (url _ headers method data) entry - (let* ((key (elfeed-curl--request-key url headers method data))) - (push key keys) - (push entry (gethash key table nil))))) - (dolist (key (nreverse keys)) - (let ((entry (gethash key table))) - (when entry - (let ((rotated (list (nreverse (cl-mapcar #'car entry)) - (nreverse (cl-mapcar #'cadr entry)) - (cl-caddar entry) - (elt (car entry) 3) - (elt (car entry) 4)))) - (push rotated queue-out) - (setf (gethash key table) nil))))) - (nreverse queue-out))) - -(defun elfeed-curl--queue-wrap (cb) - "Wrap the curl CB so that it operates the queue." - (lambda (status) - (cl-decf elfeed-curl-queue-active) - (elfeed-curl--run-queue) - (funcall cb status))) - -(defvar elfeed-curl--run-queue-queued nil - "Non-nil if run-queue has already been queued for the next turn.") - -(defun elfeed-curl--run-queue () - "Possibly fire off some new requests." - (when elfeed-curl--run-queue-queued - (setf elfeed-curl--run-queue-queued nil - ;; Try to consolidate the new requests. - elfeed-curl-queue - (elfeed-curl--queue-consolidate elfeed-curl-queue))) - (while (and (< elfeed-curl-queue-active elfeed-curl-max-connections) - (> (length elfeed-curl-queue) 0)) - (cl-destructuring-bind (url cb headers method data) (pop elfeed-curl-queue) - (elfeed-log 'debug "retrieve %s" url) - (cl-incf elfeed-curl-queue-active 1) - (elfeed-curl-retrieve - url - (if (functionp cb) - (elfeed-curl--queue-wrap cb) - (cons (elfeed-curl--queue-wrap (car cb)) - (cdr cb))) - :headers headers - :method method - :data data)))) - -(cl-defun elfeed-curl-enqueue (url cb &key headers method data) - "Just like `elfeed-curl-retrieve', but restricts concurrent fetches." - (unless (or (stringp url) - (and (listp url) (cl-every #'stringp url))) - ;; Signal error synchronously instead of asynchronously in the timer - (signal 'wrong-type-argument (list 'string-p-or-string-list-p url))) - (let ((entry (list url cb headers method data))) - (setf elfeed-curl-queue (nconc elfeed-curl-queue (list entry))) - (unless elfeed-curl--run-queue-queued - (run-at-time 0 nil #'elfeed-curl--run-queue) - (setf elfeed-curl--run-queue-queued t)))) - -(provide 'elfeed-curl) - -;;; elfeed-curl.el ends here diff --git a/elpa/elfeed-20190903.1137/elfeed-db.el b/elpa/elfeed-20190903.1137/elfeed-db.el deleted file mode 100644 index 4000a0bb..00000000 --- a/elpa/elfeed-20190903.1137/elfeed-db.el +++ /dev/null @@ -1,646 +0,0 @@ -;;; 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 diff --git a/elpa/elfeed-20190903.1137/elfeed-lib.el b/elpa/elfeed-20190903.1137/elfeed-lib.el deleted file mode 100644 index 5168a390..00000000 --- a/elpa/elfeed-20190903.1137/elfeed-lib.el +++ /dev/null @@ -1,382 +0,0 @@ -;;; elfeed-lib.el --- misc functions for elfeed -*- lexical-binding: t; -*- - -;; This is free and unencumbered software released into the public domain. - -;;; Commentary: - -;; These are general functions that aren't specific to web feeds. It's -;; a library of useful functions to Elfeed. - -;;; Code: - -(require 'xml) -(require 'cl-lib) -(require 'time-date) -(require 'url-parse) -(require 'url-util) - -(defun elfeed-expose (function &rest args) - "Return an interactive version of FUNCTION, 'exposing' it to the user." - (lambda () (interactive) (apply function args))) - -(defun elfeed-goto-line (n) - "Like `goto-line' but for non-interactive use." - (goto-char (point-min)) - (forward-line (1- n))) - -(defun elfeed-kill-buffer () - "Kill the current buffer." - (interactive) - (kill-buffer (current-buffer))) - -(defun elfeed-kill-line () - "Clear out the current line without touching anything else." - (beginning-of-line) - (let ((start (point))) - (end-of-line) - (delete-region start (point)))) - -(defun elfeed-time-duration (time &optional now) - "Turn a time expression into a number of seconds. Uses -`timer-duration' but allows a bit more flair. - -If `now' is non-nil, use it as the current time (`float-time'). This -is mostly useful for testing." - (cond - ((numberp time) time) - ((let ((iso-time (elfeed-parse-simple-iso-8601 time))) - (when iso-time (- (or now (float-time)) iso-time)))) - ((string-match-p "[[:alpha:]]" time) - (let* ((clean (replace-regexp-in-string "\\(ago\\|old\\|-\\)" " " time)) - (duration (timer-duration clean))) - ;; convert to float since float-time is used elsewhere - (when duration (float duration)))))) - -(defun elfeed-looks-like-url-p (string) - "Return true if STRING looks like it could be a URL." - (and (stringp string) - (not (string-match-p "[ \n\t\r]" string)) - (not (null (url-type (url-generic-parse-url string)))))) - -(defun elfeed-format-column (string width &optional align) - "Return STRING truncated or padded to WIDTH following ALIGNment. -Align should be a keyword :left or :right." - (if (<= width 0) - "" - (format (format "%%%s%d.%ds" (if (eq align :left) "-" "") width width) - string))) - -(defun elfeed-clamp (min value max) - "Clamp a value between two values." - (min max (max min value))) - -(defun elfeed-valid-regexp-p (regexp) - "Return t if REGEXP is a valid REGEXP." - (ignore-errors - (prog1 t - (string-match-p regexp "")))) - -(defun elfeed-cleanup (name) - "Trim trailing and leading spaces and collapse multiple spaces." - (let ((trim (replace-regexp-in-string "[\f\n\r\t\v ]+" " " (or name "")))) - (replace-regexp-in-string "^ +\\| +$" "" trim))) - -(defun elfeed-parse-simple-iso-8601 (string) - "Attempt to parse STRING as a simply formatted ISO 8601 date. -Examples: 2015-02-22, 2015-02, 20150222" - (let* ((re (cl-flet ((re-numbers (num) (format "\\([0-9]\\{%s\\}\\)" num))) - (format "^%s-?%s-?%s?\\(T%s:%s:?%s?\\)?" - (re-numbers 4) - (re-numbers 2) - (re-numbers 2) - (re-numbers 2) - (re-numbers 2) - (re-numbers 2)))) - (matches (save-match-data - (when (string-match re string) - (cl-loop for i from 1 to 7 - collect (let ((match (match-string i string))) - (and match (string-to-number match)))))))) - (when matches - (cl-multiple-value-bind (year month day _ hour min sec) matches - (float-time (encode-time (or sec 0) (or min 0) (or hour 0) - (or day 1) month year t)))))) - -(defun elfeed-new-date-for-entry (old-date new-date) - "Decide entry date, given an existing date (nil for new) and a new date. -Existing entries' dates are unchanged if the new date is not -parseable. New entries with unparseable dates default to the -current time." - (or (elfeed-float-time new-date) - old-date - (float-time))) - -(defun elfeed-float-time (date) - "Like `float-time' but accept anything reasonable for DATE. -Defaults to nil if DATE could not be parsed. Date is allowed to -be relative to now (`elfeed-time-duration')." - (cl-typecase date - (string - (let ((iso-8601 (elfeed-parse-simple-iso-8601 date))) - (if iso-8601 - iso-8601 - (let ((duration (elfeed-time-duration date))) - (if duration - (- (float-time) duration) - (let ((time (ignore-errors (date-to-time date)))) - ;; check if date-to-time failed, silently or otherwise - (unless (or (null time) (equal time '(14445 17280))) - (float-time time)))))))) - (integer date) - (otherwise nil))) - -(defun elfeed-xml-parse-region (&optional beg end buffer parse-dtd _parse-ns) - "Decode (if needed) and parse XML file. Uses coding system from -XML encoding declaration." - (unless beg (setq beg (point-min))) - (unless end (setq end (point-max))) - (setf (point) beg) - (when (re-search-forward - "<\\?xml.*?encoding=[\"']\\([^\"']+\\)[\"'].*?\\?>" nil t) - (let ((coding-system (intern-soft (downcase (match-string 1))))) - (when (ignore-errors (check-coding-system coding-system)) - (let ((mark-beg (make-marker)) - (mark-end (make-marker))) - ;; Region changes with encoding, so use markers to track it. - (set-marker mark-beg beg) - (set-marker mark-end end) - (set-buffer-multibyte t) - (recode-region mark-beg mark-end coding-system 'raw-text) - (setf beg (marker-position mark-beg) - end (marker-position mark-end)))))) - (let ((xml-default-ns ())) - (xml-parse-region beg end buffer parse-dtd 'symbol-qnames))) - -(defun elfeed-xml-unparse (element) - "Inverse of `elfeed-xml-parse-region', writing XML to the buffer." - (cl-destructuring-bind (tag attrs . body) element - (insert (format "<%s" tag)) - (dolist (attr attrs) - (cl-destructuring-bind (key . value) attr - (insert (format " %s='%s'" key (xml-escape-string value))))) - (if (null body) - (insert "/>") - (insert ">") - (dolist (sub body) - (if (stringp sub) - (insert (xml-escape-string sub)) - (elfeed-xml-unparse sub))) - (insert (format "" tag))))) - -(defun elfeed-directory-empty-p (dir) - "Return non-nil if DIR is empty." - (null (cddr (directory-files dir)))) - -(defun elfeed-slurp (file &optional literally) - "Return the contents of FILE as a string." - (with-temp-buffer - (if literally - (insert-file-contents-literally file) - (insert-file-contents file)) - (buffer-string))) - -(cl-defun elfeed-spit (file string &key fsync append (encoding 'utf-8)) - "Write STRING to FILE." - (let ((coding-system-for-write encoding) - (write-region-inhibit-fsync (not fsync))) - (with-temp-buffer - (insert string) - (write-region nil nil file append 0)))) - -(defvar elfeed-gzip-supported-p--cache :unknown - "To avoid running the relatively expensive test more than once.") - -(defun elfeed-gzip-supported-p () - "Return non-nil if `auto-compression-mode' can handle gzip." - (if (not (eq elfeed-gzip-supported-p--cache :unknown)) - elfeed-gzip-supported-p--cache - (setf elfeed-gzip-supported-p--cache - (and (executable-find "gzip") - (ignore-errors - (save-window-excursion - (let ((file (make-temp-file "gziptest" nil ".gz")) - (data (cl-loop for i from 32 to 3200 - collect i into chars - finally - (return (apply #'string chars))))) - (unwind-protect - (progn - (elfeed-spit file data) - (and (string= data (elfeed-slurp file)) - (not (string= data (elfeed-slurp file t))))) - (delete-file file))))))))) - -(defun elfeed-libxml-supported-p () - "Return non-nil if `libxml-parse-html-region' is available." - (with-temp-buffer - (insert "") - (and (fboundp 'libxml-parse-html-region) - (not (null (libxml-parse-html-region (point-min) (point-max))))))) - -(defun elfeed-keyword->symbol (keyword) - "If a keyword, convert KEYWORD into a plain symbol (remove the colon)." - (if (keywordp keyword) - (intern (substring (symbol-name keyword) 1)) - keyword)) - -(defun elfeed-resize-vector (vector length) - "Return a copy of VECTOR set to size LENGTH." - (let ((new-vector (make-vector length nil))) - (prog1 new-vector ; don't use dotimes result (bug#16206) - (dotimes (i (min (length new-vector) (length vector))) - (setf (aref new-vector i) (aref vector i)))))) - -(defun elfeed-readable-p (value) - "Return non-nil if VALUE can be serialized." - (condition-case _ - (prog1 t (read (prin1-to-string value))) - (error nil))) - -(defun elfeed-strip-properties (string) - "Return a copy of STRING with all properties removed. -If STRING is nil, returns nil." - (when string - (let ((copy (copy-sequence string))) - (prog1 copy - (set-text-properties 0 (length copy) nil copy))))) - -(defun elfeed-clipboard-get () - "Try to get a sensible value from the system clipboard. -On systems running X, it will try to use the PRIMARY selection -first, then fall back onto the standard clipboard like other -systems." - (elfeed-strip-properties - (or (and (fboundp 'x-get-selection) - (funcall 'x-get-selection)) - (and (functionp interprogram-paste-function) - (funcall interprogram-paste-function)) - (and (fboundp 'w32-get-clipboard-data) - (funcall 'w32-get-clipboard-data)) - (ignore-errors - (current-kill 0 :non-destructively))))) - -(defun elfeed-get-link-at-point () - "Try to a link at point and return its URL." - (or (get-text-property (point) 'shr-url) - (and (fboundp 'eww-current-url) - (funcall 'eww-current-url)) - (get-text-property (point) :nt-link))) - -(defun elfeed-get-url-at-point () - "Try to get a plain URL at point." - (or (url-get-url-at-point) - (thing-at-point 'url))) - -(defun elfeed-move-to-first-empty-line () - "Place point after first blank line, for use with `url-retrieve'. -If no such line exists, point is left in place." - (let ((start (point))) - (setf (point) (point-min)) - (unless (search-forward-regexp "^$" nil t) - (setf (point) start)))) - -(defun elfeed--shuffle (seq) - "Destructively shuffle SEQ." - (let ((n (length seq))) - (prog1 seq ; don't use dotimes result (bug#16206) - (dotimes (i n) - (cl-rotatef (elt seq i) (elt seq (+ i (cl-random (- n i))))))))) - -(defun elfeed-split-ranges-to-numbers (str n) - "Convert STR containing enclosure numbers into a list of numbers. -STR is a string; N is the highest possible number in the list. -This includes expanding e.g. 3-5 into 3,4,5. If the letter -\"a\" ('all')) is given, that is expanded to a list with numbers [1..n]." - (let ((str-split (split-string str)) - beg end list) - (dolist (elem str-split list) - ;; special number "a" converts into all enclosures 1-N. - (when (equal elem "a") - (setf elem (concat "1-" (int-to-string n)))) - (if (string-match "\\([0-9]+\\)-\\([0-9]+\\)" elem) - ;; we have found a range A-B, which needs converting - ;; into the numbers A, A+1, A+2, ... B. - (progn - (setf beg (string-to-number (match-string 1 elem)) - end (string-to-number (match-string 2 elem))) - (while (<= beg end) - (setf list (nconc list (list beg)) - beg (1+ beg)))) - ;; else just a number - (push (string-to-number elem) list))))) - -(defun elfeed-remove-dot-segments (input) - "Relative URL algorithm as described in RFC 3986 §5.2.4." - (cl-loop - with output = "" - for s = input - then (cond - ((string-match-p "^\\.\\./" s) - (substring s 3)) - ((string-match-p "^\\./" s) - (substring s 2)) - ((string-match-p "^/\\./" s) - (substring s 2)) - ((string-match-p "^/\\.$" s) "/") - ((string-match-p "^/\\.\\./" s) - (setf output (replace-regexp-in-string "/?[^/]*$" "" output)) - (substring s 3)) - ((string-match-p "^/\\.\\.$" s) - (setf output (replace-regexp-in-string "/?[^/]*$" "" output)) - "/") - ((string-match-p "^\\.\\.?$" s) - "") - ((string-match "^/?[^/]*" s) - (setf output (concat output (match-string 0 s))) - (replace-regexp-in-string "^/?[^/]*" "" s))) - until (zerop (length s)) - finally return output)) - -(defun elfeed-update-location (old-url new-url) - "Return full URL for maybe-relative NEW-URL based on full OLD-URL." - (if (null new-url) - old-url - (let ((old (url-generic-parse-url old-url)) - (new (url-generic-parse-url new-url))) - (cond - ;; Is new URL absolute already? - ((url-type new) new-url) - ;; Empty is a special case (clear fragment) - ((equal new-url "") - (setf (url-target old) nil) - (url-recreate-url old)) - ;; Does it start with //? Append the old protocol. - ((url-fullness new) (concat (url-type old) ":" new-url)) - ;; Is it a relative path? - ((not (string-match-p "^/" new-url)) - (let* ((old-dir (or (file-name-directory (url-filename old)) "/")) - (concat (concat old-dir new-url)) - (new-file (elfeed-remove-dot-segments concat))) - (setf (url-filename old) nil - (url-target old) nil - (url-attributes old) nil - (url-filename old) new-file) - (url-recreate-url old))) - ;; Replace the relative part. - ((progn - (setf (url-filename old) (elfeed-remove-dot-segments new-url) - (url-target old) nil - (url-attributes old) nil) - (url-recreate-url old))))))) - -(defun elfeed-url-to-namespace (url) - "Compute an ID namespace from URL." - (let* ((urlobj (url-generic-parse-url url)) - (host (url-host urlobj))) - (if (= 0 (length host)) - url - host))) - -(provide 'elfeed-lib) - -;;; elfeed-lib.el ends here diff --git a/elpa/elfeed-20190903.1137/elfeed-link.el b/elpa/elfeed-20190903.1137/elfeed-link.el deleted file mode 100644 index c127bf2e..00000000 --- a/elpa/elfeed-20190903.1137/elfeed-link.el +++ /dev/null @@ -1,80 +0,0 @@ -;;; elfeed-link.el --- misc functions for elfeed -*- lexical-binding: t; -*- - -;; This is free and unencumbered software released into the public domain. - -;;; Commentary: - -;; Code for integration with org-mode. - -;; To use, add (require 'elfeed-link) somewhere in your configuration. - -;;; Code: - -(require 'org) -(require 'cl-lib) -(require 'elfeed-db) -(require 'elfeed-show) -(require 'elfeed-search) - -;;;###autoload -(defun elfeed-link-store-link () - "Store a link to an elfeed search or entry buffer. - -When storing a link to an entry, automatically extract all the -entry metadata. These can be used in the capture templates as -%:elfeed-entry-. See `elfeed-entry--create' for the list -of available props." - (cond ((derived-mode-p 'elfeed-search-mode) - (org-store-link-props - :type "elfeed" - :link (format "elfeed:%s" elfeed-search-filter) - :description elfeed-search-filter)) - ((derived-mode-p 'elfeed-show-mode) - (apply - 'org-store-link-props - :type "elfeed" - :link (format "elfeed:%s#%s" - (car (elfeed-entry-id elfeed-show-entry)) - (cdr (elfeed-entry-id elfeed-show-entry))) - :description (elfeed-entry-title elfeed-show-entry) - (cl-loop for prop in - (list 'id 'title 'link 'date 'content 'content-type 'enclosures 'tags 'feed-id 'meta) - nconc (list - (intern (concat ":elfeed-entry-" (symbol-name prop))) - (funcall - (intern (concat "elfeed-entry-" (symbol-name prop))) - elfeed-show-entry))))))) - -;;;###autoload -(defun elfeed-link-open (filter-or-id) - "Jump to an elfeed entry or search. - -Depending on what FILTER-OR-ID looks like, we jump to either -search buffer or show a concrete entry." - (if (string-match "\\([^#]+\\)#\\(.+\\)" filter-or-id) - (elfeed-show-entry (elfeed-db-get-entry - (cons (match-string 1 filter-or-id) - (match-string 2 filter-or-id)))) - (elfeed) - (elfeed-search-set-filter filter-or-id))) - -;;;###autoload -(eval-after-load 'org - `(funcall - ;; The extra quote below is necessary because uncompiled closures - ;; do not evaluate to themselves. The quote is harmless for - ;; byte-compiled function objects. - ',(lambda () - (if (version< (org-version) "9.0") - (with-no-warnings - (org-add-link-type "elfeed" #'elfeed-link-open) - (add-hook 'org-store-link-functions #'elfeed-link-store-link)) - (with-no-warnings - (org-link-set-parameters - "elfeed" - :follow #'elfeed-link-open - :store #'elfeed-link-store-link)))))) - -(provide 'elfeed-link) - -;;; elfeed-link.el ends here diff --git a/elpa/elfeed-20190903.1137/elfeed-log.el b/elpa/elfeed-20190903.1137/elfeed-log.el deleted file mode 100644 index 9f91237f..00000000 --- a/elpa/elfeed-20190903.1137/elfeed-log.el +++ /dev/null @@ -1,84 +0,0 @@ -;;; 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 diff --git a/elpa/elfeed-20190903.1137/elfeed-pkg.el b/elpa/elfeed-20190903.1137/elfeed-pkg.el deleted file mode 100644 index d192f366..00000000 --- a/elpa/elfeed-20190903.1137/elfeed-pkg.el +++ /dev/null @@ -1,5 +0,0 @@ -(define-package "elfeed" "20190903.1137" "an Emacs Atom/RSS feed reader" - '((emacs "24.3"))) -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/elpa/elfeed-20190903.1137/elfeed-search.el b/elpa/elfeed-20190903.1137/elfeed-search.el deleted file mode 100644 index 2731a225..00000000 --- a/elpa/elfeed-20190903.1137/elfeed-search.el +++ /dev/null @@ -1,933 +0,0 @@ -;;; 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)) - -(defun elfeed-search-last-entry () - "Place point on first entry." - (interactive) - (setf (point) (point-max)) - (forward-line -2)) - -(defun elfeed-search-first-entry () - "Place point on last entry." - (interactive) - (setf (point) (point-min))) - -(defvar elfeed-search-mode-map - (let ((map (make-sparse-keymap))) - (prog1 map - (suppress-keymap map) - (define-key map "h" #'describe-mode) - (define-key map "q" #'elfeed-search-quit-window) - (define-key map "g" #'elfeed-search-update--force) - (define-key map "G" #'elfeed-search-fetch) - (define-key map (kbd "RET") #'elfeed-search-show-entry) - (define-key map "s" #'elfeed-search-live-filter) - (define-key map "S" #'elfeed-search-set-filter) - (define-key map "c" #'elfeed-search-clear-filter) - (define-key map "b" #'elfeed-search-browse-url) - (define-key map "y" #'elfeed-search-yank) - (define-key map "u" #'elfeed-search-tag-all-unread) - (define-key map "r" #'elfeed-search-untag-all-unread) - (define-key map "n" #'next-line) - (define-key map "p" #'previous-line) - (define-key map "+" #'elfeed-search-tag-all) - (define-key map "-" #'elfeed-search-untag-all) - (define-key map "<" #'elfeed-search-first-entry) - (define-key map ">" #'elfeed-search-last-entry))) - "Keymap for elfeed-search-mode.") - -(defun elfeed-search--intro-header () - "Return the header shown to new users." - (with-temp-buffer - (cl-flet ((button (f) - (insert-button (symbol-name f) - 'follow-link t - 'action (lambda (_) (call-interactively f))))) - (insert "Database empty. Use ") - (button 'elfeed-add-feed) - (insert ", or ") - (button 'elfeed-load-opml) - (insert ", or ") - (button 'elfeed-update) - (insert ".") - (buffer-string)))) - -(defun elfeed-search--count-unread () - "Count the number of entries and feeds being currently displayed." - (if (and elfeed-search-filter-active elfeed-search-filter-overflowing) - "?/?:?" - (cl-loop with feeds = (make-hash-table :test 'equal) - for entry in elfeed-search-entries - for feed = (elfeed-entry-feed entry) - for url = (elfeed-feed-url feed) - count entry into entry-count - count (elfeed-tagged-p 'unread entry) into unread-count - do (puthash url t feeds) - finally - (cl-return - (format "%d/%d:%d" - unread-count entry-count - (hash-table-count feeds)))))) - -(defvar elfeed-search--header-cache nil - "Cache of the last computed header.") - -(defun elfeed-search--header () - "Returns the string to be used as the Elfeed header." - (if (eql (car elfeed-search--header-cache) (buffer-modified-tick)) - (cdr elfeed-search--header-cache) - (let* ((header (elfeed-search--header-1)) - (cache (cons (buffer-modified-tick) header))) - (prog1 header - (setf elfeed-search--header-cache cache))))) - -(defun elfeed-search--header-1 () - "Computes the string to be used as the Elfeed header." - (cond - ((zerop (elfeed-db-last-update)) - (elfeed-search--intro-header)) - ((> (elfeed-queue-count-total) 0) - (let ((total (elfeed-queue-count-total)) - (in-process (elfeed-queue-count-active))) - (format "%d jobs pending, %d active..." - (- total in-process) in-process))) - ((let* ((db-time (seconds-to-time (elfeed-db-last-update))) - (update (format-time-string "%Y-%m-%d %H:%M" db-time)) - (unread (elfeed-search--count-unread))) - (format "Updated %s, %s%s" - (propertize update 'face 'elfeed-search-last-update-face) - (propertize unread 'face 'elfeed-search-unread-count-face) - (cond - (elfeed-search-filter-active "") - ((string-match-p "[^ ]" elfeed-search-filter) - (concat ", " (propertize elfeed-search-filter - 'face 'elfeed-search-filter-face))) - (""))))))) - -(defun elfeed-search-mode () - "Major mode for listing elfeed feed entries. -\\{elfeed-search-mode-map}" - (interactive) - (kill-all-local-variables) - (use-local-map elfeed-search-mode-map) - (setq major-mode 'elfeed-search-mode - mode-name "elfeed-search" - truncate-lines t - buffer-read-only t - desktop-save-buffer #'elfeed-search-desktop-save - header-line-format '(:eval (funcall elfeed-search-header-function))) - (set (make-local-variable 'bookmark-make-record-function) - #'elfeed-search-bookmark-make-record) - (buffer-disable-undo) - (hl-line-mode) - (make-local-variable 'elfeed-search-entries) - (make-local-variable 'elfeed-search-filter) - (add-hook 'elfeed-update-hooks #'elfeed-search-update) - (add-hook 'elfeed-update-init-hooks #'elfeed-search-update--force) - (add-hook 'kill-buffer-hook #'elfeed-db-save t t) - (add-hook 'elfeed-db-unload-hook #'elfeed-search--unload) - (elfeed-search-update :force) - (run-mode-hooks 'elfeed-search-mode-hook)) - -(defun elfeed-search-buffer () - (get-buffer-create "*elfeed-search*")) - -(defun elfeed-search--unload () - "Hook function for `elfeed-db-unload-hook'." - (with-current-buffer (elfeed-search-buffer) - ;; don't try to save the database in this case - (remove-hook 'kill-buffer-hook #'elfeed-db-save t) - (kill-buffer ))) - -(defun elfeed-search-format-date (date) - "Format a date for printing in `elfeed-search-mode'. -The customization `elfeed-search-date-format' sets the formatting." - (cl-destructuring-bind (format target alignment) elfeed-search-date-format - (let* ((string (format-time-string format (seconds-to-time date))) - (width (string-width string))) - (cond - ((> width target) - (if (eq alignment :left) - (substring string 0 target) - (substring string (- width target) width))) - ((< width target) - (let ((pad (make-string (- target width) ?\s))) - (if (eq alignment :left) - (concat string pad) - (concat pad string)))) - (string))))) - -(defface elfeed-search-date-face - '((((class color) (background light)) (:foreground "#aaa")) - (((class color) (background dark)) (:foreground "#77a"))) - "Face used in search mode for dates." - :group 'elfeed) - -(defface elfeed-search-title-face - '((((class color) (background light)) (:foreground "#000")) - (((class color) (background dark)) (:foreground "#fff"))) - "Face used in search mode for titles." - :group 'elfeed) - -(defface elfeed-search-unread-title-face - '((t :weight bold)) - "Face used in search mode for unread entry titles." - :group 'elfeed) - -(defface elfeed-search-feed-face - '((((class color) (background light)) (:foreground "#aa0")) - (((class color) (background dark)) (:foreground "#ff0"))) - "Face used in search mode for feed titles." - :group 'elfeed) - -(defface elfeed-search-tag-face - '((((class color) (background light)) (:foreground "#070")) - (((class color) (background dark)) (:foreground "#0f0"))) - "Face used in search mode for tags." - :group 'elfeed) - -(defface elfeed-search-last-update-face - '((t)) - "Face for showing the date and time the database was last updated." - :group 'elfeed) - -(defface elfeed-search-unread-count-face - '((((class color) (background light)) (:foreground "#000")) - (((class color) (background dark)) (:foreground "#fff"))) - "Face used in search mode for unread entry titles." - :group 'elfeed) - -(defface elfeed-search-filter-face - '((t :inherit mode-line-buffer-id)) - "Face for showing the current Elfeed search filter." - :group 'elfeed) - -(defcustom elfeed-search-title-max-width 70 - "Maximum column width for titles in the elfeed-search buffer." - :group 'elfeed - :type 'integer) - -(defcustom elfeed-search-title-min-width 16 - "Minimum column width for titles in the elfeed-search buffer." - :group 'elfeed - :type 'integer) - -(defcustom elfeed-search-trailing-width 30 - "Space reserved for displaying the feed and tag information." - :group 'elfeed - :type 'integer) - -(defcustom elfeed-search-face-alist - '((unread elfeed-search-unread-title-face)) - "Mapping of tags to faces in the Elfeed entry listing." - :group 'elfeed - :type '(alist :key-type symbol :value-type (repeat face))) - -(defun elfeed-search--faces (tags) - "Return all the faces that apply to an entry with TAGS." - (nconc (cl-loop for (tag . faces) in elfeed-search-face-alist - when (memq tag tags) - append faces) - (list 'elfeed-search-title-face))) - -(defun elfeed-search-print-entry--default (entry) - "Print ENTRY to the buffer." - (let* ((date (elfeed-search-format-date (elfeed-entry-date entry))) - (title (or (elfeed-meta entry :title) (elfeed-entry-title entry) "")) - (title-faces (elfeed-search--faces (elfeed-entry-tags entry))) - (feed (elfeed-entry-feed entry)) - (feed-title - (when feed - (or (elfeed-meta feed :title) (elfeed-feed-title feed)))) - (tags (mapcar #'symbol-name (elfeed-entry-tags entry))) - (tags-str (mapconcat - (lambda (s) (propertize s 'face 'elfeed-search-tag-face)) - tags ",")) - (title-width (- (window-width) 10 elfeed-search-trailing-width)) - (title-column (elfeed-format-column - title (elfeed-clamp - elfeed-search-title-min-width - title-width - elfeed-search-title-max-width) - :left))) - (insert (propertize date 'face 'elfeed-search-date-face) " ") - (insert (propertize title-column 'face title-faces 'kbd-help title) " ") - (when feed-title - (insert (propertize feed-title 'face 'elfeed-search-feed-face) " ")) - (when tags - (insert "(" tags-str ")")))) - -(defun elfeed-search-parse-filter (filter) - "Parse the elements of a search filter into a plist." - (let ((must-have ()) - (must-not-have ()) - (before nil) - (after nil) - (matches ()) - (not-matches ()) - (limit nil) - (feeds ())) - (cl-loop for element in (split-string filter) - for type = (aref element 0) - do (cl-case type - (?+ - (let ((symbol (intern (substring element 1)))) - (unless (eq '## symbol) - (push symbol must-have)))) - (?- - (let ((symbol (intern (substring element 1)))) - (unless (eq '## symbol) - (push symbol must-not-have)))) - (?@ (cl-multiple-value-bind (a b) - (split-string (substring element 1) "--") - (let ((duration-a (elfeed-time-duration a)) - (duration-b (and b (elfeed-time-duration b)))) - (when (and duration-b (> duration-b duration-a)) - (cl-rotatef duration-a duration-b)) - (when duration-b (setf before duration-b)) - (setf after duration-a)))) - (?! (let ((re (substring element 1))) - (when (elfeed-valid-regexp-p re) - (push re not-matches)))) - (?# (setf limit (string-to-number (substring element 1)))) - (?= (let ((re (substring element 1))) - (when (elfeed-valid-regexp-p re) - (push re feeds)))) - (otherwise (when (elfeed-valid-regexp-p element) - (push element matches))))) - `(,@(when before - (list :before before)) - ,@(when after - (list :after after)) - ,@(when must-have - (list :must-have must-have)) - ,@(when must-not-have - (list :must-not-have must-not-have)) - ,@(when matches - (list :matches matches)) - ,@(when not-matches - (list :not-matches not-matches)) - ,@(when limit - (list :limit limit)) - ,@(when feeds - (list :feeds feeds))))) - -(defun elfeed-search--recover-time (seconds) - "Pick a reasonable filter representation for SECONDS." - (let ((units '((60 1 "minute") - (60 1 "hour") - (24 1 "day") - (7 1 "week") - (30 7 "month") - (1461 120 "year"))) - (value (float seconds)) - (name "second")) - (cl-loop for (n d unit) in units - for next-value = (/ (* value d) n) - when (< next-value 1.0) - return t - do (setf name unit - value next-value)) - (let ((count (format "%.4g" value))) - (format "%s-%s%s-ago" count name (if (equal count "1") "" "s"))))) - -(defun elfeed-search--recover-units (after-seconds &optional before-seconds) - "Stringify the age or optionally the date range specified by -AFTER-SECONDS and BEFORE-SECONDS." - (apply 'concat "@" - (elfeed-search--recover-time after-seconds) - (when before-seconds - (list "--"(elfeed-search--recover-time before-seconds))))) - -(defun elfeed-search-unparse-filter (filter) - "Inverse of `elfeed-search-parse-filter', returning a string. - -The time (@n-units-ago) filter may not exactly match the -original, but will be equal in its effect." - (let ((output ())) - (let ((after (plist-get filter :after)) - (before (plist-get filter :before)) - (must-have (plist-get filter :must-have)) - (must-not-have (plist-get filter :must-not-have)) - (matches (plist-get filter :matches)) - (not-matches (plist-get filter :not-matches)) - (limit (plist-get filter :limit)) - (feeds (plist-get filter :feeds))) - (when after - (push (elfeed-search--recover-units after before) output)) - (dolist (tag must-have) - (push (format "+%S" tag) output)) - (dolist (tag must-not-have) - (push (format "-%S" tag) output)) - (dolist (re matches) - (push re output)) - (dolist (re not-matches) - (push (concat "!" re) output)) - (when limit - (push (format "#%d" limit) output)) - (dolist (feed feeds) - (push (format "=%s" feed) output)) - (mapconcat #'identity (nreverse output) " ")))) - -(defun elfeed-search-filter (filter entry feed &optional count) - "Return non-nil if ENTRY and FEED pass FILTER. - -COUNT is the total number of entries collected so far, for -filtering against a limit filter (ex. #10). - -See `elfeed-search-set-filter' for format/syntax documentation. -This function must *only* be called within the body of -`with-elfeed-db-visit' because it may perform a non-local exit." - (let ((after (plist-get filter :after)) - (must-have (plist-get filter :must-have)) - (must-not-have (plist-get filter :must-not-have)) - (matches (plist-get filter :matches)) - (not-matches (plist-get filter :not-matches)) - (limit (plist-get filter :limit)) - (feeds (plist-get filter :feeds))) - (let* ((tags (elfeed-entry-tags entry)) - (date (elfeed-entry-date entry)) - (age (- (float-time) date)) - (title (or (elfeed-meta entry :title) (elfeed-entry-title entry))) - (link (elfeed-entry-link entry)) - (feed-title - (or (elfeed-meta feed :title) (elfeed-feed-title feed) "")) - (feed-id (elfeed-feed-id feed))) - (when (or (and after (> age after)) - (and limit (<= limit 0)) - (and limit count (>= count limit))) - (elfeed-db-return)) - (and (cl-every (lambda (tag) (memq tag tags)) must-have) - (cl-notany (lambda (tag) (memq tag tags)) must-not-have) - (or (null matches) - (cl-every - (lambda (m) - (or (and title (string-match-p m title)) - (and link (string-match-p m link)))) - matches)) - (cl-notany (lambda (m) - (or (and title (string-match-p m title)) - (and link (string-match-p m link)))) - not-matches) - (or (null feeds) - (cl-some (lambda (f) - (or (string-match-p f feed-id) - (string-match-p f feed-title))) - feeds)))))) - -(defun elfeed-search-compile-filter (filter) - "Compile FILTER into a lambda function for `byte-compile'. - -Executing a filter in bytecode form is generally faster than -\"interpreting\" the filter with `elfeed-search-filter'." - (let ((after (plist-get filter :after)) - (before (plist-get filter :before)) - (must-have (plist-get filter :must-have)) - (must-not-have (plist-get filter :must-not-have)) - (matches (plist-get filter :matches)) - (not-matches (plist-get filter :not-matches)) - (limit (plist-get filter :limit)) - (feeds (plist-get filter :feeds))) - `(lambda (,(if (or after matches not-matches must-have must-not-have) - 'entry - '_entry) - ,(if feeds - 'feed - '_feed) - ,(if limit - 'count - '_count)) - (let* (,@(when after - '((date (elfeed-entry-date entry)) - (age (- (float-time) date)))) - ,@(when (or must-have must-not-have) - '((tags (elfeed-entry-tags entry)))) - ,@(when (or matches not-matches) - '((title (or (elfeed-meta entry :title) - (elfeed-entry-title entry))) - (link (elfeed-entry-link entry)))) - ,@(when feeds - '((feed-id (elfeed-feed-id feed)) - (feed-title (or (elfeed-meta feed :title) - (elfeed-feed-title feed) ""))))) - ,@(when after - `((when (> age ,after) - (elfeed-db-return)))) - ,@(when limit - `((when (>= count ,limit) - (elfeed-db-return)))) - (and ,@(cl-loop for forbid in must-not-have - collect `(not (memq ',forbid tags))) - ,@(cl-loop for forbid in must-have - collect `(memq ',forbid tags)) - ,@(cl-loop for regex in matches collect - `(or (string-match-p ,regex title) - (string-match-p ,regex link))) - ,@(cl-loop for regex in not-matches collect - `(not - (or (string-match-p ,regex title) - (string-match-p ,regex link)))) - ,@(when feeds - `((or ,@(cl-loop - for regex in feeds - collect `(string-match-p ,regex feed-id) - collect `(string-match-p ,regex feed-title))))) - ,@(when before - `((> age ,before)))))))) - -(defun elfeed-search--prompt (current) - "Prompt for a new filter, starting with CURRENT." - (read-from-minibuffer - "Filter: " - (if (or (string= "" current) - (string-match-p " $" current)) - current - (concat current " ")) - nil nil 'elfeed-search-filter-history)) - -(defun elfeed-search-clear-filter () - "Reset the search filter to the default value of `elfeed-search-filter'." - (interactive) - (setf elfeed-search-filter (default-value 'elfeed-search-filter)) - (elfeed-search-update--force)) - -(defun elfeed-search-set-filter (new-filter) - "Set a new search filter for the elfeed-search buffer. - -When NEW-FILTER is nil, reset the filter to the default value. - -When given a prefix argument, the current filter is not displayed -in the minibuffer when prompting for a new filter. - -Any component beginning with a + or - is treated as a tag. If + -the tag must be present on the entry. If - the tag must *not* be -present on the entry. Ex. \"+unread\" or \"+unread -comic\". - -Any component beginning with an @ is an age limit or an age -range. If a limit, no posts older than this are allowed. If a -range, posts dates have to be inbetween the specified date -range. Examples: -- \"@3-days-ago\" -- \"@1-year-old\" -- \"@2019-06-24\" -- \"@2019-06-24--2019-06-24\" -- \"@5-days-ago--1-day-ago\" - -Any component beginning with a # is an entry count maximum. The -number following # determines the maxiumum number of entries -to be shown (descending by date). Ex. \"#20\" or \"#100\". - -Any component beginning with a = is a regular expression matching -the entry's feed (title or URL). Only entries belonging to a feed -that match at least one of the = expressions will be shown. - -Every other space-seperated element is treated like a regular -expression, matching against entry link, title, and feed title." - (interactive - (let ((elfeed-search-filter-active :non-interactive)) - (list (elfeed-search--prompt - (if current-prefix-arg "" elfeed-search-filter))))) - (with-current-buffer (elfeed-search-buffer) - (setf elfeed-search-filter - (or new-filter (default-value 'elfeed-search-filter))) - (elfeed-search-update :force))) - -(defun elfeed-search--update-list () - "Update `elfeed-search-filter' list." - (let* ((filter (elfeed-search-parse-filter elfeed-search-filter)) - (head (list nil)) - (tail head) - (count 0)) - (if elfeed-search-compile-filter - ;; Force lexical bindings regardless of the current - ;; buffer-local value. Lexical scope uses the faster - ;; stack-ref opcode instead of the traditional varref opcode. - (let ((lexical-binding t) - (func (byte-compile (elfeed-search-compile-filter filter)))) - (with-elfeed-db-visit (entry feed) - (when (funcall func entry feed count) - (setf (cdr tail) (list entry) - tail (cdr tail) - count (1+ count))))) - (with-elfeed-db-visit (entry feed) - (when (elfeed-search-filter filter entry feed count) - (setf (cdr tail) (list entry) - tail (cdr tail) - count (1+ count))))) - ;; Determine the final list order - (let ((entries (cdr head))) - (when elfeed-search-sort-function - (setf entries (sort entries elfeed-search-sort-function))) - (when (eq elfeed-sort-order 'ascending) - (setf entries (nreverse entries))) - (setf elfeed-search-entries - entries)))) - -(defmacro elfeed-save-excursion (&rest body) - "Like `save-excursion', but by entry/line/column instead of point." - (declare (indent defun)) - `(let ((entry (elfeed-search-selected :single)) - (line (line-number-at-pos)) - (column (current-column))) - (unwind-protect - (progn ,@body) - (let ((entry-position (cl-position entry elfeed-search-entries))) - (elfeed-goto-line (if entry-position - (+ elfeed-search--offset entry-position) - line)) - (move-to-column column))))) - -(defun elfeed-search-update (&optional force) - "Update the elfeed-search buffer listing to match the database. -When FORCE is non-nil, redraw even when the database hasn't changed." - (interactive) - (with-current-buffer (elfeed-search-buffer) - (when (or force (and (not elfeed-search-filter-active) - (< elfeed-search-last-update (elfeed-db-last-update)))) - (elfeed-save-excursion - (let ((inhibit-read-only t) - (standard-output (current-buffer))) - (erase-buffer) - (elfeed-search--update-list) - (dolist (entry elfeed-search-entries) - (funcall elfeed-search-print-entry-function entry) - (insert "\n")) - (insert "End of entries.\n") - (setf elfeed-search-last-update (float-time)))) - (run-hooks 'elfeed-search-update-hook)))) - -(defun elfeed-search-fetch (prefix) - "Update all feeds via `elfeed-update', or only visible feeds with PREFIX. -Given a prefix, this function becomes `elfeed-search-fetch-visible'." - (interactive "P") - (if prefix - (elfeed-search-fetch-visible) - (elfeed-update))) - -(defun elfeed-search-fetch-visible () - "Update any feed with an entry currently displayed in the search buffer." - (interactive) - (cl-loop with seen = (make-hash-table :test 'equal) - for entry in elfeed-search-entries - for feed = (elfeed-entry-feed entry) - for url = (elfeed-feed-url feed) - when (not (gethash url seen)) - do (elfeed-update-feed (setf (gethash url seen) url)))) - -(defun elfeed-search-update-line (&optional n) - "Redraw the current line." - (let ((inhibit-read-only t)) - (save-excursion - (when n (elfeed-goto-line n)) - (let ((entry (elfeed-search-selected :ignore-region))) - (when entry - (elfeed-kill-line) - (funcall elfeed-search-print-entry-function entry)))))) - -(defun elfeed-search-update-entry (entry) - "Redraw a specific entry." - (let ((n (cl-position entry elfeed-search-entries))) - (when n (elfeed-search-update-line (+ elfeed-search--offset n))))) - -(defun elfeed-search-selected (&optional ignore-region-p) - "Return a list of the currently selected feeds. - -If IGNORE-REGION-P is non-nil, only return the entry under point." - (let ((use-region (and (not ignore-region-p) (use-region-p)))) - (let ((start (if use-region (region-beginning) (point))) - (end (if use-region (region-end) (point)))) - (cl-loop for line from (line-number-at-pos start) - to (line-number-at-pos end) - for offset = (- line elfeed-search--offset) - when (and (>= offset 0) (nth offset elfeed-search-entries)) - collect it into selected - finally (return (if ignore-region-p - (car selected) - selected)))))) - -(defun elfeed-search-browse-url (&optional use-generic-p) - "Visit the current entry in your browser using `browse-url'. -If there is a prefix argument, visit the current entry in the -browser defined by `browse-url-generic-program'." - (interactive "P") - (let ((entries (elfeed-search-selected))) - (cl-loop for entry in entries - do (elfeed-untag entry 'unread) - when (elfeed-entry-link entry) - do (if use-generic-p - (browse-url-generic it) - (browse-url it))) - (mapc #'elfeed-search-update-entry entries) - (unless (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 diff --git a/elpa/elfeed-20190903.1137/elfeed-show.el b/elpa/elfeed-20190903.1137/elfeed-show.el deleted file mode 100644 index d3893f85..00000000 --- a/elpa/elfeed-20190903.1137/elfeed-show.el +++ /dev/null @@ -1,458 +0,0 @@ -;;; elfeed-show.el --- display feed entries -*- lexical-binding: t; -*- - -;; This is free and unencumbered software released into the public domain. - -;;; Code: - -(require 'cl-lib) -(require 'shr) -(require 'url-parse) -(require 'browse-url) -(require 'message) ; faces - -(require 'elfeed) -(require 'elfeed-db) -(require 'elfeed-lib) -(require 'elfeed-search) - -(defcustom elfeed-show-truncate-long-urls t - "When non-nil, use an ellipsis to shorten very long displayed URLs." - :group 'elfeed - :type 'boolean) - -(defcustom elfeed-show-entry-author t - "When non-nil, show the entry's author (if it's in the entry's metadata)." - :group 'elfeed - :type 'boolean) - -(defvar elfeed-show-entry nil - "The entry being displayed in this buffer.") - -(defvar elfeed-show-entry-switch #'switch-to-buffer - "Function to call to display and switch to the feed entry buffer. -Defaults to `switch-to-buffer'.") - -(defvar elfeed-show-entry-delete #'elfeed-kill-buffer - "Function called when quitting from the elfeed-entry -buffer. Does not take any arguments. - -Defaults to `elfeed-kill-buffer'.") - -(defvar elfeed-show-refresh-function #'elfeed-show-refresh--mail-style - "Function called to refresh the `*elfeed-entry*' buffer.") - -(defvar elfeed-show-mode-map - (let ((map (make-sparse-keymap))) - (prog1 map - (suppress-keymap map) - (define-key map "h" #'describe-mode) - (define-key map "d" #'elfeed-show-save-enclosure) - (define-key map "q" #'elfeed-kill-buffer) - (define-key map "g" #'elfeed-show-refresh) - (define-key map "n" #'elfeed-show-next) - (define-key map "p" #'elfeed-show-prev) - (define-key map "s" #'elfeed-show-new-live-search) - (define-key map "b" #'elfeed-show-visit) - (define-key map "y" #'elfeed-show-yank) - (define-key map "u" #'elfeed-show-tag--unread) - (define-key map "+" #'elfeed-show-tag) - (define-key map "-" #'elfeed-show-untag) - (define-key map "<" #'beginning-of-buffer) - (define-key map ">" #'end-of-buffer) - (define-key map (kbd "SPC") #'scroll-up-command) - (define-key map (kbd "DEL") #'scroll-down-command) - (define-key map (kbd "TAB") #'elfeed-show-next-link) - (define-key map "\e\t" #'shr-previous-link) - (define-key map [backtab] #'shr-previous-link) - (define-key map [mouse-2] #'shr-browse-url) - (define-key map "A" #'elfeed-show-add-enclosure-to-playlist) - (define-key map "P" #'elfeed-show-play-enclosure))) - "Keymap for `elfeed-show-mode'.") - -(defun elfeed-show-mode () - "Mode for displaying Elfeed feed entries. -\\{elfeed-show-mode-map}" - (interactive) - (kill-all-local-variables) - (use-local-map elfeed-show-mode-map) - (setq major-mode 'elfeed-show-mode - mode-name "elfeed-show" - buffer-read-only t) - (buffer-disable-undo) - (make-local-variable 'elfeed-show-entry) - (run-mode-hooks 'elfeed-show-mode-hook)) - -(defalias 'elfeed-show-tag--unread - (elfeed-expose #'elfeed-show-tag 'unread) - "Mark the current entry unread.") - -(defun elfeed-insert-html (html &optional base-url) - "Converted HTML markup to a propertized string." - (shr-insert-document - (if (elfeed-libxml-supported-p) - (with-temp-buffer - ;; insert to work around libxml-parse-html-region bug - (when base-url - (insert (format "" base-url))) - (insert html) - (libxml-parse-html-region (point-min) (point-max) base-url)) - '(i () "Elfeed: libxml2 functionality is unavailable")))) - -(cl-defun elfeed-insert-link (url &optional (content url)) - "Insert a clickable hyperlink to URL titled CONTENT." - (when (and elfeed-show-truncate-long-urls - (integerp shr-width) - (> (length content) (- shr-width 8))) - (let ((len (- (/ shr-width 2) 10))) - (setq content (format "%s[...]%s" - (substring content 0 len) - (substring content (- len)))))) - (elfeed-insert-html (format "%s" url content))) - -(defun elfeed-compute-base (url) - "Return the base URL for URL, useful for relative paths." - (let ((obj (url-generic-parse-url url))) - (setf (url-filename obj) nil) - (setf (url-target obj) nil) - (url-recreate-url obj))) - -(defun elfeed--show-format-author (author) - "Format author plist for the header." - (let ((name (plist-get author :name)) - (uri (plist-get author :uri)) - (email (plist-get author :email))) - (cond ((and name uri email) - (format "%s <%s> (%s)" name email uri)) - ((and name email) - (format "%s <%s>" name email)) - ((and name uri) - (format "%s (%s)" name uri)) - (name name) - (email email) - (uri uri) - ("[unknown]")))) - -(defun elfeed-show-refresh--mail-style () - "Update the buffer to match the selected entry, using a mail-style." - (interactive) - (let* ((inhibit-read-only t) - (title (elfeed-entry-title elfeed-show-entry)) - (date (seconds-to-time (elfeed-entry-date elfeed-show-entry))) - (authors (elfeed-meta elfeed-show-entry :authors)) - (link (elfeed-entry-link elfeed-show-entry)) - (tags (elfeed-entry-tags elfeed-show-entry)) - (tagsstr (mapconcat #'symbol-name tags ", ")) - (nicedate (format-time-string "%a, %e %b %Y %T %Z" date)) - (content (elfeed-deref (elfeed-entry-content elfeed-show-entry))) - (type (elfeed-entry-content-type elfeed-show-entry)) - (feed (elfeed-entry-feed elfeed-show-entry)) - (feed-title (elfeed-feed-title feed)) - (base (and feed (elfeed-compute-base (elfeed-feed-url feed))))) - (erase-buffer) - (insert (format (propertize "Title: %s\n" 'face 'message-header-name) - (propertize title 'face 'message-header-subject))) - (when elfeed-show-entry-author - (dolist (author authors) - (let ((formatted (elfeed--show-format-author author))) - (insert - (format (propertize "Author: %s\n" 'face 'message-header-name) - (propertize formatted 'face 'message-header-to)))))) - (insert (format (propertize "Date: %s\n" 'face 'message-header-name) - (propertize nicedate 'face 'message-header-other))) - (insert (format (propertize "Feed: %s\n" 'face 'message-header-name) - (propertize feed-title 'face 'message-header-other))) - (when tags - (insert (format (propertize "Tags: %s\n" 'face 'message-header-name) - (propertize tagsstr 'face 'message-header-other)))) - (insert (propertize "Link: " 'face 'message-header-name)) - (elfeed-insert-link link link) - (insert "\n") - (cl-loop for enclosure in (elfeed-entry-enclosures elfeed-show-entry) - do (insert (propertize "Enclosure: " 'face 'message-header-name)) - do (elfeed-insert-link (car enclosure)) - do (insert "\n")) - (insert "\n") - (if content - (if (eq type 'html) - (elfeed-insert-html content base) - (insert content)) - (insert (propertize "(empty)\n" 'face 'italic))) - (goto-char (point-min)))) - -(defun elfeed-show-refresh () - "Update the buffer to match the selected entry." - (interactive) - (call-interactively elfeed-show-refresh-function)) - -(defcustom elfeed-show-unique-buffers nil - "When non-nil, every entry buffer gets a unique name. -This allows for displaying multiple show buffers at the same -time." - :group 'elfeed - :type 'boolean) - -(defun elfeed-show--buffer-name (entry) - "Return the appropriate buffer name for ENTRY. -The result depends on the value of `elfeed-show-unique-buffers'." - (if elfeed-show-unique-buffers - (format "*elfeed-entry-<%s %s>*" - (elfeed-entry-title entry) - (format-time-string "%F" (elfeed-entry-date entry))) - "*elfeed-entry*")) - -(defun elfeed-show-entry (entry) - "Display ENTRY in the current buffer." - (let ((buff (get-buffer-create (elfeed-show--buffer-name entry)))) - (with-current-buffer buff - (elfeed-show-mode) - (setq elfeed-show-entry entry) - (elfeed-show-refresh)) - (funcall elfeed-show-entry-switch buff))) - -(defun elfeed-show-next () - "Show the next item in the elfeed-search buffer." - (interactive) - (funcall elfeed-show-entry-delete) - (with-current-buffer (elfeed-search-buffer) - (call-interactively #'elfeed-search-show-entry))) - -(defun elfeed-show-prev () - "Show the previous item in the elfeed-search buffer." - (interactive) - (funcall elfeed-show-entry-delete) - (with-current-buffer (elfeed-search-buffer) - (forward-line -2) - (call-interactively #'elfeed-search-show-entry))) - -(defun elfeed-show-new-live-search () - "Kill the current buffer, search again in *elfeed-search*." - (interactive) - (elfeed-kill-buffer) - (elfeed) - (elfeed-search-live-filter)) - -(defun elfeed-show-visit (&optional use-generic-p) - "Visit the current entry in your browser using `browse-url'. -If there is a prefix argument, visit the current entry in the -browser defined by `browse-url-generic-program'." - (interactive "P") - (let ((link (elfeed-entry-link elfeed-show-entry))) - (when link - (message "Sent to browser: %s" link) - (if use-generic-p - (browse-url-generic link) - (browse-url link))))) - -(defun elfeed-show-yank () - "Copy the current entry link URL to the clipboard." - (interactive) - (let ((link (elfeed-entry-link elfeed-show-entry))) - (when link - (kill-new link) - (if (fboundp 'gui-set-selection) - (gui-set-selection 'PRIMARY link) - (with-no-warnings - (x-set-selection 'PRIMARY link))) - (message "Yanked: %s" link)))) - -(defun elfeed-show-tag (&rest tags) - "Add TAGS to the displayed entry." - (interactive (list (intern (read-from-minibuffer "Tag: ")))) - (let ((entry elfeed-show-entry)) - (apply #'elfeed-tag entry tags) - (with-current-buffer (elfeed-search-buffer) - (elfeed-search-update-entry entry)) - (elfeed-show-refresh))) - -(defun elfeed-show-untag (&rest tags) - "Remove TAGS from the displayed entry." - (interactive (let* ((tags (elfeed-entry-tags elfeed-show-entry)) - (names (mapcar #'symbol-name tags)) - (select (completing-read "Untag: " names nil :match))) - (list (intern select)))) - (let ((entry elfeed-show-entry)) - (apply #'elfeed-untag entry tags) - (with-current-buffer (elfeed-search-buffer) - (elfeed-search-update-entry entry)) - (elfeed-show-refresh))) - -;; Enclosures: - -(defcustom elfeed-enclosure-default-dir (expand-file-name "~") - "Default directory for saving enclosures. -This can be either a string (a file system path), or a function -that takes a filename and the mime-type as arguments, and returns -the enclosure dir." - :type 'directory - :group 'elfeed - :safe 'stringp) - -(defcustom elfeed-save-multiple-enclosures-without-asking nil - "If non-nil, saving multiple enclosures asks once for a -directory and saves all attachments in the chosen directory." - :type 'boolean - :group 'elfeed) - -(defvar elfeed-show-enclosure-filename-function - #'elfeed-show-enclosure-filename-remote - "Function called to generate the filename for an enclosure.") - -(defun elfeed--download-enclosure (url path) - "Download asynchronously the enclosure from URL to PATH." - (if (require 'async nil :noerror) - (with-no-warnings - (async-start - (lambda () - (url-copy-file url path t)) - (lambda (_) - (message (format "%s downloaded" url))))) - (url-copy-file url path t))) - -(defun elfeed--get-enclosure-num (prompt entry &optional multi) - "Ask the user with PROMPT for an enclosure number for ENTRY. -The number is [1..n] for enclosures \[0..(n-1)] in the entry. If -MULTI is nil, return the number for the enclosure; -otherwise (MULTI is non-nil), accept ranges of enclosure numbers, -as per `elfeed-split-ranges-to-numbers', and return the -corresponding string." - (let* ((count (length (elfeed-entry-enclosures entry))) - def) - (when (zerop count) - (error "No enclosures to this entry")) - (if (not multi) - (if (= count 1) - (read-number (format "%s: " prompt) 1) - (read-number (format "%s (1-%d): " prompt count))) - (progn - (setq def (if (= count 1) "1" (format "1-%d" count))) - (read-string (format "%s (default %s): " prompt def) - nil nil def))))) - -(defun elfeed--request-enclosure-path (fname path) - "Ask the user where to save FNAME (default is PATH/FNAME)." - (let ((fpath (expand-file-name - (read-file-name "Save as: " path nil nil fname) path))) - (if (file-directory-p fpath) - (expand-file-name fname fpath) - fpath))) - -(defun elfeed--request-enclosures-dir (path) - "Ask the user where to save multiple enclosures (default is PATH)." - (let ((fpath (expand-file-name - (read-directory-name - (format "Save in directory: ") path nil nil nil) path))) - (if (file-directory-p fpath) - fpath))) - -(defun elfeed-show-enclosure-filename-remote (_entry url-enclosure) - "Returns the remote filename as local filename for an enclosure." - (file-name-nondirectory - (url-unhex-string - (car (url-path-and-query (url-generic-parse-url - url-enclosure)))))) - -(defun elfeed-show-save-enclosure-single (&optional entry enclosure-index) - "Save enclosure number ENCLOSURE-INDEX from ENTRY. -If ENTRY is nil use the elfeed-show-entry variable. -If ENCLOSURE-INDEX is nil ask for the enclosure number." - (interactive) - (let* ((path elfeed-enclosure-default-dir) - (entry (or entry elfeed-show-entry)) - (enclosure-index (or enclosure-index - (elfeed--get-enclosure-num - "Enclosure to save" entry))) - (url-enclosure (car (elt (elfeed-entry-enclosures entry) - (- enclosure-index 1)))) - (fname - (funcall elfeed-show-enclosure-filename-function - entry url-enclosure)) - (retry t) - (fpath)) - (while retry - (setf fpath (elfeed--request-enclosure-path fname path) - retry (and (file-exists-p fpath) - (not (y-or-n-p (format "Overwrite '%s'?" fpath)))))) - (elfeed--download-enclosure url-enclosure fpath))) - -(defun elfeed-show-save-enclosure-multi (&optional entry) - "Offer to save multiple entry enclosures from the current entry. -Default is to save all enclosures, [1..n], where n is the number of -enclosures. You can type multiple values separated by space, e.g. - 1 3-6 8 -will save enclosures 1,3,4,5,6 and 8. - -Furthermore, there is a shortcut \"a\" which so means all -enclosures, but as this is the default, you may not need it." - (interactive) - (let* ((entry (or entry elfeed-show-entry)) - (attachstr (elfeed--get-enclosure-num - "Enclosure number range (or 'a' for 'all')" entry t)) - (count (length (elfeed-entry-enclosures entry))) - (attachnums (elfeed-split-ranges-to-numbers attachstr count)) - (path elfeed-enclosure-default-dir) - (fpath)) - (if elfeed-save-multiple-enclosures-without-asking - (let ((attachdir (elfeed--request-enclosures-dir path))) - (dolist (enclosure-index attachnums) - (let* ((url-enclosure - (aref (elfeed-entry-enclosures entry) enclosure-index)) - (fname - (funcall elfeed-show-enclosure-filename-function - entry url-enclosure)) - (retry t)) - (while retry - (setf fpath (expand-file-name (concat attachdir fname) path) - retry - (and (file-exists-p fpath) - (not (y-or-n-p (format "Overwrite '%s'?" fpath)))))) - (elfeed--download-enclosure url-enclosure fpath)))) - (dolist (enclosure-index attachnums) - (elfeed-show-save-enclosure-single entry enclosure-index))))) - -(defun elfeed-show-save-enclosure (&optional multi) - "Offer to save enclosure(s). -If MULTI (prefix-argument) is nil, save a single one, otherwise, -offer to save a range of enclosures." - (interactive "P") - (if multi - (elfeed-show-save-enclosure-multi) - (elfeed-show-save-enclosure-single))) - -(defun elfeed--enclosure-maybe-prompt-index (entry) - "Prompt for an enclosure if there are multiple in ENTRY." - (if (= 1 (length (elfeed-entry-enclosures entry))) - 1 - (elfeed--get-enclosure-num "Enclosure to play" entry))) - -(defun elfeed-show-play-enclosure (enclosure-index) - "Play enclosure number ENCLOSURE-INDEX from current entry using EMMS. -Prompts for ENCLOSURE-INDEX when called interactively." - (interactive (list (elfeed--enclosure-maybe-prompt-index elfeed-show-entry))) - (elfeed-show-add-enclosure-to-playlist enclosure-index) - (with-no-warnings - (with-current-emms-playlist - (save-excursion - (emms-playlist-last) - (emms-playlist-mode-play-current-track))))) - -(defun elfeed-show-add-enclosure-to-playlist (enclosure-index) - "Add enclosure number ENCLOSURE-INDEX to current EMMS playlist. -Prompts for ENCLOSURE-INDEX when called interactively." - - (interactive (list (elfeed--enclosure-maybe-prompt-index elfeed-show-entry))) - (require 'emms) ;; optional - (with-no-warnings ;; due to lazy (require ) - (emms-add-url (car (elt (elfeed-entry-enclosures elfeed-show-entry) - (- enclosure-index 1)))))) - -(defun elfeed-show-next-link () - "Skip to the next link, exclusive of the Link header." - (interactive) - (let ((properties (text-properties-at (line-beginning-position)))) - (when (memq 'message-header-name properties) - (forward-paragraph)) - (shr-next-link))) - -(provide 'elfeed-show) - -;;; elfeed-show.el ends here diff --git a/elpa/elfeed-20190903.1137/elfeed.el b/elpa/elfeed-20190903.1137/elfeed.el deleted file mode 100644 index 836b9f09..00000000 --- a/elpa/elfeed-20190903.1137/elfeed.el +++ /dev/null @@ -1,673 +0,0 @@ -;;; elfeed.el --- an Emacs Atom/RSS feed reader -*- lexical-binding: t; -*- - -;; This is free and unencumbered software released into the public domain. - -;; Author: Christopher Wellons -;; URL: https://github.com/skeeto/elfeed - -;;; Commentary: - -;; Elfeed is a web feed client for Emacs, inspired by notmuch. See -;; the README for full documentation. - -;; Notice: Before stamping a new release the following places need to -;; be updated: -;; * NEWS.md -;; * elfeed.el (`elfeed-version') -;; * elfeed-pkg.el -;; * web/elfeed-web-pkg.el -;; * Makefile (VERSION) - -;;; Code: - -(require 'cl-lib) -(require 'xml) -(require 'xml-query) -(require 'url-parse) -(require 'url-queue) - -(require 'elfeed-db) -(require 'elfeed-lib) -(require 'elfeed-log) -(require 'elfeed-curl) - -;; Interface to elfeed-search (lazy required) -(declare-function elfeed-search-buffer 'elfeed-search ()) -(declare-function elfeed-search-mode 'elfeed-search ()) - -(defgroup elfeed () - "An Emacs web feed reader." - :group 'comm) - -(defconst elfeed-version "3.2.0") - -(defcustom elfeed-feeds () - "List of all feeds that Elfeed should follow. -You must add your feeds to this list. - -In its simplest form this will be a list of strings of feed URLs. -Items in this list can also be list whose car is the feed URL -and cdr is a list of symbols to be applied to all discovered -entries as tags (\"autotags\"). For example, - - (setq elfeed-feeds '(\"http://foo/\" - \"http://bar/\" - (\"http://baz/\" comic))) - -All entries from the \"baz\" feed will be tagged as \"comic\" -when they are first discovered." - :group 'elfeed - :type '(repeat (choice string - (cons string (repeat symbol))))) - -(defcustom elfeed-feed-functions - '(elfeed-get-link-at-point - elfeed-get-url-at-point - elfeed-clipboard-get) - "List of functions to use to get possible feeds for `elfeed-add-feed'. -Each function should accept no arguments, and return a string or nil." - :group 'elfeed - :type 'hook - :options '(elfeed-get-link-at-point - elfeed-get-url-at-point - elfeed-clipboard-get)) - -(defcustom elfeed-use-curl - (not (null (executable-find elfeed-curl-program-name))) - "If non-nil, fetch feeds using curl instead of `url-retrieve'." - :group 'elfeed - :type 'boolean) - -(defcustom elfeed-user-agent (format "Emacs Elfeed %s" elfeed-version) - "User agent string to use for Elfeed (requires `elfeed-use-curl')." - :group 'elfeed - :type 'string) - -(defcustom elfeed-initial-tags '(unread) - "Initial tags for new entries." - :group 'elfeed - :type '(repeat symbol)) - -;; Fetching: - -(defvar elfeed-http-error-hooks () - "Hooks to run when an http connection error occurs. -It is called with 2 arguments. The first argument is the url of -the failing feed. The second argument is the http status code.") - -(defvar elfeed-parse-error-hooks () - "Hooks to run when an error occurs during the parsing of a feed. -It is called with 2 arguments. The first argument is the url of -the failing feed. The second argument is the error message .") - -(defvar elfeed-update-hooks () - "Hooks to run any time a feed update has completed a request. -It is called with 1 argument: the URL of the feed that was just -updated. The hook is called even when no new entries were -found.") - -(defvar elfeed-update-init-hooks () - "Hooks called when one or more feed updates have begun. -Receivers may want to, say, update a display to indicate that -updates are pending.") - -(defvar elfeed-tag-hooks () - "Hooks called when one or more entries add tags. -It is called with 2 arguments. The first argument is the entry -list. The second argument is the tag list.") - -(defvar elfeed-untag-hooks () - "Hooks called when one or more entries remove tags. -It is called with 2 arguments. The first argument is the entry -list. The second argument is the tag list.") - -(defvar elfeed--inhibit-update-init-hooks nil - "When non-nil, don't run `elfeed-update-init-hooks'.") - -(defun elfeed-queue-count-active () - "Return the number of items in process." - (if elfeed-use-curl - elfeed-curl-queue-active - (cl-count-if #'url-queue-buffer url-queue))) - -(defun elfeed-queue-count-total () - "Return the number of items in process." - (if elfeed-use-curl - (+ (length elfeed-curl-queue) elfeed-curl-queue-active) - (length url-queue))) - -(defun elfeed-set-max-connections (n) - "Limit the maximum number of concurrent connections to N." - (if elfeed-use-curl - (setf elfeed-curl-max-connections n) - (setf url-queue-parallel-processes n))) - -(defun elfeed-get-max-connections () - "Get the maximum number of concurrent connections." - (if elfeed-use-curl - elfeed-curl-max-connections - url-queue-parallel-processes)) - -(defun elfeed-set-timeout (seconds) - "Limit the time for fetching a feed to SECONDS." - (if elfeed-use-curl - (setf elfeed-curl-timeout seconds) - (setf url-queue-timeout seconds))) - -(defun elfeed-get-timeout () - "Get the time limit for fetching feeds in SECONDS." - (if elfeed-use-curl - elfeed-curl-timeout - url-queue-timeout)) - -(defun elfeed-is-status-error (status use-curl) - "Check if HTTP request returned status means a error." - (or (and use-curl (null status)) ; nil = error - (and (not use-curl) (eq (car status) :error)))) - -(defmacro elfeed-with-fetch (url &rest body) - "Asynchronously run BODY in a buffer with the contents from URL. -This macro is anaphoric, with STATUS referring to the status from -`url-retrieve'/cURL and USE-CURL being the original invoked-value -of `elfeed-use-curl'." - (declare (indent defun)) - `(let* ((use-curl elfeed-use-curl) ; capture current value in closure - (cb (lambda (status) ,@body))) - (if elfeed-use-curl - (let* ((feed (elfeed-db-get-feed url)) - (last-modified (elfeed-meta feed :last-modified)) - (etag (elfeed-meta feed :etag)) - (headers `(("User-Agent" . ,elfeed-user-agent)))) - (when etag - (push `("If-None-Match" . ,etag) headers)) - (when last-modified - (push `("If-Modified-Since" . ,last-modified) headers)) - (elfeed-curl-enqueue ,url cb :headers headers)) - (url-queue-retrieve ,url cb () t t)))) - -(defun elfeed-unjam () - "Manually clear the connection pool when connections fail to timeout. -This is a workaround for issues in `url-queue-retrieve'." - (interactive) - (if elfeed-use-curl - (setf elfeed-curl-queue nil - elfeed-curl-queue-active 0) - (let ((fails (mapcar #'url-queue-url url-queue))) - (when fails - (elfeed-log 'warn "Elfeed aborted feeds: %s" - (mapconcat #'identity fails " "))) - (setf url-queue nil))) - (run-hooks 'elfeed-update-init-hooks)) - -;; Parsing: - -(defun elfeed-feed-type (content) - "Return the feed type (:atom, :rss, :rss1.0) or nil for unknown." - (let ((top (xml-query-strip-ns (caar content)))) - (cadr (assoc top '((feed :atom) - (rss :rss) - (RDF :rss1.0)))))) - -(defun elfeed-generate-id (&optional content) - "Generate an ID based on CONTENT or from the current time." - (concat "urn:sha1:" (sha1 (format "%s" (or content (float-time)))))) - -(defun elfeed--atom-content (entry) - "Get content string from ENTRY." - (let ((content-type (xml-query* (content :type) entry))) - (if (equal content-type "xhtml") - (with-temp-buffer - (let ((xhtml (cddr (xml-query* (content) entry)))) - (dolist (element xhtml) - (if (stringp element) - (insert element) - (elfeed-xml-unparse element)))) - (buffer-string)) - (let ((all-content - (or (xml-query-all* (content *) entry) - (xml-query-all* (summary *) entry)))) - (when all-content - (apply #'concat all-content)))))) - -(defvar elfeed-new-entry-parse-hook '() - "Hook to be called after parsing a new entry. - -Take three arguments: the feed TYPE, the XML structure for the -entry, and the Elfeed ENTRY object. Return value is ignored, and -is called for side-effects on the ENTRY object.") - -(defsubst elfeed--fixup-protocol (protocol url) - "Prepend PROTOCOL to URL if it is protocol-relative. -If PROTOCOL is nil, returns URL." - (if (and protocol url (string-match-p "^//[^/]" url)) - (concat protocol ":" url) - url)) - -(defsubst elfeed--atom-authors-to-plist (authors) - "Parse list of author XML tags into list of plists." - (let ((result ())) - (dolist (author authors) - (let ((plist ()) - (name (xml-query* (name *) author)) - (uri (xml-query* (uri *) author)) - (email (xml-query* (email *) author))) - (when email - (setf plist (list :email (elfeed-cleanup email)))) - (when uri - (setf plist (nconc (list :uri (elfeed-cleanup uri)) plist))) - (when name - (setf plist (nconc (list :name (elfeed-cleanup name)) plist))) - (push plist result))) - (nreverse result))) - -(defsubst elfeed--creators-to-plist (creators) - "Convert Dublin Core list of creators into an authors plist." - (cl-loop for creator in creators - collect (list :name creator))) - -(defun elfeed-entries-from-atom (url xml) - "Turn parsed Atom content into a list of elfeed-entry structs." - (let* ((feed-id url) - (protocol (url-type (url-generic-parse-url url))) - (namespace (elfeed-url-to-namespace url)) - (feed (elfeed-db-get-feed feed-id)) - (title (elfeed-cleanup (xml-query* (feed title *) xml))) - (authors (xml-query-all* (feed author) xml)) - (xml-base (or (xml-query* (feed :base) xml) url)) - (autotags (elfeed-feed-autotags url))) - (setf (elfeed-feed-url feed) url - (elfeed-feed-title feed) title - (elfeed-feed-author feed) (elfeed--atom-authors-to-plist authors)) - (cl-loop for entry in (xml-query-all* (feed entry) xml) collect - (let* ((title (or (xml-query* (title *) entry) "")) - (xml-base (elfeed-update-location - xml-base (xml-query* (:base) (list entry)))) - (anylink (xml-query* (link :href) entry)) - (altlink (xml-query* (link [rel "alternate"] :href) entry)) - (link (elfeed--fixup-protocol - protocol - (elfeed-update-location xml-base - (or altlink anylink)))) - (date (or (xml-query* (published *) entry) - (xml-query* (updated *) entry) - (xml-query* (date *) entry) - (xml-query* (modified *) entry) ; Atom 0.3 - (xml-query* (issued *) entry))) ; Atom 0.3 - (authors (nconc (elfeed--atom-authors-to-plist - (xml-query-all* (author) entry)) - ;; Dublin Core - (elfeed--creators-to-plist - (xml-query-all* (creator *) entry)))) - (categories (xml-query-all* (category :term) entry)) - (content (elfeed--atom-content entry)) - (id (or (xml-query* (id *) entry) link - (elfeed-generate-id content))) - (type (or (xml-query* (content :type) entry) - (xml-query* (summary :type) entry) - "")) - (tags (elfeed-normalize-tags autotags elfeed-initial-tags)) - (content-type (if (string-match-p "html" type) 'html nil)) - (etags (xml-query-all* (link [rel "enclosure"]) entry)) - (enclosures - (cl-loop for enclosure in etags - for wrap = (list enclosure) - for href = (xml-query* (:href) wrap) - for type = (xml-query* (:type) wrap) - for length = (xml-query* (:length) wrap) - collect (list href type length))) - (db-entry (elfeed-entry--create - :title (elfeed-cleanup title) - :feed-id feed-id - :id (cons namespace (elfeed-cleanup id)) - :link (elfeed-cleanup link) - :tags tags - :date (or (elfeed-float-time date) (float-time)) - :content content - :enclosures enclosures - :content-type content-type - :meta `(,@(when authors - (list :authors authors)) - ,@(when categories - (list :categories categories)))))) - (dolist (hook elfeed-new-entry-parse-hook) - (funcall hook :atom entry db-entry)) - db-entry)))) - -(defsubst elfeed--rss-author-to-plist (author) - "Parse an RSS author element into an authors plist." - (when author - (let ((clean (elfeed-cleanup author))) - (if (string-match "^\\(.*\\) (\\([^)]+\\))$" clean) - (list (list :name (match-string 2 clean) - :email (match-string 1 clean))) - (list (list :email clean)))))) - -(defun elfeed-entries-from-rss (url xml) - "Turn parsed RSS content into a list of elfeed-entry structs." - (let* ((feed-id url) - (protocol (url-type (url-generic-parse-url url))) - (namespace (elfeed-url-to-namespace url)) - (feed (elfeed-db-get-feed feed-id)) - (title (elfeed-cleanup (xml-query* (rss channel title *) xml))) - (autotags (elfeed-feed-autotags url))) - (setf (elfeed-feed-url feed) url - (elfeed-feed-title feed) title) - (cl-loop for item in (xml-query-all* (rss channel item) xml) collect - (let* ((title (or (xml-query* (title *) item) "")) - (guid (xml-query* (guid *) item)) - (link (elfeed--fixup-protocol - protocol - (or (xml-query* (link *) item) guid))) - (date (or (xml-query* (pubDate *) item) - (xml-query* (date *) item))) - (authors (nconc (elfeed--rss-author-to-plist - (xml-query* (author *) item)) - ;; Dublin Core - (elfeed--creators-to-plist - (xml-query-all* (creator *) item)))) - (categories (xml-query-all* (category *) item)) - (content (or (xml-query-all* (encoded *) item) - (xml-query-all* (description *) item))) - (description (apply #'concat content)) - (id (or guid link (elfeed-generate-id description))) - (full-id (cons namespace (elfeed-cleanup id))) - (original (elfeed-db-get-entry full-id)) - (original-date (and original (elfeed-entry-date original))) - (tags (elfeed-normalize-tags autotags elfeed-initial-tags)) - (etags (xml-query-all* (enclosure) item)) - (enclosures - (cl-loop for enclosure in etags - for wrap = (list enclosure) - for url = (xml-query* (:url) wrap) - for type = (xml-query* (:type) wrap) - for length = (xml-query* (:length) wrap) - collect (list url type length))) - (db-entry (elfeed-entry--create - :title (elfeed-cleanup title) - :id full-id - :feed-id feed-id - :link (elfeed-cleanup link) - :tags tags - :date (elfeed-new-date-for-entry - original-date date) - :enclosures enclosures - :content description - :content-type 'html - :meta `(,@(when authors - (list :authors authors)) - ,@(when categories - (list :categories categories)))))) - (dolist (hook elfeed-new-entry-parse-hook) - (funcall hook :rss item db-entry)) - db-entry)))) - -(defun elfeed-entries-from-rss1.0 (url xml) - "Turn parsed RSS 1.0 content into a list of elfeed-entry structs." - (let* ((feed-id url) - (namespace (elfeed-url-to-namespace url)) - (feed (elfeed-db-get-feed feed-id)) - (title (elfeed-cleanup (xml-query* (RDF channel title *) xml))) - (autotags (elfeed-feed-autotags url))) - (setf (elfeed-feed-url feed) url - (elfeed-feed-title feed) title) - (cl-loop for item in (xml-query-all* (RDF item) xml) collect - (let* ((title (or (xml-query* (title *) item) "")) - (link (xml-query* (link *) item)) - (date (or (xml-query* (pubDate *) item) - (xml-query* (date *) item))) - (description - (apply #'concat (xml-query-all* (description *) item))) - (id (or link (elfeed-generate-id description))) - (full-id (cons namespace (elfeed-cleanup id))) - (original (elfeed-db-get-entry full-id)) - (original-date (and original (elfeed-entry-date original))) - (tags (elfeed-normalize-tags autotags elfeed-initial-tags)) - (db-entry (elfeed-entry--create - :title (elfeed-cleanup title) - :id full-id - :feed-id feed-id - :link (elfeed-cleanup link) - :tags tags - :date (elfeed-new-date-for-entry - original-date date) - :content description - :content-type 'html))) - (dolist (hook elfeed-new-entry-parse-hook) - (funcall hook :rss1.0 item db-entry)) - db-entry)))) - -(defun elfeed-feed-list () - "Return a flat list version of `elfeed-feeds'. -Only a list of strings will be returned." - ;; Validate elfeed-feeds and fail early rather than asynchronously later. - (dolist (feed elfeed-feeds) - (unless (cl-typecase feed - (list (and (stringp (car feed)) - (cl-every #'symbolp (cdr feed)))) - (string t)) - (error "elfeed-feeds malformed, bad entry: %S" feed))) - (cl-loop for feed in elfeed-feeds - when (listp feed) collect (car feed) - else collect feed)) - -(defun elfeed-feed-autotags (url-or-feed) - "Return tags to automatically apply to all entries from URL-OR-FEED." - (let ((url (if (elfeed-feed-p url-or-feed) - (or (elfeed-feed-url url-or-feed) - (elfeed-feed-id url-or-feed)) - url-or-feed))) - (mapcar #'elfeed-keyword->symbol (cdr (assoc url elfeed-feeds))))) - -(defun elfeed-apply-autotags-now () - "Apply autotags to existing entries according to `elfeed-feeds'." - (interactive) - (with-elfeed-db-visit (entry feed) - (apply #'elfeed-tag entry (elfeed-feed-autotags feed)))) - -(defun elfeed-handle-http-error (url status) - "Handle an http error during retrieval of URL with STATUS code." - (cl-incf (elfeed-meta (elfeed-db-get-feed url) :failures 0)) - (run-hook-with-args 'elfeed-http-error-hooks url status) - (elfeed-log 'error "%s: %S" url status)) - -(defun elfeed-handle-parse-error (url error) - "Handle parse error during parsing of URL with ERROR message." - (cl-incf (elfeed-meta (elfeed-db-get-feed url) :failures 0)) - (run-hook-with-args 'elfeed-parse-error-hooks url error) - (elfeed-log 'error "%s: %s" url error)) - -(defun elfeed-update-feed (url) - "Update a specific feed." - (interactive (list (completing-read "Feed: " (elfeed-feed-list)))) - (unless elfeed--inhibit-update-init-hooks - (run-hooks 'elfeed-update-init-hooks)) - (elfeed-with-fetch url - (if (elfeed-is-status-error status use-curl) - (let ((print-escape-newlines t)) - (elfeed-handle-http-error - url (if use-curl elfeed-curl-error-message status))) - (condition-case error - (let ((feed (elfeed-db-get-feed url))) - (unless use-curl - (elfeed-move-to-first-empty-line) - (set-buffer-multibyte t)) - (unless (eql elfeed-curl-status-code 304) - ;; Update Last-Modified and Etag - (setf (elfeed-meta feed :last-modified) - (cdr (assoc "last-modified" elfeed-curl-headers)) - (elfeed-meta feed :etag) - (cdr (assoc "etag" elfeed-curl-headers))) - (if (equal url elfeed-curl-location) - (setf (elfeed-meta feed :canonical-url) nil) - (setf (elfeed-meta feed :canonical-url) elfeed-curl-location)) - (let* ((xml (elfeed-xml-parse-region (point) (point-max))) - (entries (cl-case (elfeed-feed-type xml) - (:atom (elfeed-entries-from-atom url xml)) - (:rss (elfeed-entries-from-rss url xml)) - (:rss1.0 (elfeed-entries-from-rss1.0 url xml)) - (otherwise - (error (elfeed-handle-parse-error - url "Unknown feed type.")))))) - (elfeed-db-add entries)))) - (error (elfeed-handle-parse-error url error)))) - (unless use-curl - (kill-buffer)) - (run-hook-with-args 'elfeed-update-hooks url))) - -(defun elfeed-candidate-feeds () - "Return a list of possible feeds from `elfeed-feed-functions'." - (let (res) - (run-hook-wrapped - 'elfeed-feed-functions - (lambda (fun) - (let* ((val (elfeed-cleanup (funcall fun)))) - (when (and (not (zerop (length val))) - (elfeed-looks-like-url-p val)) - (cl-pushnew val res :test #'equal))) - nil)) - (nreverse res))) - -(cl-defun elfeed-add-feed (url &key save) - "Manually add a feed to the database. -If SAVE is non-nil the new value of ‘elfeed-feeds’ is saved. When -called interactively, SAVE is set to t." - (interactive - (list - (let* ((feeds (elfeed-candidate-feeds)) - (prompt (if feeds (concat "URL (default " (car feeds) "): ") - "URL: ")) - (input (read-from-minibuffer prompt nil nil nil nil feeds)) - (result (elfeed-cleanup input))) - (cond ((not (zerop (length result))) result) - (feeds (car feeds)) - ((user-error "No feed to add")))) - :save t)) - (cl-pushnew url elfeed-feeds :test #'equal) - (when save - (customize-save-variable 'elfeed-feeds elfeed-feeds)) - (elfeed-update-feed url)) - -;;;###autoload -(defun elfeed-update () - "Update all the feeds in `elfeed-feeds'." - (interactive) - (elfeed-log 'info "Elfeed update: %s" - (format-time-string "%B %e %Y %H:%M:%S %Z")) - (let ((elfeed--inhibit-update-init-hooks t)) - (mapc #'elfeed-update-feed (elfeed--shuffle (elfeed-feed-list)))) - (run-hooks 'elfeed-update-init-hooks) - (elfeed-db-save)) - -;;;###autoload -(defun elfeed () - "Enter elfeed." - (interactive) - (switch-to-buffer (elfeed-search-buffer)) - (unless (eq major-mode 'elfeed-search-mode) - (elfeed-search-mode))) - -;; New entry filtering - -(cl-defun elfeed-make-tagger - (&key feed-title feed-url entry-title entry-link after before - add remove callback) - "Create a function that adds or removes tags on matching entries. - -FEED-TITLE, FEED-URL, ENTRY-TITLE, and ENTRY-LINK are regular -expressions or a list (not ), which indicates a negative -match. AFTER and BEFORE are relative times (see -`elfeed-time-duration'). Entries must match all provided -expressions. If an entry matches, add tags ADD and remove tags -REMOVE. - -Examples, - - (elfeed-make-tagger :feed-url \"youtube\\\\.com\" - :add '(video youtube)) - - (elfeed-make-tagger :before \"1 week ago\" - :remove 'unread) - - (elfeed-make-tagger :feed-url \"example\\\\.com\" - :entry-title '(not \"something interesting\") - :add 'junk) - -The returned function should be added to `elfeed-new-entry-hook'." - (let ((after-time (and after (elfeed-time-duration after))) - (before-time (and before (elfeed-time-duration before)))) - (when (and add (symbolp add)) (setf add (list add))) - (when (and remove (symbolp remove)) (setf remove (list remove))) - (lambda (entry) - (let ((feed (elfeed-entry-feed entry)) - (date (elfeed-entry-date entry)) - (case-fold-search t)) - (cl-flet ((match (r s) - (or (null r) - (if (listp r) - (not (string-match-p (cl-second r) s)) - (string-match-p r s))))) - (when (and - (match feed-title (elfeed-feed-title feed)) - (match feed-url (elfeed-feed-url feed)) - (match entry-title (elfeed-entry-title entry)) - (match entry-link (elfeed-entry-link entry)) - (or (not after-time) (> date (- (float-time) after-time))) - (or (not before-time) (< date (- (float-time) before-time)))) - (when add - (apply #'elfeed-tag entry add)) - (when remove - (apply #'elfeed-untag entry remove)) - (when callback - (funcall callback entry)) - entry)))))) - -;; OPML - -(defun elfeed--parse-opml (xml) - "Parse XML (from `xml-parse-region') into `elfeed-feeds' list." - (cl-loop for (tag attr . content) in (cl-remove-if-not #'listp xml) - count tag into work-around-bug ; bug#15326 - when (assoc 'xmlUrl attr) collect (cdr it) - else append (elfeed--parse-opml content))) - -;;;###autoload -(defun elfeed-load-opml (file) - "Load feeds from an OPML file into `elfeed-feeds'. -When called interactively, the changes to `elfeed-feeds' are -saved to your customization file." - (interactive "fOPML file: ") - (let* ((xml (xml-parse-file file)) - (feeds (elfeed--parse-opml xml)) - (full (append feeds elfeed-feeds))) - (prog1 (setf elfeed-feeds (cl-delete-duplicates full :test #'string=)) - (when (called-interactively-p 'any) - (customize-save-variable 'elfeed-feeds elfeed-feeds) - (elfeed-log 'notice "%d feeds loaded from %s" (length feeds) file))))) - -;;;###autoload -(defun elfeed-export-opml (file) - "Export the current feed listing to OPML-formatted FILE." - (interactive "FOutput OPML file: ") - (with-temp-file file - (let ((standard-output (current-buffer))) - (princ "\n") - (xml-print - `((opml ((version . "1.0")) - (head () (title () "Elfeed Export")) - (body () - ,@(cl-loop for url in (elfeed-feed-list) - for feed = (elfeed-db-get-feed url) - for title = (or (elfeed-feed-title feed) "") - collect `(outline ((xmlUrl . ,url) - (title . ,title))))))))))) - -(provide 'elfeed) - -(cl-eval-when (load eval) - ;; run-time only, so don't load when compiling other files - (unless byte-compile-root-dir - (require 'elfeed-csv) - (require 'elfeed-show) - (require 'elfeed-search))) - -;;; elfeed.el ends here diff --git a/elpa/elfeed-20190903.1137/xml-query.el b/elpa/elfeed-20190903.1137/xml-query.el deleted file mode 100644 index fd3cc2d8..00000000 --- a/elpa/elfeed-20190903.1137/xml-query.el +++ /dev/null @@ -1,231 +0,0 @@ -;;; 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 diff --git a/elpa/elfeed-20191227.426/elfeed-autoloads.el b/elpa/elfeed-20191227.426/elfeed-autoloads.el new file mode 100644 index 00000000..24f4e004 --- /dev/null +++ b/elpa/elfeed-20191227.426/elfeed-autoloads.el @@ -0,0 +1,141 @@ +;;; elfeed-autoloads.el --- automatically extracted autoloads +;; +;;; Code: + +(add-to-list 'load-path (directory-file-name + (or (file-name-directory #$) (car load-path)))) + + +;;;### (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-"))) + +;;;*** + +;;;### (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-"))) + +;;;*** + +;;;### (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-"))) + +;;;*** + +;;;### (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"))) + +;;;*** + +;;;### (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-"))) + +;;;*** + +;;;### (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-. 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)))))) + +;;;*** + +;;;### (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"))) + +;;;*** + +;;;### (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"))) + +;;;*** + +;;;### (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-"))) + +;;;*** + +;;;### (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"))) + +;;;*** + +;;;### (autoloads nil nil ("elfeed-pkg.el") (0 0 0 0)) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; coding: utf-8 +;; End: +;;; elfeed-autoloads.el ends here diff --git a/elpa/elfeed-20191227.426/elfeed-csv.el b/elpa/elfeed-20191227.426/elfeed-csv.el new file mode 100644 index 00000000..ae1f1457 --- /dev/null +++ b/elpa/elfeed-20191227.426/elfeed-csv.el @@ -0,0 +1,176 @@ +;;; 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 diff --git a/elpa/elfeed-20191227.426/elfeed-curl.el b/elpa/elfeed-20191227.426/elfeed-curl.el new file mode 100644 index 00000000..9e3308d8 --- /dev/null +++ b/elpa/elfeed-20191227.426/elfeed-curl.el @@ -0,0 +1,503 @@ +;;; elfeed-curl.el --- curl backend for Elfeed -*- lexical-binding: t; -*- + +;;; Comments: + +;; An alternative to `url-retrieve' and `url-queue' that fetches URLs +;; using the curl command line program. + +;; The API is three functions: + +;; * `elfeed-curl-retrieve' +;; * `elfeed-curl-retrieve-synchronously' +;; * `elfeed-curl-enqueue' + +;; And has four buffer-local variables for use in callbacks: + +;; * `elfeed-curl-headers' +;; * `elfeed-curl-status-code' +;; * `elfeed-curl-error-message' +;; * `elfeed-curl-location' + +;; The buffer delivered to callbacks may contain multiple requests. It +;; will be narrowed to the specific content for the current request. +;; It's vitally important that callbacks do not kill the buffer +;; because it may be needed for other callbacks. It also means the +;; buffer won't necessarily be around when the callback returns. +;; Callbacks should also avoid editing the buffer, though this +;; generally shouldn't impact other requests. + +;; Sometimes Elfeed asks curl to retrieve multiple requests and +;; deliver them concatenated. Due to the possibility of HTTP/1.0 being +;; involved — and other ambiguous-length protocols — there's no +;; perfectly unambiguous way to split the output. To work around this, +;; I use curl's --write-out to insert a randomly-generated token after +;; each request. It's highly unlikely (1 in ~1e38) that this token +;; will appear in content, so I can use it to identify the end of each +;; request. + +;;; Code: + +(require 'url) +(require 'cl-lib) +(require 'elfeed-lib) +(require 'elfeed-log) + +(defcustom elfeed-curl-program-name "curl" + "Name/path by which to invoke the curl program." + :group 'elfeed + :type 'string) + +(defcustom elfeed-curl-max-connections 16 + "Maximum number of concurrent fetches." + :group 'elfeed + :type 'integer) + +(defcustom elfeed-curl-timeout 30 + "Maximum number of seconds a fetch is allowed to take once started." + :group 'elfeed + :type 'integer) + +(defcustom elfeed-curl-extra-arguments () + "A list of additional arguments to pass to cURL. +These extra arguments are appended after Elfeed's own arguments, +and care must be taken to not interfere with Elfeed's needs. The +guideline is to avoid arguments that change anything about cURL's +output format." + :group 'elfeed + :type '(repeat string)) + +(defvar elfeed-curl-queue () + "List of pending curl requests.") + +(defvar elfeed-curl-queue-active 0 + "Number of concurrent requests currently active.") + +(defvar-local elfeed-curl-headers nil + "Alist of HTTP response headers.") + +(defvar-local elfeed-curl-status-code nil + "Numeric HTTP response code, nil for non-HTTP protocols.") + +(defvar-local elfeed-curl-error-message nil + "Human-friendly message describing the error.") + +(defvar-local elfeed-curl-location nil + "Actual URL fetched (after any redirects).") + +(defvar-local elfeed-curl--regions () + "List of markers bounding separate requests.") + +(defvar-local elfeed-curl--requests () + "List of URL / callback pairs for the current buffer.") + +(defvar-local elfeed-curl--token nil + "Unique token that splits requests.") + +(defvar-local elfeed-curl--refcount nil + "Number of callbacks waiting on the current buffer.") + +(defvar elfeed-curl--error-codes + '((1 . "Unsupported protocol.") + (2 . "Failed to initialize.") + (3 . "URL malformed. The syntax was not correct.") + (4 . "A feature or option that was needed to perform the desired request was not enabled or was explicitly disabled at build-time.") + (5 . "Couldn't resolve proxy. The given proxy host could not be resolved.") + (6 . "Couldn't resolve host. The given remote host was not resolved.") + (7 . "Failed to connect to host.") + (8 . "FTP weird server reply. The server sent data curl couldn't parse.") + (9 . "FTP access denied.") + (11 . "FTP weird PASS reply.") + (13 . "FTP weird PASV reply.") + (14 . "FTP weird 227 format.") + (15 . "FTP can't get host.") + (16 . "A problem was detected in the HTTP2 framing layer.") + (17 . "FTP couldn't set binary.") + (18 . "Partial file. Only a part of the file was transferred.") + (19 . "FTP couldn't download/access the given file, the RETR (or similar) command failed.") + (21 . "FTP quote error. A quote command returned error from the server.") + (22 . "HTTP page not retrieved.") + (23 . "Write error.") + (25 . "FTP couldn't STOR file.") + (26 . "Read error. Various reading problems.") + (27 . "Out of memory. A memory allocation request failed.") + (28 . "Operation timeout.") + (30 . "FTP PORT failed.") + (31 . "FTP couldn't use REST.") + (33 . "HTTP range error. The range \"command\" didn't work.") + (34 . "HTTP post error. Internal post-request generation error.") + (35 . "SSL connect error. The SSL handshaking failed.") + (36 . "FTP bad download resume.") + (37 . "FILE couldn't read file.") + (38 . "LDAP bind operation failed.") + (39 . "LDAP search failed.") + (41 . "Function not found. A required LDAP function was not found.") + (42 . "Aborted by callback.") + (43 . "Internal error. A function was called with a bad parameter.") + (45 . "Interface error. A specified outgoing interface could not be used.") + (47 . "Too many redirects.") + (48 . "Unknown option specified to libcurl.") + (49 . "Malformed telnet option.") + (51 . "The peer's SSL certificate or SSH MD5 fingerprint was not OK.") + (52 . "The server didn't reply anything, which here is considered an error.") + (53 . "SSL crypto engine not found.") + (54 . "Cannot set SSL crypto engine as default.") + (55 . "Failed sending network data.") + (56 . "Failure in receiving network data.") + (58 . "Problem with the local certificate.") + (59 . "Couldn't use specified SSL cipher.") + (60 . "Peer certificate cannot be authenticated with known CA certificates.") + (61 . "Unrecognized transfer encoding.") + (62 . "Invalid LDAP URL.") + (63 . "Maximum file size exceeded.") + (64 . "Requested FTP SSL level failed.") + (65 . "Sending the data requires a rewind that failed.") + (66 . "Failed to initialise SSL Engine.") + (67 . "The user name, password, or similar was not accepted and curl failed to log in.") + (68 . "File not found on TFTP server.") + (69 . "Permission problem on TFTP server.") + (70 . "Out of disk space on TFTP server.") + (71 . "Illegal TFTP operation.") + (72 . "Unknown TFTP transfer ID.") + (73 . "File already exists (TFTP).") + (74 . "No such user (TFTP).") + (75 . "Character conversion failed.") + (76 . "Character conversion functions required.") + (77 . "Problem with reading the SSL CA cert (path? access rights?).") + (78 . "The resource referenced in the URL does not exist.") + (79 . "An unspecified error occurred during the SSH session.") + (80 . "Failed to shut down the SSL connection.") + (82 . "Could not load CRL file, missing or wrong format (added in 7.19.0).") + (83 . "Issuer check failed (added in 7.19.0).") + (84 . "The FTP PRET command failed") + (85 . "RTSP: mismatch of CSeq numbers") + (86 . "RTSP: mismatch of Session Identifiers") + (87 . "unable to parse FTP file list") + (88 . "FTP chunk callback reported error") + (89 . "No connection available, the session will be queued") + (90 . "SSL public key does not matched pinned public key"))) + +(defvar elfeed-curl--capabilities-cache + (make-hash-table :test 'eq :weakness 'key) + "Used to avoid invoking curl more than once for version info.") + +(defun elfeed-curl-get-capabilities () + "Return capabilities plist for the curl at `elfeed-curl-program-name'. +:version -- cURL's version string +:compression -- non-nil if --compressed is supported" + (let* ((cache elfeed-curl--capabilities-cache) + (cache-value (gethash elfeed-curl-program-name cache))) + (if cache-value + cache-value + (with-temp-buffer + (call-process elfeed-curl-program-name nil t nil "--version") + (let ((version + (progn + (setf (point) (point-min)) + (when (re-search-forward "[.0-9]+" nil t) + (match-string 0)))) + (compression + (progn + (setf (point) (point-min)) + (not (null (re-search-forward "libz\\>" nil t)))))) + (setf (gethash elfeed-curl-program-name cache) + `(:version ,version :compression ,compression))))))) + +(defun elfeed-curl-get-version () + "Return the version of curl for `elfeed-curl-program-name'." + (plist-get (elfeed-curl-get-capabilities) :version)) +(make-obsolete 'elfeed-curl-get-version 'elfeed-curl-get-capabilities "3.0.1") + +(defun elfeed-curl--token () + "Return a unique, random string that prints as a symbol without escapes. +This token is used to split requests. The % is excluded since +it's special to --write-out." + (let* ((token (make-string 22 ?=)) + (set "!$&*+-/0123456789:<>@ABCDEFGHIJKLMNOPQRSTUVWXYZ^_\ +abcdefghijklmnopqrstuvwxyz|~")) + (prog1 token ; workaround bug#16206 + (dotimes (i (- (length token) 2)) + (setf (aref token (1+ i)) (aref set (cl-random (length set)))))))) + +(defun elfeed-curl--parse-write-out () + "Parse curl's write-out (-w) messages into `elfeed-curl--regions'." + (widen) + (setf (point) (point-max) + elfeed-curl--regions ()) + (while (> (point) (point-min)) + (search-backward elfeed-curl--token) + (cl-decf (point)) + (let ((end (point))) + (cl-destructuring-bind (_ . header) (read (current-buffer)) + (setf (point) end) + ;; Find next sentinel token + (if (search-backward elfeed-curl--token nil t) + (search-forward ")" nil t) + (setf (point) (point-min))) + (let* ((header-start (point)) + (header-end (+ (point) header)) + (content-start (+ (point) header)) + (content-end end) + (regions (list header-start header-end + content-start content-end)) + (markers (cl-loop for p in regions + for marker = (make-marker) + collect (set-marker marker p)))) + (push markers elfeed-curl--regions)))))) + +(defun elfeed-curl--narrow (kind n) + "Narrow to Nth region of KIND (:header, :content)." + (let ((region (nth n elfeed-curl--regions))) + (cl-destructuring-bind (h-start h-end c-start c-end) region + (cl-ecase kind + (:header (narrow-to-region h-start h-end)) + (:content (narrow-to-region c-start c-end)))))) + +(defun elfeed-curl--parse-headers () + "Parse the current HTTP response headers into buffer-locals. +Sets `elfeed-curl-headers'and `elfeed-curl-status-code'. +Use `elfeed-curl--narrow' to select a header." + (when (> (- (point-max) (point-min)) 0) + (setf (point) (point-max)) + (re-search-backward "HTTP/[.0-9]+ +\\([0-9]+\\)") + (setf elfeed-curl-status-code (string-to-number (match-string 1))) + (cl-loop initially (setf (point) (point-max)) + while (re-search-backward "^\\([^:]+\\): +\\([^\r\n]+\\)" nil t) + for key = (downcase (match-string 1)) + for value = (match-string 2) + collect (cons key value) into headers + finally (setf elfeed-curl-headers headers)))) + +(defun elfeed-curl--decode () + "Try to decode the buffer based on the headers." + (let ((content-type (cdr (assoc "Content-Type" elfeed-curl-headers)))) + (if (and content-type (string-match "charset=\\(.+\\)" content-type)) + (decode-coding-region (point-min) (point-max) + (coding-system-from-name + (match-string 1 content-type))) + (decode-coding-region (point-min) (point-max) 'utf-8)))) + +(defun elfeed-curl--final-location (location headers) + "Given start LOCATION and HEADERS, find the final location." + (cl-loop for (key . value) in headers + when (equal key "location") + do (setf location (elfeed-update-location location value)) + finally return location)) + +(defun elfeed-curl--args (url token &optional headers method data) + "Build an argument list for curl for URL. +URL can be a string or a list of URL strings." + (let* ((args ()) + (capabilities (elfeed-curl-get-capabilities))) + (push "--disable" args) + (when (plist-get capabilities :compression) + (push "--compressed" args)) + (push "--silent" args) + (push "--location" args) + (push (format "-w(%s . %%{size_header})" token) args) + (push (format "-m%s" elfeed-curl-timeout) args) + (push "-D-" args) + (dolist (header headers) + (cl-destructuring-bind (key . value) header + (push (format "-H%s: %s" key value) args))) + (when method (push (format "-X%s" method) args)) + (when data (push (format "-d%s" data) args)) + (setf args (nconc (reverse elfeed-curl-extra-arguments) args)) + (if (listp url) + (nconc (nreverse args) url) + (nreverse (cons url args))))) + +(defun elfeed-curl--prepare-response (url n) + "Prepare response N for delivery to user." + (elfeed-curl--narrow :header n) + (elfeed-curl--parse-headers) + (setf elfeed-curl-location + (elfeed-curl--final-location url elfeed-curl-headers)) + (elfeed-curl--narrow :content n) + (elfeed-curl--decode) + (current-buffer)) + +(cl-defun elfeed-curl-retrieve-synchronously (url &key headers method data) + "Retrieve the contents for URL and return a new buffer with them. + +HEADERS is an alist of additional headers to add to the HTTP request. +METHOD is the HTTP method to use. +DATA is the content to include in the request." + (with-current-buffer (generate-new-buffer " *curl*") + (setf elfeed-curl--token (elfeed-curl--token)) + (let ((args (elfeed-curl--args url elfeed-curl--token headers method data)) + (coding-system-for-read 'binary)) + (apply #'call-process elfeed-curl-program-name nil t nil args)) + (elfeed-curl--parse-write-out) + (elfeed-curl--prepare-response url 0))) + +(defun elfeed-curl--call-callback (buffer n url cb) + "Prepare the buffer for callback N and call it." + (let ((result nil)) + (with-current-buffer buffer + (setf elfeed-curl-error-message "unable to parse curl response") + (unwind-protect + (progn + (elfeed-curl--prepare-response url n) + (if (and (>= elfeed-curl-status-code 400) + (<= elfeed-curl-status-code 599)) + (setf elfeed-curl-error-message + (format "HTTP %d" elfeed-curl-status-code)) + (setf result t + elfeed-curl-error-message nil))) + ;; Always call callback + (unwind-protect + (funcall cb result) + ;; Always clean up + (when (zerop (cl-decf elfeed-curl--refcount)) + (kill-buffer))))))) + +(defun elfeed-curl--fail-callback (buffer cb) + "Inform the callback the request failed." + (with-current-buffer buffer + (unwind-protect + (funcall cb nil) + (when (zerop (cl-decf elfeed-curl--refcount)) + (kill-buffer))))) + +(defun elfeed-curl--sentinel (process status) + "Manage the end of a curl process' life." + (let ((buffer (process-buffer process))) + (with-current-buffer buffer + ;; Fire off callbacks in separate interpreter turns so they can + ;; each fail in isolation from each other. + (if (equal status "finished\n") + (cl-loop with handler = #'elfeed-curl--call-callback + initially do (elfeed-curl--parse-write-out) + for (url . cb) in elfeed-curl--requests + for n upfrom 0 + do (run-at-time 0 nil handler buffer n url cb)) + (if (string-match "exited abnormally with code \\([0-9]+\\)" status) + (let* ((code (string-to-number (match-string 1 status))) + (message (cdr (assoc code elfeed-curl--error-codes)))) + (setf elfeed-curl-error-message + (format "(%d) %s" code + (or message "Unknown curl error!")))) + (setf elfeed-curl-error-message status)) + (cl-loop with handler = #'elfeed-curl--fail-callback + for (_ . cb) in elfeed-curl--requests + do (run-at-time 0 nil handler buffer cb)))))) + +(cl-defun elfeed-curl-retrieve (url cb &key headers method data) + "Retrieve URL contents asynchronously, calling CB with one status argument. + +The callback must *not* kill the buffer! + +The destination buffer is set at the current buffer for the +callback. + +HEADERS is an alist of additional headers to add to HTTP requests. +METHOD is the HTTP method to use. +DATA is the content to include in the request. + +URL can be a list of URLs, which will fetch them all in the same +curl process. In this case, CB can also be either a list of the +same length, or just a single function to be called once for each +URL in the list. Headers will be common to all requests. A TCP or +DNS failure in one will cause all to fail, but 4xx and 5xx +results will not." + (with-current-buffer (generate-new-buffer " *curl*") + (setf elfeed-curl--token (elfeed-curl--token)) + (let* ((coding-system-for-read 'binary) + (process-connection-type nil) + (args (elfeed-curl--args url elfeed-curl--token headers method data)) + (process (apply #'start-process "elfeed-curl" (current-buffer) + elfeed-curl-program-name args))) + (prog1 process + (if (listp url) + (progn + (when (functionp cb) + (setf cb (make-list (length url) cb))) + (setf elfeed-curl--requests (cl-mapcar #'cons url cb) + elfeed-curl--refcount (length url))) + (push (cons url cb) elfeed-curl--requests) + (setf elfeed-curl--refcount 1)) + (setf (process-sentinel process) #'elfeed-curl--sentinel))))) + +(defun elfeed-curl--request-key (url headers method data) + "Try to fetch URLs with matching keys at the same time." + (unless (listp url) + (let* ((urlobj (url-generic-parse-url url))) + (list (url-type urlobj) + (url-host urlobj) + (url-portspec urlobj) + headers + method + data)))) + +(defun elfeed-curl--queue-consolidate (queue-in) + "Group compatible requests together and return a new queue. +Compatible means the requests have the same protocol, domain, +port, headers, method, and body, allowing them to be used safely +in the same curl invocation." + (let ((table (make-hash-table :test 'equal)) + (keys ()) + (queue-out ())) + (dolist (entry queue-in) + (cl-destructuring-bind (url _ headers method data) entry + (let* ((key (elfeed-curl--request-key url headers method data))) + (push key keys) + (push entry (gethash key table nil))))) + (dolist (key (nreverse keys)) + (let ((entry (gethash key table))) + (when entry + (let ((rotated (list (nreverse (cl-mapcar #'car entry)) + (nreverse (cl-mapcar #'cadr entry)) + (cl-caddar entry) + (elt (car entry) 3) + (elt (car entry) 4)))) + (push rotated queue-out) + (setf (gethash key table) nil))))) + (nreverse queue-out))) + +(defun elfeed-curl--queue-wrap (cb) + "Wrap the curl CB so that it operates the queue." + (lambda (status) + (cl-decf elfeed-curl-queue-active) + (elfeed-curl--run-queue) + (funcall cb status))) + +(defvar elfeed-curl--run-queue-queued nil + "Non-nil if run-queue has already been queued for the next turn.") + +(defun elfeed-curl--run-queue () + "Possibly fire off some new requests." + (when elfeed-curl--run-queue-queued + (setf elfeed-curl--run-queue-queued nil + ;; Try to consolidate the new requests. + elfeed-curl-queue + (elfeed-curl--queue-consolidate elfeed-curl-queue))) + (while (and (< elfeed-curl-queue-active elfeed-curl-max-connections) + (> (length elfeed-curl-queue) 0)) + (cl-destructuring-bind (url cb headers method data) (pop elfeed-curl-queue) + (elfeed-log 'debug "retrieve %s" url) + (cl-incf elfeed-curl-queue-active 1) + (elfeed-curl-retrieve + url + (if (functionp cb) + (elfeed-curl--queue-wrap cb) + (cons (elfeed-curl--queue-wrap (car cb)) + (cdr cb))) + :headers headers + :method method + :data data)))) + +(cl-defun elfeed-curl-enqueue (url cb &key headers method data) + "Just like `elfeed-curl-retrieve', but restricts concurrent fetches." + (unless (or (stringp url) + (and (listp url) (cl-every #'stringp url))) + ;; Signal error synchronously instead of asynchronously in the timer + (signal 'wrong-type-argument (list 'string-p-or-string-list-p url))) + (let ((entry (list url cb headers method data))) + (setf elfeed-curl-queue (nconc elfeed-curl-queue (list entry))) + (unless elfeed-curl--run-queue-queued + (run-at-time 0 nil #'elfeed-curl--run-queue) + (setf elfeed-curl--run-queue-queued t)))) + +(provide 'elfeed-curl) + +;;; elfeed-curl.el ends here diff --git a/elpa/elfeed-20191227.426/elfeed-db.el b/elpa/elfeed-20191227.426/elfeed-db.el new file mode 100644 index 00000000..4000a0bb --- /dev/null +++ b/elpa/elfeed-20191227.426/elfeed-db.el @@ -0,0 +1,646 @@ +;;; 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 diff --git a/elpa/elfeed-20191227.426/elfeed-lib.el b/elpa/elfeed-20191227.426/elfeed-lib.el new file mode 100644 index 00000000..5168a390 --- /dev/null +++ b/elpa/elfeed-20191227.426/elfeed-lib.el @@ -0,0 +1,382 @@ +;;; elfeed-lib.el --- misc functions for elfeed -*- lexical-binding: t; -*- + +;; This is free and unencumbered software released into the public domain. + +;;; Commentary: + +;; These are general functions that aren't specific to web feeds. It's +;; a library of useful functions to Elfeed. + +;;; Code: + +(require 'xml) +(require 'cl-lib) +(require 'time-date) +(require 'url-parse) +(require 'url-util) + +(defun elfeed-expose (function &rest args) + "Return an interactive version of FUNCTION, 'exposing' it to the user." + (lambda () (interactive) (apply function args))) + +(defun elfeed-goto-line (n) + "Like `goto-line' but for non-interactive use." + (goto-char (point-min)) + (forward-line (1- n))) + +(defun elfeed-kill-buffer () + "Kill the current buffer." + (interactive) + (kill-buffer (current-buffer))) + +(defun elfeed-kill-line () + "Clear out the current line without touching anything else." + (beginning-of-line) + (let ((start (point))) + (end-of-line) + (delete-region start (point)))) + +(defun elfeed-time-duration (time &optional now) + "Turn a time expression into a number of seconds. Uses +`timer-duration' but allows a bit more flair. + +If `now' is non-nil, use it as the current time (`float-time'). This +is mostly useful for testing." + (cond + ((numberp time) time) + ((let ((iso-time (elfeed-parse-simple-iso-8601 time))) + (when iso-time (- (or now (float-time)) iso-time)))) + ((string-match-p "[[:alpha:]]" time) + (let* ((clean (replace-regexp-in-string "\\(ago\\|old\\|-\\)" " " time)) + (duration (timer-duration clean))) + ;; convert to float since float-time is used elsewhere + (when duration (float duration)))))) + +(defun elfeed-looks-like-url-p (string) + "Return true if STRING looks like it could be a URL." + (and (stringp string) + (not (string-match-p "[ \n\t\r]" string)) + (not (null (url-type (url-generic-parse-url string)))))) + +(defun elfeed-format-column (string width &optional align) + "Return STRING truncated or padded to WIDTH following ALIGNment. +Align should be a keyword :left or :right." + (if (<= width 0) + "" + (format (format "%%%s%d.%ds" (if (eq align :left) "-" "") width width) + string))) + +(defun elfeed-clamp (min value max) + "Clamp a value between two values." + (min max (max min value))) + +(defun elfeed-valid-regexp-p (regexp) + "Return t if REGEXP is a valid REGEXP." + (ignore-errors + (prog1 t + (string-match-p regexp "")))) + +(defun elfeed-cleanup (name) + "Trim trailing and leading spaces and collapse multiple spaces." + (let ((trim (replace-regexp-in-string "[\f\n\r\t\v ]+" " " (or name "")))) + (replace-regexp-in-string "^ +\\| +$" "" trim))) + +(defun elfeed-parse-simple-iso-8601 (string) + "Attempt to parse STRING as a simply formatted ISO 8601 date. +Examples: 2015-02-22, 2015-02, 20150222" + (let* ((re (cl-flet ((re-numbers (num) (format "\\([0-9]\\{%s\\}\\)" num))) + (format "^%s-?%s-?%s?\\(T%s:%s:?%s?\\)?" + (re-numbers 4) + (re-numbers 2) + (re-numbers 2) + (re-numbers 2) + (re-numbers 2) + (re-numbers 2)))) + (matches (save-match-data + (when (string-match re string) + (cl-loop for i from 1 to 7 + collect (let ((match (match-string i string))) + (and match (string-to-number match)))))))) + (when matches + (cl-multiple-value-bind (year month day _ hour min sec) matches + (float-time (encode-time (or sec 0) (or min 0) (or hour 0) + (or day 1) month year t)))))) + +(defun elfeed-new-date-for-entry (old-date new-date) + "Decide entry date, given an existing date (nil for new) and a new date. +Existing entries' dates are unchanged if the new date is not +parseable. New entries with unparseable dates default to the +current time." + (or (elfeed-float-time new-date) + old-date + (float-time))) + +(defun elfeed-float-time (date) + "Like `float-time' but accept anything reasonable for DATE. +Defaults to nil if DATE could not be parsed. Date is allowed to +be relative to now (`elfeed-time-duration')." + (cl-typecase date + (string + (let ((iso-8601 (elfeed-parse-simple-iso-8601 date))) + (if iso-8601 + iso-8601 + (let ((duration (elfeed-time-duration date))) + (if duration + (- (float-time) duration) + (let ((time (ignore-errors (date-to-time date)))) + ;; check if date-to-time failed, silently or otherwise + (unless (or (null time) (equal time '(14445 17280))) + (float-time time)))))))) + (integer date) + (otherwise nil))) + +(defun elfeed-xml-parse-region (&optional beg end buffer parse-dtd _parse-ns) + "Decode (if needed) and parse XML file. Uses coding system from +XML encoding declaration." + (unless beg (setq beg (point-min))) + (unless end (setq end (point-max))) + (setf (point) beg) + (when (re-search-forward + "<\\?xml.*?encoding=[\"']\\([^\"']+\\)[\"'].*?\\?>" nil t) + (let ((coding-system (intern-soft (downcase (match-string 1))))) + (when (ignore-errors (check-coding-system coding-system)) + (let ((mark-beg (make-marker)) + (mark-end (make-marker))) + ;; Region changes with encoding, so use markers to track it. + (set-marker mark-beg beg) + (set-marker mark-end end) + (set-buffer-multibyte t) + (recode-region mark-beg mark-end coding-system 'raw-text) + (setf beg (marker-position mark-beg) + end (marker-position mark-end)))))) + (let ((xml-default-ns ())) + (xml-parse-region beg end buffer parse-dtd 'symbol-qnames))) + +(defun elfeed-xml-unparse (element) + "Inverse of `elfeed-xml-parse-region', writing XML to the buffer." + (cl-destructuring-bind (tag attrs . body) element + (insert (format "<%s" tag)) + (dolist (attr attrs) + (cl-destructuring-bind (key . value) attr + (insert (format " %s='%s'" key (xml-escape-string value))))) + (if (null body) + (insert "/>") + (insert ">") + (dolist (sub body) + (if (stringp sub) + (insert (xml-escape-string sub)) + (elfeed-xml-unparse sub))) + (insert (format "" tag))))) + +(defun elfeed-directory-empty-p (dir) + "Return non-nil if DIR is empty." + (null (cddr (directory-files dir)))) + +(defun elfeed-slurp (file &optional literally) + "Return the contents of FILE as a string." + (with-temp-buffer + (if literally + (insert-file-contents-literally file) + (insert-file-contents file)) + (buffer-string))) + +(cl-defun elfeed-spit (file string &key fsync append (encoding 'utf-8)) + "Write STRING to FILE." + (let ((coding-system-for-write encoding) + (write-region-inhibit-fsync (not fsync))) + (with-temp-buffer + (insert string) + (write-region nil nil file append 0)))) + +(defvar elfeed-gzip-supported-p--cache :unknown + "To avoid running the relatively expensive test more than once.") + +(defun elfeed-gzip-supported-p () + "Return non-nil if `auto-compression-mode' can handle gzip." + (if (not (eq elfeed-gzip-supported-p--cache :unknown)) + elfeed-gzip-supported-p--cache + (setf elfeed-gzip-supported-p--cache + (and (executable-find "gzip") + (ignore-errors + (save-window-excursion + (let ((file (make-temp-file "gziptest" nil ".gz")) + (data (cl-loop for i from 32 to 3200 + collect i into chars + finally + (return (apply #'string chars))))) + (unwind-protect + (progn + (elfeed-spit file data) + (and (string= data (elfeed-slurp file)) + (not (string= data (elfeed-slurp file t))))) + (delete-file file))))))))) + +(defun elfeed-libxml-supported-p () + "Return non-nil if `libxml-parse-html-region' is available." + (with-temp-buffer + (insert "") + (and (fboundp 'libxml-parse-html-region) + (not (null (libxml-parse-html-region (point-min) (point-max))))))) + +(defun elfeed-keyword->symbol (keyword) + "If a keyword, convert KEYWORD into a plain symbol (remove the colon)." + (if (keywordp keyword) + (intern (substring (symbol-name keyword) 1)) + keyword)) + +(defun elfeed-resize-vector (vector length) + "Return a copy of VECTOR set to size LENGTH." + (let ((new-vector (make-vector length nil))) + (prog1 new-vector ; don't use dotimes result (bug#16206) + (dotimes (i (min (length new-vector) (length vector))) + (setf (aref new-vector i) (aref vector i)))))) + +(defun elfeed-readable-p (value) + "Return non-nil if VALUE can be serialized." + (condition-case _ + (prog1 t (read (prin1-to-string value))) + (error nil))) + +(defun elfeed-strip-properties (string) + "Return a copy of STRING with all properties removed. +If STRING is nil, returns nil." + (when string + (let ((copy (copy-sequence string))) + (prog1 copy + (set-text-properties 0 (length copy) nil copy))))) + +(defun elfeed-clipboard-get () + "Try to get a sensible value from the system clipboard. +On systems running X, it will try to use the PRIMARY selection +first, then fall back onto the standard clipboard like other +systems." + (elfeed-strip-properties + (or (and (fboundp 'x-get-selection) + (funcall 'x-get-selection)) + (and (functionp interprogram-paste-function) + (funcall interprogram-paste-function)) + (and (fboundp 'w32-get-clipboard-data) + (funcall 'w32-get-clipboard-data)) + (ignore-errors + (current-kill 0 :non-destructively))))) + +(defun elfeed-get-link-at-point () + "Try to a link at point and return its URL." + (or (get-text-property (point) 'shr-url) + (and (fboundp 'eww-current-url) + (funcall 'eww-current-url)) + (get-text-property (point) :nt-link))) + +(defun elfeed-get-url-at-point () + "Try to get a plain URL at point." + (or (url-get-url-at-point) + (thing-at-point 'url))) + +(defun elfeed-move-to-first-empty-line () + "Place point after first blank line, for use with `url-retrieve'. +If no such line exists, point is left in place." + (let ((start (point))) + (setf (point) (point-min)) + (unless (search-forward-regexp "^$" nil t) + (setf (point) start)))) + +(defun elfeed--shuffle (seq) + "Destructively shuffle SEQ." + (let ((n (length seq))) + (prog1 seq ; don't use dotimes result (bug#16206) + (dotimes (i n) + (cl-rotatef (elt seq i) (elt seq (+ i (cl-random (- n i))))))))) + +(defun elfeed-split-ranges-to-numbers (str n) + "Convert STR containing enclosure numbers into a list of numbers. +STR is a string; N is the highest possible number in the list. +This includes expanding e.g. 3-5 into 3,4,5. If the letter +\"a\" ('all')) is given, that is expanded to a list with numbers [1..n]." + (let ((str-split (split-string str)) + beg end list) + (dolist (elem str-split list) + ;; special number "a" converts into all enclosures 1-N. + (when (equal elem "a") + (setf elem (concat "1-" (int-to-string n)))) + (if (string-match "\\([0-9]+\\)-\\([0-9]+\\)" elem) + ;; we have found a range A-B, which needs converting + ;; into the numbers A, A+1, A+2, ... B. + (progn + (setf beg (string-to-number (match-string 1 elem)) + end (string-to-number (match-string 2 elem))) + (while (<= beg end) + (setf list (nconc list (list beg)) + beg (1+ beg)))) + ;; else just a number + (push (string-to-number elem) list))))) + +(defun elfeed-remove-dot-segments (input) + "Relative URL algorithm as described in RFC 3986 §5.2.4." + (cl-loop + with output = "" + for s = input + then (cond + ((string-match-p "^\\.\\./" s) + (substring s 3)) + ((string-match-p "^\\./" s) + (substring s 2)) + ((string-match-p "^/\\./" s) + (substring s 2)) + ((string-match-p "^/\\.$" s) "/") + ((string-match-p "^/\\.\\./" s) + (setf output (replace-regexp-in-string "/?[^/]*$" "" output)) + (substring s 3)) + ((string-match-p "^/\\.\\.$" s) + (setf output (replace-regexp-in-string "/?[^/]*$" "" output)) + "/") + ((string-match-p "^\\.\\.?$" s) + "") + ((string-match "^/?[^/]*" s) + (setf output (concat output (match-string 0 s))) + (replace-regexp-in-string "^/?[^/]*" "" s))) + until (zerop (length s)) + finally return output)) + +(defun elfeed-update-location (old-url new-url) + "Return full URL for maybe-relative NEW-URL based on full OLD-URL." + (if (null new-url) + old-url + (let ((old (url-generic-parse-url old-url)) + (new (url-generic-parse-url new-url))) + (cond + ;; Is new URL absolute already? + ((url-type new) new-url) + ;; Empty is a special case (clear fragment) + ((equal new-url "") + (setf (url-target old) nil) + (url-recreate-url old)) + ;; Does it start with //? Append the old protocol. + ((url-fullness new) (concat (url-type old) ":" new-url)) + ;; Is it a relative path? + ((not (string-match-p "^/" new-url)) + (let* ((old-dir (or (file-name-directory (url-filename old)) "/")) + (concat (concat old-dir new-url)) + (new-file (elfeed-remove-dot-segments concat))) + (setf (url-filename old) nil + (url-target old) nil + (url-attributes old) nil + (url-filename old) new-file) + (url-recreate-url old))) + ;; Replace the relative part. + ((progn + (setf (url-filename old) (elfeed-remove-dot-segments new-url) + (url-target old) nil + (url-attributes old) nil) + (url-recreate-url old))))))) + +(defun elfeed-url-to-namespace (url) + "Compute an ID namespace from URL." + (let* ((urlobj (url-generic-parse-url url)) + (host (url-host urlobj))) + (if (= 0 (length host)) + url + host))) + +(provide 'elfeed-lib) + +;;; elfeed-lib.el ends here diff --git a/elpa/elfeed-20191227.426/elfeed-link.el b/elpa/elfeed-20191227.426/elfeed-link.el new file mode 100644 index 00000000..c127bf2e --- /dev/null +++ b/elpa/elfeed-20191227.426/elfeed-link.el @@ -0,0 +1,80 @@ +;;; elfeed-link.el --- misc functions for elfeed -*- lexical-binding: t; -*- + +;; This is free and unencumbered software released into the public domain. + +;;; Commentary: + +;; Code for integration with org-mode. + +;; To use, add (require 'elfeed-link) somewhere in your configuration. + +;;; Code: + +(require 'org) +(require 'cl-lib) +(require 'elfeed-db) +(require 'elfeed-show) +(require 'elfeed-search) + +;;;###autoload +(defun elfeed-link-store-link () + "Store a link to an elfeed search or entry buffer. + +When storing a link to an entry, automatically extract all the +entry metadata. These can be used in the capture templates as +%:elfeed-entry-. See `elfeed-entry--create' for the list +of available props." + (cond ((derived-mode-p 'elfeed-search-mode) + (org-store-link-props + :type "elfeed" + :link (format "elfeed:%s" elfeed-search-filter) + :description elfeed-search-filter)) + ((derived-mode-p 'elfeed-show-mode) + (apply + 'org-store-link-props + :type "elfeed" + :link (format "elfeed:%s#%s" + (car (elfeed-entry-id elfeed-show-entry)) + (cdr (elfeed-entry-id elfeed-show-entry))) + :description (elfeed-entry-title elfeed-show-entry) + (cl-loop for prop in + (list 'id 'title 'link 'date 'content 'content-type 'enclosures 'tags 'feed-id 'meta) + nconc (list + (intern (concat ":elfeed-entry-" (symbol-name prop))) + (funcall + (intern (concat "elfeed-entry-" (symbol-name prop))) + elfeed-show-entry))))))) + +;;;###autoload +(defun elfeed-link-open (filter-or-id) + "Jump to an elfeed entry or search. + +Depending on what FILTER-OR-ID looks like, we jump to either +search buffer or show a concrete entry." + (if (string-match "\\([^#]+\\)#\\(.+\\)" filter-or-id) + (elfeed-show-entry (elfeed-db-get-entry + (cons (match-string 1 filter-or-id) + (match-string 2 filter-or-id)))) + (elfeed) + (elfeed-search-set-filter filter-or-id))) + +;;;###autoload +(eval-after-load 'org + `(funcall + ;; The extra quote below is necessary because uncompiled closures + ;; do not evaluate to themselves. The quote is harmless for + ;; byte-compiled function objects. + ',(lambda () + (if (version< (org-version) "9.0") + (with-no-warnings + (org-add-link-type "elfeed" #'elfeed-link-open) + (add-hook 'org-store-link-functions #'elfeed-link-store-link)) + (with-no-warnings + (org-link-set-parameters + "elfeed" + :follow #'elfeed-link-open + :store #'elfeed-link-store-link)))))) + +(provide 'elfeed-link) + +;;; elfeed-link.el ends here diff --git a/elpa/elfeed-20191227.426/elfeed-log.el b/elpa/elfeed-20191227.426/elfeed-log.el new file mode 100644 index 00000000..9f91237f --- /dev/null +++ b/elpa/elfeed-20191227.426/elfeed-log.el @@ -0,0 +1,84 @@ +;;; 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 diff --git a/elpa/elfeed-20191227.426/elfeed-pkg.el b/elpa/elfeed-20191227.426/elfeed-pkg.el new file mode 100644 index 00000000..dc803bb7 --- /dev/null +++ b/elpa/elfeed-20191227.426/elfeed-pkg.el @@ -0,0 +1,5 @@ +(define-package "elfeed" "20191227.426" "an Emacs Atom/RSS feed reader" + '((emacs "24.3"))) +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/elpa/elfeed-20191227.426/elfeed-search.el b/elpa/elfeed-20191227.426/elfeed-search.el new file mode 100644 index 00000000..a439e5c5 --- /dev/null +++ b/elpa/elfeed-20191227.426/elfeed-search.el @@ -0,0 +1,967 @@ +;;; elfeed-search.el --- list feed entries -*- lexical-binding: t; -*- + +;; This is free and unencumbered software released into the public domain. + +;;; Code: + +(require 'cl-lib) +(require 'browse-url) +(require 'wid-edit) ; widget-inactive face +(require 'bookmark) +(bookmark-maybe-load-default-file) + +(require 'elfeed) +(require 'elfeed-db) +(require 'elfeed-lib) + +;; Interface to elfeed-show (lazy required) +(declare-function elfeed-show-entry 'elfeed-show (entry)) + +(defvar elfeed-search-entries () + "List of the entries currently on display.") + +(defvar elfeed-search-filter-history nil + "Filter history for `completing-read'.") + +(defvar elfeed-search-last-update 0 + "The last time the buffer was redrawn in epoch seconds.") + +(defvar elfeed-search-update-hook () + "List of functions to run immediately following a search buffer update.") + +(defcustom elfeed-search-filter "@6-months-ago +unread" + "Query string filtering shown entries." + :group 'elfeed + :type 'string) + +(defcustom elfeed-sort-order 'descending + "The order in which entries should be displayed. + +Changing this from the default will lead to misleading results +during live filter editing, but the results be will correct when +live filter editing is exited. " + :group 'elfeed + :type '(choice (const descending) (const ascending))) + +(defcustom elfeed-search-sort-function nil + "Sort predicate applied to the list of entries before display. + +This function must take two entries as arguments, an interface +suitable as the predicate for `sort'. + +Changing this from the default will lead to misleading results +during live filter editing, but the results be will correct when +live filter editing is exited." + :group 'elfeed + :type '(choice function (const nil))) + +(defcustom elfeed-search-remain-on-entry nil + "When non-nil, keep point at entry after performing a command. + +When nil, move to next entry." + :group 'elfeed + :type 'boolean) + +(defcustom elfeed-search-clipboard-type 'PRIMARY + "Selects the clipboard `elfeed-search-yank' should use. +Choices are the symbols PRIMARY, SECONDARY, or CLIPBOARD." + :group 'elfeed + :type '(choice (const PRIMARY) (const SECONDARY) (const CLIPBOARD))) + +(defcustom elfeed-search-date-format '("%Y-%m-%d" 10 :left) + "The `format-time-string' format, target width, and alignment for dates. + +This should be (string integer keyword) for (format width alignment). +Possible alignments are :left and :right." + :group 'elfeed + :type '(list string integer (choice (const :left) (const :right)))) + +(defcustom elfeed-search-compile-filter t + "If non-nil, compile search filters into bytecode on the fly." + :group 'elfeed + :type 'boolean) + +(defvar elfeed-search-filter-active nil + "When non-nil, Elfeed is currently reading a filter from the minibuffer. +When live editing the filter, it is bound to :live.") + +(defvar elfeed-search-filter-overflowing nil + "When non-nil, the current live filter overflows the window.") + +(defvar elfeed-search--offset 1 + "Offset between line numbers and entry list position.") + +(defvar elfeed-search-header-function #'elfeed-search--header + "Function that returns the string to be used for the Elfeed search header.") + +(defvar elfeed-search-print-entry-function #'elfeed-search-print-entry--default + "Function to print entries into the *elfeed-search* buffer.") + +(defalias 'elfeed-search-tag-all-unread + (elfeed-expose #'elfeed-search-tag-all 'unread) + "Add the `unread' tag to all selected entries.") + +(defalias 'elfeed-search-untag-all-unread + (elfeed-expose #'elfeed-search-untag-all 'unread) + "Remove the `unread' tag from all selected entries.") + +(defalias 'elfeed-search-update--force + (elfeed-expose #'elfeed-search-update :force) + "Force refresh view of the feed listing.") + +(defun elfeed-search-quit-window () + "Save the database, then `quit-window'." + (interactive) + (elfeed-db-save) + (quit-window)) + +(defun elfeed-search-last-entry () + "Place point on first entry." + (interactive) + (setf (point) (point-max)) + (forward-line -2)) + +(defun elfeed-search-first-entry () + "Place point on last entry." + (interactive) + (setf (point) (point-min))) + +(defvar elfeed-search-mode-map + (let ((map (make-sparse-keymap))) + (prog1 map + (suppress-keymap map) + (define-key map "h" #'describe-mode) + (define-key map "q" #'elfeed-search-quit-window) + (define-key map "g" #'elfeed-search-update--force) + (define-key map "G" #'elfeed-search-fetch) + (define-key map (kbd "RET") #'elfeed-search-show-entry) + (define-key map "s" #'elfeed-search-live-filter) + (define-key map "S" #'elfeed-search-set-filter) + (define-key map "c" #'elfeed-search-clear-filter) + (define-key map "b" #'elfeed-search-browse-url) + (define-key map "y" #'elfeed-search-yank) + (define-key map "u" #'elfeed-search-tag-all-unread) + (define-key map "r" #'elfeed-search-untag-all-unread) + (define-key map "n" #'next-line) + (define-key map "p" #'previous-line) + (define-key map "+" #'elfeed-search-tag-all) + (define-key map "-" #'elfeed-search-untag-all) + (define-key map "<" #'elfeed-search-first-entry) + (define-key map ">" #'elfeed-search-last-entry))) + "Keymap for elfeed-search-mode.") + +(defun elfeed-search--intro-header () + "Return the header shown to new users." + (with-temp-buffer + (cl-flet ((button (f) + (insert-button (symbol-name f) + 'follow-link t + 'action (lambda (_) (call-interactively f))))) + (insert "Database empty. Use ") + (button 'elfeed-add-feed) + (insert ", or ") + (button 'elfeed-load-opml) + (insert ", or ") + (button 'elfeed-update) + (insert ".") + (buffer-string)))) + +(defun elfeed-search--count-unread () + "Count the number of entries and feeds being currently displayed." + (if (and elfeed-search-filter-active elfeed-search-filter-overflowing) + "?/?:?" + (cl-loop with feeds = (make-hash-table :test 'equal) + for entry in elfeed-search-entries + for feed = (elfeed-entry-feed entry) + for url = (elfeed-feed-url feed) + count entry into entry-count + count (elfeed-tagged-p 'unread entry) into unread-count + do (puthash url t feeds) + finally + (cl-return + (format "%d/%d:%d" + unread-count entry-count + (hash-table-count feeds)))))) + +(defvar elfeed-search--header-cache nil + "Cache of the last computed header.") + +(defun elfeed-search--header () + "Returns the string to be used as the Elfeed header." + (if (eql (car elfeed-search--header-cache) (buffer-modified-tick)) + (cdr elfeed-search--header-cache) + (let* ((header (elfeed-search--header-1)) + (cache (cons (buffer-modified-tick) header))) + (prog1 header + (setf elfeed-search--header-cache cache))))) + +(defun elfeed-search--header-1 () + "Computes the string to be used as the Elfeed header." + (cond + ((zerop (elfeed-db-last-update)) + (elfeed-search--intro-header)) + ((> (elfeed-queue-count-total) 0) + (let ((total (elfeed-queue-count-total)) + (in-process (elfeed-queue-count-active))) + (format "%d jobs pending, %d active..." + (- total in-process) in-process))) + ((let* ((db-time (seconds-to-time (elfeed-db-last-update))) + (update (format-time-string "%Y-%m-%d %H:%M" db-time)) + (unread (elfeed-search--count-unread))) + (format "Updated %s, %s%s" + (propertize update 'face 'elfeed-search-last-update-face) + (propertize unread 'face 'elfeed-search-unread-count-face) + (cond + (elfeed-search-filter-active "") + ((string-match-p "[^ ]" elfeed-search-filter) + (concat ", " (propertize elfeed-search-filter + 'face 'elfeed-search-filter-face))) + (""))))))) + +(defun elfeed-search-mode () + "Major mode for listing elfeed feed entries. +\\{elfeed-search-mode-map}" + (interactive) + (kill-all-local-variables) + (use-local-map elfeed-search-mode-map) + (setq major-mode 'elfeed-search-mode + mode-name "elfeed-search" + truncate-lines t + buffer-read-only t + desktop-save-buffer #'elfeed-search-desktop-save + header-line-format '(:eval (funcall elfeed-search-header-function))) + (set (make-local-variable 'bookmark-make-record-function) + #'elfeed-search-bookmark-make-record) + (buffer-disable-undo) + (hl-line-mode) + (make-local-variable 'elfeed-search-entries) + (make-local-variable 'elfeed-search-filter) + (add-hook 'elfeed-update-hooks #'elfeed-search-update) + (add-hook 'elfeed-update-init-hooks #'elfeed-search-update--force) + (add-hook 'kill-buffer-hook #'elfeed-db-save t t) + (add-hook 'elfeed-db-unload-hook #'elfeed-search--unload) + (elfeed-search-update :force) + (run-mode-hooks 'elfeed-search-mode-hook)) + +(defun elfeed-search-buffer () + (get-buffer-create "*elfeed-search*")) + +(defun elfeed-search--unload () + "Hook function for `elfeed-db-unload-hook'." + (with-current-buffer (elfeed-search-buffer) + ;; don't try to save the database in this case + (remove-hook 'kill-buffer-hook #'elfeed-db-save t) + (kill-buffer ))) + +(defun elfeed-search-format-date (date) + "Format a date for printing in `elfeed-search-mode'. +The customization `elfeed-search-date-format' sets the formatting." + (cl-destructuring-bind (format target alignment) elfeed-search-date-format + (let* ((string (format-time-string format (seconds-to-time date))) + (width (string-width string))) + (cond + ((> width target) + (if (eq alignment :left) + (substring string 0 target) + (substring string (- width target) width))) + ((< width target) + (let ((pad (make-string (- target width) ?\s))) + (if (eq alignment :left) + (concat string pad) + (concat pad string)))) + (string))))) + +(defface elfeed-search-date-face + '((((class color) (background light)) (:foreground "#aaa")) + (((class color) (background dark)) (:foreground "#77a"))) + "Face used in search mode for dates." + :group 'elfeed) + +(defface elfeed-search-title-face + '((((class color) (background light)) (:foreground "#000")) + (((class color) (background dark)) (:foreground "#fff"))) + "Face used in search mode for titles." + :group 'elfeed) + +(defface elfeed-search-unread-title-face + '((t :weight bold)) + "Face used in search mode for unread entry titles." + :group 'elfeed) + +(defface elfeed-search-feed-face + '((((class color) (background light)) (:foreground "#aa0")) + (((class color) (background dark)) (:foreground "#ff0"))) + "Face used in search mode for feed titles." + :group 'elfeed) + +(defface elfeed-search-tag-face + '((((class color) (background light)) (:foreground "#070")) + (((class color) (background dark)) (:foreground "#0f0"))) + "Face used in search mode for tags." + :group 'elfeed) + +(defface elfeed-search-last-update-face + '((t)) + "Face for showing the date and time the database was last updated." + :group 'elfeed) + +(defface elfeed-search-unread-count-face + '((((class color) (background light)) (:foreground "#000")) + (((class color) (background dark)) (:foreground "#fff"))) + "Face used in search mode for unread entry titles." + :group 'elfeed) + +(defface elfeed-search-filter-face + '((t :inherit mode-line-buffer-id)) + "Face for showing the current Elfeed search filter." + :group 'elfeed) + +(defcustom elfeed-search-title-max-width 70 + "Maximum column width for titles in the elfeed-search buffer." + :group 'elfeed + :type 'integer) + +(defcustom elfeed-search-title-min-width 16 + "Minimum column width for titles in the elfeed-search buffer." + :group 'elfeed + :type 'integer) + +(defcustom elfeed-search-trailing-width 30 + "Space reserved for displaying the feed and tag information." + :group 'elfeed + :type 'integer) + +(defcustom elfeed-search-face-alist + '((unread elfeed-search-unread-title-face)) + "Mapping of tags to faces in the Elfeed entry listing." + :group 'elfeed + :type '(alist :key-type symbol :value-type (repeat face))) + +(defun elfeed-search--faces (tags) + "Return all the faces that apply to an entry with TAGS." + (nconc (cl-loop for (tag . faces) in elfeed-search-face-alist + when (memq tag tags) + append faces) + (list 'elfeed-search-title-face))) + +(defun elfeed-search-print-entry--default (entry) + "Print ENTRY to the buffer." + (let* ((date (elfeed-search-format-date (elfeed-entry-date entry))) + (title (or (elfeed-meta entry :title) (elfeed-entry-title entry) "")) + (title-faces (elfeed-search--faces (elfeed-entry-tags entry))) + (feed (elfeed-entry-feed entry)) + (feed-title + (when feed + (or (elfeed-meta feed :title) (elfeed-feed-title feed)))) + (tags (mapcar #'symbol-name (elfeed-entry-tags entry))) + (tags-str (mapconcat + (lambda (s) (propertize s 'face 'elfeed-search-tag-face)) + tags ",")) + (title-width (- (window-width) 10 elfeed-search-trailing-width)) + (title-column (elfeed-format-column + title (elfeed-clamp + elfeed-search-title-min-width + title-width + elfeed-search-title-max-width) + :left))) + (insert (propertize date 'face 'elfeed-search-date-face) " ") + (insert (propertize title-column 'face title-faces 'kbd-help title) " ") + (when feed-title + (insert (propertize feed-title 'face 'elfeed-search-feed-face) " ")) + (when tags + (insert "(" tags-str ")")))) + +(defun elfeed-search-parse-filter (filter) + "Parse the elements of a search filter into a plist." + (let ((must-have ()) + (must-not-have ()) + (before nil) + (after nil) + (matches ()) + (not-matches ()) + (limit nil) + (feeds ()) + (not-feeds ())) + (cl-loop for element in (split-string filter) + for type = (aref element 0) + do (cl-case type + (?+ + (let ((symbol (intern (substring element 1)))) + (unless (eq '## symbol) + (push symbol must-have)))) + (?- + (let ((symbol (intern (substring element 1)))) + (unless (eq '## symbol) + (push symbol must-not-have)))) + (?@ (cl-multiple-value-bind (a b) + (split-string (substring element 1) "--") + (let ((duration-a (elfeed-time-duration a)) + (duration-b (and b (elfeed-time-duration b)))) + (when (and duration-b (> duration-b duration-a)) + (cl-rotatef duration-a duration-b)) + (when duration-b (setf before duration-b)) + (setf after duration-a)))) + (?! (let ((re (substring element 1))) + (when (elfeed-valid-regexp-p re) + (push re not-matches)))) + (?# (setf limit (string-to-number (substring element 1)))) + (?= (let ((re (substring element 1))) + (when (elfeed-valid-regexp-p re) + (push re feeds)))) + (?~ (let ((re (substring element 1))) + (when (elfeed-valid-regexp-p re) + (push re not-feeds)))) + (otherwise (when (elfeed-valid-regexp-p element) + (push element matches))))) + `(,@(when before + (list :before before)) + ,@(when after + (list :after after)) + ,@(when must-have + (list :must-have must-have)) + ,@(when must-not-have + (list :must-not-have must-not-have)) + ,@(when matches + (list :matches matches)) + ,@(when not-matches + (list :not-matches not-matches)) + ,@(when limit + (list :limit limit)) + ,@(when feeds + (list :feeds feeds)) + ,@(when not-feeds + (list :not-feeds not-feeds))))) + +(defun elfeed-search--recover-time (seconds) + "Pick a reasonable filter representation for SECONDS." + (let ((units '((60 1 "minute") + (60 1 "hour") + (24 1 "day") + (7 1 "week") + (30 7 "month") + (1461 120 "year"))) + (value (float seconds)) + (name "second")) + (cl-loop for (n d unit) in units + for next-value = (/ (* value d) n) + when (< next-value 1.0) + return t + do (setf name unit + value next-value)) + (let ((count (format "%.4g" value))) + (format "%s-%s%s-ago" count name (if (equal count "1") "" "s"))))) + +(defun elfeed-search--recover-units (after-seconds &optional before-seconds) + "Stringify the age or optionally the date range specified by +AFTER-SECONDS and BEFORE-SECONDS." + (apply 'concat "@" + (elfeed-search--recover-time after-seconds) + (when before-seconds + (list "--"(elfeed-search--recover-time before-seconds))))) + +(defun elfeed-search-unparse-filter (filter) + "Inverse of `elfeed-search-parse-filter', returning a string. + +The time (@n-units-ago) filter may not exactly match the +original, but will be equal in its effect." + (let ((output ())) + (let ((after (plist-get filter :after)) + (before (plist-get filter :before)) + (must-have (plist-get filter :must-have)) + (must-not-have (plist-get filter :must-not-have)) + (matches (plist-get filter :matches)) + (not-matches (plist-get filter :not-matches)) + (limit (plist-get filter :limit)) + (feeds (plist-get filter :feeds)) + (not-feeds (plist-get filter :not-feeds))) + (when after + (push (elfeed-search--recover-units after before) output)) + (dolist (tag must-have) + (push (format "+%S" tag) output)) + (dolist (tag must-not-have) + (push (format "-%S" tag) output)) + (dolist (re matches) + (push re output)) + (dolist (re not-matches) + (push (concat "!" re) output)) + (when limit + (push (format "#%d" limit) output)) + (dolist (feed feeds) + (push (format "=%s" feed) output)) + (dolist (feed not-feeds) + (push (format "~%s" feed) output)) + (mapconcat #'identity (nreverse output) " ")))) + +(defun elfeed-search-filter (filter entry feed &optional count) + "Return non-nil if ENTRY and FEED pass FILTER. + +COUNT is the total number of entries collected so far, for +filtering against a limit filter (ex. #10). + +See `elfeed-search-set-filter' for format/syntax documentation. +This function must *only* be called within the body of +`with-elfeed-db-visit' because it may perform a non-local exit." + (let ((after (plist-get filter :after)) + (must-have (plist-get filter :must-have)) + (must-not-have (plist-get filter :must-not-have)) + (matches (plist-get filter :matches)) + (not-matches (plist-get filter :not-matches)) + (limit (plist-get filter :limit)) + (feeds (plist-get filter :feeds)) + (not-feeds (plist-get filter :not-feeds))) + (let* ((tags (elfeed-entry-tags entry)) + (date (elfeed-entry-date entry)) + (age (- (float-time) date)) + (title (or (elfeed-meta entry :title) (elfeed-entry-title entry))) + (link (elfeed-entry-link entry)) + (feed-title + (or (elfeed-meta feed :title) (elfeed-feed-title feed) "")) + (feed-id (elfeed-feed-id feed))) + (when (or (and after (> age after)) + (and limit (<= limit 0)) + (and limit count (>= count limit))) + (elfeed-db-return)) + (and (cl-every (lambda (tag) (memq tag tags)) must-have) + (cl-notany (lambda (tag) (memq tag tags)) must-not-have) + (or (null matches) + (cl-every + (lambda (m) + (or (and title (string-match-p m title)) + (and link (string-match-p m link)))) + matches)) + (cl-notany (lambda (m) + (or (and title (string-match-p m title)) + (and link (string-match-p m link)))) + not-matches) + (or (null feeds) + (cl-some (lambda (f) + (or (string-match-p f feed-id) + (string-match-p f feed-title))) + feeds)) + (cl-notany (lambda (f) + (or (string-match-p f feed-id) + (string-match-p f feed-title))) + not-feeds))))) + +(defun elfeed-search-compile-filter (filter) + "Compile FILTER into a lambda function for `byte-compile'. + +Executing a filter in bytecode form is generally faster than +\"interpreting\" the filter with `elfeed-search-filter'." + (let ((after (plist-get filter :after)) + (before (plist-get filter :before)) + (must-have (plist-get filter :must-have)) + (must-not-have (plist-get filter :must-not-have)) + (matches (plist-get filter :matches)) + (not-matches (plist-get filter :not-matches)) + (limit (plist-get filter :limit)) + (feeds (plist-get filter :feeds)) + (not-feeds (plist-get filter :not-feeds))) + `(lambda (,(if (or after matches not-matches must-have must-not-have) + 'entry + '_entry) + ,(if (or feeds not-feeds) + 'feed + '_feed) + ,(if limit + 'count + '_count)) + (let* (,@(when after + '((date (elfeed-entry-date entry)) + (age (- (float-time) date)))) + ,@(when (or must-have must-not-have) + '((tags (elfeed-entry-tags entry)))) + ,@(when (or matches not-matches) + '((title (or (elfeed-meta entry :title) + (elfeed-entry-title entry))) + (link (elfeed-entry-link entry)))) + ,@(when (or feeds not-feeds) + '((feed-id (elfeed-feed-id feed)) + (feed-title (or (elfeed-meta feed :title) + (elfeed-feed-title feed) ""))))) + ,@(when after + `((when (> age ,after) + (elfeed-db-return)))) + ,@(when limit + `((when (>= count ,limit) + (elfeed-db-return)))) + (and ,@(cl-loop for forbid in must-not-have + collect `(not (memq ',forbid tags))) + ,@(cl-loop for forbid in must-have + collect `(memq ',forbid tags)) + ,@(cl-loop for regex in matches collect + `(or (string-match-p ,regex title) + (string-match-p ,regex link))) + ,@(cl-loop for regex in not-matches collect + `(not + (or (string-match-p ,regex title) + (string-match-p ,regex link)))) + ,@(when feeds + `((or ,@(cl-loop + for regex in feeds + collect `(string-match-p ,regex feed-id) + collect `(string-match-p ,regex feed-title))))) + ,@(when not-feeds + `((not + (or ,@(cl-loop + for regex in not-feeds + collect `(string-match-p ,regex feed-id) + collect `(string-match-p ,regex feed-title)))))) + ,@(when before + `((> age ,before)))))))) + +(defun elfeed-search--prompt (current) + "Prompt for a new filter, starting with CURRENT." + (read-from-minibuffer + "Filter: " + (if (or (string= "" current) + (string-match-p " $" current)) + current + (concat current " ")) + nil nil 'elfeed-search-filter-history)) + +(defun elfeed-search-clear-filter () + "Reset the search filter to the default value of `elfeed-search-filter'." + (interactive) + (setf elfeed-search-filter (default-value 'elfeed-search-filter)) + (elfeed-search-update--force)) + +(defun elfeed-search-set-filter (new-filter) + "Set a new search filter for the elfeed-search buffer. + +When NEW-FILTER is nil, reset the filter to the default value. + +When given a prefix argument, the current filter is not displayed +in the minibuffer when prompting for a new filter. + +Any component beginning with a + or - is treated as a tag. If + +the tag must be present on the entry. If - the tag must *not* be +present on the entry. Ex. \"+unread\" or \"+unread -comic\". + +Any component beginning with an @ is an age limit or an age +range. If a limit, no posts older than this are allowed. If a +range, posts dates have to be inbetween the specified date +range. Examples: +- \"@3-days-ago\" +- \"@1-year-old\" +- \"@2019-06-24\" +- \"@2019-06-24--2019-06-24\" +- \"@5-days-ago--1-day-ago\" + +Any component beginning with a # is an entry count maximum. The +number following # determines the maxiumum number of entries +to be shown (descending by date). Ex. \"#20\" or \"#100\". + +Any component beginning with a = is a regular expression matching +the entry's feed (title or URL). Only entries belonging to a feed +that match at least one of the = expressions will be shown. + +Every other space-seperated element is treated like a regular +expression, matching against entry link, title, and feed title." + (interactive + (let ((elfeed-search-filter-active :non-interactive)) + (list (elfeed-search--prompt + (if current-prefix-arg "" elfeed-search-filter))))) + (with-current-buffer (elfeed-search-buffer) + (setf elfeed-search-filter + (or new-filter (default-value 'elfeed-search-filter))) + (elfeed-search-update :force))) + +(defun elfeed-search--update-list () + "Update `elfeed-search-filter' list." + (let* ((filter (elfeed-search-parse-filter elfeed-search-filter)) + (head (list nil)) + (tail head) + (count 0)) + (if elfeed-search-compile-filter + ;; Force lexical bindings regardless of the current + ;; buffer-local value. Lexical scope uses the faster + ;; stack-ref opcode instead of the traditional varref opcode. + (let ((lexical-binding t) + (func (byte-compile (elfeed-search-compile-filter filter)))) + (with-elfeed-db-visit (entry feed) + (when (funcall func entry feed count) + (setf (cdr tail) (list entry) + tail (cdr tail) + count (1+ count))))) + (with-elfeed-db-visit (entry feed) + (when (elfeed-search-filter filter entry feed count) + (setf (cdr tail) (list entry) + tail (cdr tail) + count (1+ count))))) + ;; Determine the final list order + (let ((entries (cdr head))) + (when elfeed-search-sort-function + (setf entries (sort entries elfeed-search-sort-function))) + (when (eq elfeed-sort-order 'ascending) + (setf entries (nreverse entries))) + (setf elfeed-search-entries + entries)))) + +(defmacro elfeed-save-excursion (&rest body) + "Like `save-excursion', but by entry/line/column instead of point." + (declare (indent defun)) + `(let ((entry (elfeed-search-selected :single)) + (line (line-number-at-pos)) + (column (current-column))) + (unwind-protect + (progn ,@body) + (let ((entry-position (cl-position entry elfeed-search-entries))) + (elfeed-goto-line (if entry-position + (+ elfeed-search--offset entry-position) + line)) + (move-to-column column))))) + +(defun elfeed-search-update (&optional force) + "Update the elfeed-search buffer listing to match the database. +When FORCE is non-nil, redraw even when the database hasn't changed." + (interactive) + (with-current-buffer (elfeed-search-buffer) + (when (or force (and (not elfeed-search-filter-active) + (< elfeed-search-last-update (elfeed-db-last-update)))) + (elfeed-save-excursion + (let ((inhibit-read-only t) + (standard-output (current-buffer))) + (erase-buffer) + (elfeed-search--update-list) + (dolist (entry elfeed-search-entries) + (funcall elfeed-search-print-entry-function entry) + (insert "\n")) + (insert "End of entries.\n") + (setf elfeed-search-last-update (float-time)))) + (run-hooks 'elfeed-search-update-hook)))) + +(defun elfeed-search-fetch (prefix) + "Update all feeds via `elfeed-update', or only visible feeds with PREFIX. +Given a prefix, this function becomes `elfeed-search-fetch-visible'." + (interactive "P") + (if prefix + (elfeed-search-fetch-visible) + (elfeed-update))) + +(defun elfeed-search-fetch-visible () + "Update any feed with an entry currently displayed in the search buffer." + (interactive) + (cl-loop with seen = (make-hash-table :test 'equal) + for entry in elfeed-search-entries + for feed = (elfeed-entry-feed entry) + for url = (elfeed-feed-url feed) + when (not (gethash url seen)) + do (elfeed-update-feed (setf (gethash url seen) url)))) + +(defun elfeed-search-update-line (&optional n) + "Redraw the current line." + (let ((inhibit-read-only t)) + (save-excursion + (when n (elfeed-goto-line n)) + (let ((entry (elfeed-search-selected :ignore-region))) + (when entry + (elfeed-kill-line) + (funcall elfeed-search-print-entry-function entry)))))) + +(defun elfeed-search-update-entry (entry) + "Redraw a specific entry." + (let ((n (cl-position entry elfeed-search-entries))) + (when n (elfeed-search-update-line (+ elfeed-search--offset n))))) + +(defun elfeed-search-selected (&optional ignore-region-p) + "Return a list of the currently selected feeds. + +If IGNORE-REGION-P is non-nil, only return the entry under point." + (let ((use-region (and (not ignore-region-p) (use-region-p)))) + (let ((start (if use-region (region-beginning) (point))) + (end (if use-region (region-end) (point)))) + (cl-loop for line from (line-number-at-pos start) + to (line-number-at-pos end) + for offset = (- line elfeed-search--offset) + when (and (>= offset 0) (nth offset elfeed-search-entries)) + collect it into selected + finally (return (if ignore-region-p + (car selected) + selected)))))) + +(defun elfeed-search-browse-url (&optional use-generic-p) + "Visit the current entry in your browser using `browse-url'. +If there is a prefix argument, visit the current entry in the +browser defined by `browse-url-generic-program'." + (interactive "P") + (let ((entries (elfeed-search-selected))) + (cl-loop for entry in entries + do (elfeed-untag entry 'unread) + when (elfeed-entry-link entry) + do (if use-generic-p + (browse-url-generic it) + (browse-url it))) + (mapc #'elfeed-search-update-entry entries) + (unless (or elfeed-search-remain-on-entry (use-region-p)) + (forward-line)))) + +(defun elfeed-search-yank () + "Copy the selected feed items to clipboard and kill-ring." + (interactive) + (let* ((entries (elfeed-search-selected)) + (links (mapcar #'elfeed-entry-link entries)) + (links-str (mapconcat #'identity links " "))) + (when entries + (elfeed-untag entries 'unread) + (kill-new links-str) + (if (fboundp 'gui-set-selection) + (gui-set-selection elfeed-search-clipboard-type links-str) + (with-no-warnings + (x-set-selection elfeed-search-clipboard-type links-str))) + (message "Copied: %s" links-str) + (mapc #'elfeed-search-update-entry entries) + (unless (or elfeed-search-remain-on-entry (use-region-p)) + (forward-line))))) + +(defun elfeed-search-tag-all (tag) + "Apply TAG to all selected entries." + (interactive (list (intern (read-from-minibuffer "Tag: ")))) + (let ((entries (elfeed-search-selected))) + (elfeed-tag entries tag) + (mapc #'elfeed-search-update-entry entries) + (unless (or elfeed-search-remain-on-entry (use-region-p)) + (forward-line)))) + +(defun elfeed-search-untag-all (tag) + "Remove TAG from all selected entries." + (interactive (list (intern (read-from-minibuffer "Tag: ")))) + (let ((entries (elfeed-search-selected))) + (elfeed-untag entries tag) + (mapc #'elfeed-search-update-entry entries) + (unless (or elfeed-search-remain-on-entry (use-region-p)) + (forward-line)))) + +(defun elfeed-search-toggle-all (tag) + "Toggle TAG on all selected entries." + (interactive (list (intern (read-from-minibuffer "Tag: ")))) + (let ((entries (elfeed-search-selected)) entries-tag entries-untag) + (cl-loop for entry in entries + when (elfeed-tagged-p tag entry) + do (push entry entries-untag) + else do (push entry entries-tag)) + (elfeed-tag entries-tag tag) + (elfeed-untag entries-untag tag) + (mapc #'elfeed-search-update-entry entries) + (unless (or elfeed-search-remain-on-entry (use-region-p)) + (forward-line)))) + +(defun elfeed-search-show-entry (entry) + "Display the currently selected item in a buffer." + (interactive (list (elfeed-search-selected :ignore-region))) + (require 'elfeed-show) + (when (elfeed-entry-p entry) + (elfeed-untag entry 'unread) + (elfeed-search-update-entry entry) + (unless elfeed-search-remain-on-entry (forward-line)) + (elfeed-show-entry entry))) + +(defun elfeed-search-set-entry-title (title) + "Manually set the title for the entry under point. +Sets the :title key of the entry's metadata. See `elfeed-meta'." + (interactive "sTitle: ") + (let ((entry (elfeed-search-selected :ignore-region))) + (unless entry + (error "No entry selected!")) + (setf (elfeed-meta entry :title) title) + (elfeed-search-update-entry entry))) + +(defun elfeed-search-set-feed-title (title) + "Manually set the title for the feed belonging to the entry under point. +Sets the :title key of the feed's metadata. See `elfeed-meta'." + (interactive "sTitle: ") + (let ((entry (elfeed-search-selected :ignore-region))) + (unless entry + (error "No entry selected!")) + (let ((feed (elfeed-entry-feed entry))) + (setf (elfeed-meta feed :title) title) + (dolist (to-fix elfeed-search-entries) + (elfeed-search-update-entry to-fix))))) + +;; Live Filters + +(defvar elfeed-search-filter-syntax-table + (let ((table (make-syntax-table))) + (prog1 table + (modify-syntax-entry ?+ "w" table) + (modify-syntax-entry ?- "w" table) + (modify-syntax-entry ?= "w" table) + (modify-syntax-entry ?@ "w" table))) + "Syntax table active when editing the filter in the minibuffer.") + +(defun elfeed-search--minibuffer-setup () + "Set up the minibuffer for live filtering." + (when elfeed-search-filter-active + (set-syntax-table elfeed-search-filter-syntax-table) + (when (eq :live elfeed-search-filter-active) + (add-hook 'post-command-hook 'elfeed-search--live-update nil :local)))) + +(add-hook 'minibuffer-setup-hook 'elfeed-search--minibuffer-setup) + +(defun elfeed-search--live-update () + "Update the elfeed-search buffer based on the contents of the minibuffer." + (when (eq :live elfeed-search-filter-active) + (let ((buffer (elfeed-search-buffer)) + (current-filter (minibuffer-contents-no-properties))) + (when buffer + (with-current-buffer buffer + (let* ((window (get-buffer-window (elfeed-search-buffer))) + (height (window-total-height window)) + (limiter (if window + (format "#%d " height) + "#1 ")) + (elfeed-search-filter (concat limiter current-filter))) + (elfeed-search-update :force) + (setf elfeed-search-filter-overflowing + (= (length elfeed-search-entries) + height)))))))) + +(defun elfeed-search-live-filter () + "Filter the elfeed-search buffer as the filter is written." + (interactive) + (unwind-protect + (let ((elfeed-search-filter-active :live)) + (setq elfeed-search-filter + (read-from-minibuffer "Filter: " elfeed-search-filter))) + (elfeed-search-update :force))) + +;; Bookmarks + +;;;###autoload +(defun elfeed-search-bookmark-handler (record) + "Jump to an elfeed-search bookmarked location." + (elfeed) + (elfeed-search-set-filter (bookmark-prop-get record 'location))) + +(defun elfeed-search-bookmark-make-record () + "Return a bookmark record for the current elfeed-search buffer." + (let* ((filter (elfeed-search-parse-filter elfeed-search-filter)) + (tags (plist-get filter :must-have))) + `(,(format "elfeed %s" elfeed-search-filter) + (location . ,elfeed-search-filter) + (tags ,@(mapcar #'symbol-name tags)) + (handler . elfeed-search-bookmark-handler)))) + +;; Desktop Save + +(defun elfeed-search-desktop-save (_desktop-dirname) + "Save the state of the current elfeed-search buffer so that it + may be restored as part of a saved desktop. Also save the state + of the db for when `desktop-auto-save-timeout' is enabled." + (elfeed-db-save) + elfeed-search-filter) + +;;;###autoload +(defun elfeed-search-desktop-restore (_file-name _buffer-name search-filter) + "Restore the state of an elfeed-search buffer on desktop restore." + (elfeed) + (elfeed-search-set-filter search-filter) + (current-buffer)) + +;;;###autoload +(add-to-list 'desktop-buffer-mode-handlers + '(elfeed-search-mode . elfeed-search-desktop-restore)) + +(provide 'elfeed-search) + +;;; elfeed-search.el ends here diff --git a/elpa/elfeed-20191227.426/elfeed-show.el b/elpa/elfeed-20191227.426/elfeed-show.el new file mode 100644 index 00000000..033ade0b --- /dev/null +++ b/elpa/elfeed-20191227.426/elfeed-show.el @@ -0,0 +1,468 @@ +;;; elfeed-show.el --- display feed entries -*- lexical-binding: t; -*- + +;; This is free and unencumbered software released into the public domain. + +;;; Code: + +(require 'cl-lib) +(require 'shr) +(require 'url-parse) +(require 'browse-url) +(require 'message) ; faces + +(require 'elfeed) +(require 'elfeed-db) +(require 'elfeed-lib) +(require 'elfeed-search) + +(defcustom elfeed-show-truncate-long-urls t + "When non-nil, use an ellipsis to shorten very long displayed URLs." + :group 'elfeed + :type 'boolean) + +(defcustom elfeed-show-entry-author t + "When non-nil, show the entry's author (if it's in the entry's metadata)." + :group 'elfeed + :type 'boolean) + +(defvar elfeed-show-entry nil + "The entry being displayed in this buffer.") + +(defvar elfeed-show-entry-switch #'switch-to-buffer + "Function to call to display and switch to the feed entry buffer. +Defaults to `switch-to-buffer'.") + +(defvar elfeed-show-entry-delete #'elfeed-kill-buffer + "Function called when quitting from the elfeed-entry +buffer. Does not take any arguments. + +Defaults to `elfeed-kill-buffer'.") + +(defvar elfeed-show-refresh-function #'elfeed-show-refresh--mail-style + "Function called to refresh the `*elfeed-entry*' buffer.") + +(defvar elfeed-show-mode-map + (let ((map (make-sparse-keymap))) + (prog1 map + (suppress-keymap map) + (define-key map "h" #'describe-mode) + (define-key map "d" #'elfeed-show-save-enclosure) + (define-key map "q" #'elfeed-kill-buffer) + (define-key map "g" #'elfeed-show-refresh) + (define-key map "n" #'elfeed-show-next) + (define-key map "p" #'elfeed-show-prev) + (define-key map "s" #'elfeed-show-new-live-search) + (define-key map "b" #'elfeed-show-visit) + (define-key map "y" #'elfeed-show-yank) + (define-key map "u" #'elfeed-show-tag--unread) + (define-key map "+" #'elfeed-show-tag) + (define-key map "-" #'elfeed-show-untag) + (define-key map "<" #'beginning-of-buffer) + (define-key map ">" #'end-of-buffer) + (define-key map (kbd "SPC") #'scroll-up-command) + (define-key map (kbd "DEL") #'scroll-down-command) + (define-key map (kbd "TAB") #'elfeed-show-next-link) + (define-key map "\e\t" #'shr-previous-link) + (define-key map [backtab] #'shr-previous-link) + (define-key map "c" #'elfeed-kill-link-url-at-point) + (define-key map [mouse-2] #'shr-browse-url) + (define-key map "A" #'elfeed-show-add-enclosure-to-playlist) + (define-key map "P" #'elfeed-show-play-enclosure))) + "Keymap for `elfeed-show-mode'.") + +(defun elfeed-show-mode () + "Mode for displaying Elfeed feed entries. +\\{elfeed-show-mode-map}" + (interactive) + (kill-all-local-variables) + (use-local-map elfeed-show-mode-map) + (setq major-mode 'elfeed-show-mode + mode-name "elfeed-show" + buffer-read-only t) + (buffer-disable-undo) + (make-local-variable 'elfeed-show-entry) + (run-mode-hooks 'elfeed-show-mode-hook)) + +(defalias 'elfeed-show-tag--unread + (elfeed-expose #'elfeed-show-tag 'unread) + "Mark the current entry unread.") + +(defun elfeed-insert-html (html &optional base-url) + "Converted HTML markup to a propertized string." + (shr-insert-document + (if (elfeed-libxml-supported-p) + (with-temp-buffer + ;; insert to work around libxml-parse-html-region bug + (when base-url + (insert (format "" base-url))) + (insert html) + (libxml-parse-html-region (point-min) (point-max) base-url)) + '(i () "Elfeed: libxml2 functionality is unavailable")))) + +(cl-defun elfeed-insert-link (url &optional (content url)) + "Insert a clickable hyperlink to URL titled CONTENT." + (when (and elfeed-show-truncate-long-urls + (integerp shr-width) + (> (length content) (- shr-width 8))) + (let ((len (- (/ shr-width 2) 10))) + (setq content (format "%s[...]%s" + (substring content 0 len) + (substring content (- len)))))) + (elfeed-insert-html (format "%s" url content))) + +(defun elfeed-compute-base (url) + "Return the base URL for URL, useful for relative paths." + (let ((obj (url-generic-parse-url url))) + (setf (url-filename obj) nil) + (setf (url-target obj) nil) + (url-recreate-url obj))) + +(defun elfeed--show-format-author (author) + "Format author plist for the header." + (let ((name (plist-get author :name)) + (uri (plist-get author :uri)) + (email (plist-get author :email))) + (cond ((and name uri email) + (format "%s <%s> (%s)" name email uri)) + ((and name email) + (format "%s <%s>" name email)) + ((and name uri) + (format "%s (%s)" name uri)) + (name name) + (email email) + (uri uri) + ("[unknown]")))) + +(defun elfeed-show-refresh--mail-style () + "Update the buffer to match the selected entry, using a mail-style." + (interactive) + (let* ((inhibit-read-only t) + (title (elfeed-entry-title elfeed-show-entry)) + (date (seconds-to-time (elfeed-entry-date elfeed-show-entry))) + (authors (elfeed-meta elfeed-show-entry :authors)) + (link (elfeed-entry-link elfeed-show-entry)) + (tags (elfeed-entry-tags elfeed-show-entry)) + (tagsstr (mapconcat #'symbol-name tags ", ")) + (nicedate (format-time-string "%a, %e %b %Y %T %Z" date)) + (content (elfeed-deref (elfeed-entry-content elfeed-show-entry))) + (type (elfeed-entry-content-type elfeed-show-entry)) + (feed (elfeed-entry-feed elfeed-show-entry)) + (feed-title (elfeed-feed-title feed)) + (base (and feed (elfeed-compute-base (elfeed-feed-url feed))))) + (erase-buffer) + (insert (format (propertize "Title: %s\n" 'face 'message-header-name) + (propertize title 'face 'message-header-subject))) + (when elfeed-show-entry-author + (dolist (author authors) + (let ((formatted (elfeed--show-format-author author))) + (insert + (format (propertize "Author: %s\n" 'face 'message-header-name) + (propertize formatted 'face 'message-header-to)))))) + (insert (format (propertize "Date: %s\n" 'face 'message-header-name) + (propertize nicedate 'face 'message-header-other))) + (insert (format (propertize "Feed: %s\n" 'face 'message-header-name) + (propertize feed-title 'face 'message-header-other))) + (when tags + (insert (format (propertize "Tags: %s\n" 'face 'message-header-name) + (propertize tagsstr 'face 'message-header-other)))) + (insert (propertize "Link: " 'face 'message-header-name)) + (elfeed-insert-link link link) + (insert "\n") + (cl-loop for enclosure in (elfeed-entry-enclosures elfeed-show-entry) + do (insert (propertize "Enclosure: " 'face 'message-header-name)) + do (elfeed-insert-link (car enclosure)) + do (insert "\n")) + (insert "\n") + (if content + (if (eq type 'html) + (elfeed-insert-html content base) + (insert content)) + (insert (propertize "(empty)\n" 'face 'italic))) + (goto-char (point-min)))) + +(defun elfeed-show-refresh () + "Update the buffer to match the selected entry." + (interactive) + (call-interactively elfeed-show-refresh-function)) + +(defcustom elfeed-show-unique-buffers nil + "When non-nil, every entry buffer gets a unique name. +This allows for displaying multiple show buffers at the same +time." + :group 'elfeed + :type 'boolean) + +(defun elfeed-show--buffer-name (entry) + "Return the appropriate buffer name for ENTRY. +The result depends on the value of `elfeed-show-unique-buffers'." + (if elfeed-show-unique-buffers + (format "*elfeed-entry-<%s %s>*" + (elfeed-entry-title entry) + (format-time-string "%F" (elfeed-entry-date entry))) + "*elfeed-entry*")) + +(defun elfeed-show-entry (entry) + "Display ENTRY in the current buffer." + (let ((buff (get-buffer-create (elfeed-show--buffer-name entry)))) + (with-current-buffer buff + (elfeed-show-mode) + (setq elfeed-show-entry entry) + (elfeed-show-refresh)) + (funcall elfeed-show-entry-switch buff))) + +(defun elfeed-show-next () + "Show the next item in the elfeed-search buffer." + (interactive) + (funcall elfeed-show-entry-delete) + (with-current-buffer (elfeed-search-buffer) + (call-interactively #'elfeed-search-show-entry))) + +(defun elfeed-show-prev () + "Show the previous item in the elfeed-search buffer." + (interactive) + (funcall elfeed-show-entry-delete) + (with-current-buffer (elfeed-search-buffer) + (forward-line -2) + (call-interactively #'elfeed-search-show-entry))) + +(defun elfeed-show-new-live-search () + "Kill the current buffer, search again in *elfeed-search*." + (interactive) + (elfeed-kill-buffer) + (elfeed) + (elfeed-search-live-filter)) + +(defun elfeed-show-visit (&optional use-generic-p) + "Visit the current entry in your browser using `browse-url'. +If there is a prefix argument, visit the current entry in the +browser defined by `browse-url-generic-program'." + (interactive "P") + (let ((link (elfeed-entry-link elfeed-show-entry))) + (when link + (message "Sent to browser: %s" link) + (if use-generic-p + (browse-url-generic link) + (browse-url link))))) + +(defun elfeed-show-yank () + "Copy the current entry link URL to the clipboard." + (interactive) + (let ((link (elfeed-entry-link elfeed-show-entry))) + (when link + (kill-new link) + (if (fboundp 'gui-set-selection) + (gui-set-selection 'PRIMARY link) + (with-no-warnings + (x-set-selection 'PRIMARY link))) + (message "Yanked: %s" link)))) + +(defun elfeed-show-tag (&rest tags) + "Add TAGS to the displayed entry." + (interactive (list (intern (read-from-minibuffer "Tag: ")))) + (let ((entry elfeed-show-entry)) + (apply #'elfeed-tag entry tags) + (with-current-buffer (elfeed-search-buffer) + (elfeed-search-update-entry entry)) + (elfeed-show-refresh))) + +(defun elfeed-show-untag (&rest tags) + "Remove TAGS from the displayed entry." + (interactive (let* ((tags (elfeed-entry-tags elfeed-show-entry)) + (names (mapcar #'symbol-name tags)) + (select (completing-read "Untag: " names nil :match))) + (list (intern select)))) + (let ((entry elfeed-show-entry)) + (apply #'elfeed-untag entry tags) + (with-current-buffer (elfeed-search-buffer) + (elfeed-search-update-entry entry)) + (elfeed-show-refresh))) + +;; Enclosures: + +(defcustom elfeed-enclosure-default-dir (expand-file-name "~") + "Default directory for saving enclosures. +This can be either a string (a file system path), or a function +that takes a filename and the mime-type as arguments, and returns +the enclosure dir." + :type 'directory + :group 'elfeed + :safe 'stringp) + +(defcustom elfeed-save-multiple-enclosures-without-asking nil + "If non-nil, saving multiple enclosures asks once for a +directory and saves all attachments in the chosen directory." + :type 'boolean + :group 'elfeed) + +(defvar elfeed-show-enclosure-filename-function + #'elfeed-show-enclosure-filename-remote + "Function called to generate the filename for an enclosure.") + +(defun elfeed--download-enclosure (url path) + "Download asynchronously the enclosure from URL to PATH." + (if (require 'async nil :noerror) + (with-no-warnings + (async-start + (lambda () + (url-copy-file url path t)) + (lambda (_) + (message (format "%s downloaded" url))))) + (url-copy-file url path t))) + +(defun elfeed--get-enclosure-num (prompt entry &optional multi) + "Ask the user with PROMPT for an enclosure number for ENTRY. +The number is [1..n] for enclosures \[0..(n-1)] in the entry. If +MULTI is nil, return the number for the enclosure; +otherwise (MULTI is non-nil), accept ranges of enclosure numbers, +as per `elfeed-split-ranges-to-numbers', and return the +corresponding string." + (let* ((count (length (elfeed-entry-enclosures entry))) + def) + (when (zerop count) + (error "No enclosures to this entry")) + (if (not multi) + (if (= count 1) + (read-number (format "%s: " prompt) 1) + (read-number (format "%s (1-%d): " prompt count))) + (progn + (setq def (if (= count 1) "1" (format "1-%d" count))) + (read-string (format "%s (default %s): " prompt def) + nil nil def))))) + +(defun elfeed--request-enclosure-path (fname path) + "Ask the user where to save FNAME (default is PATH/FNAME)." + (let ((fpath (expand-file-name + (read-file-name "Save as: " path nil nil fname) path))) + (if (file-directory-p fpath) + (expand-file-name fname fpath) + fpath))) + +(defun elfeed--request-enclosures-dir (path) + "Ask the user where to save multiple enclosures (default is PATH)." + (let ((fpath (expand-file-name + (read-directory-name + (format "Save in directory: ") path nil nil nil) path))) + (if (file-directory-p fpath) + fpath))) + +(defun elfeed-show-enclosure-filename-remote (_entry url-enclosure) + "Returns the remote filename as local filename for an enclosure." + (file-name-nondirectory + (url-unhex-string + (car (url-path-and-query (url-generic-parse-url + url-enclosure)))))) + +(defun elfeed-show-save-enclosure-single (&optional entry enclosure-index) + "Save enclosure number ENCLOSURE-INDEX from ENTRY. +If ENTRY is nil use the elfeed-show-entry variable. +If ENCLOSURE-INDEX is nil ask for the enclosure number." + (interactive) + (let* ((path elfeed-enclosure-default-dir) + (entry (or entry elfeed-show-entry)) + (enclosure-index (or enclosure-index + (elfeed--get-enclosure-num + "Enclosure to save" entry))) + (url-enclosure (car (elt (elfeed-entry-enclosures entry) + (- enclosure-index 1)))) + (fname + (funcall elfeed-show-enclosure-filename-function + entry url-enclosure)) + (retry t) + (fpath)) + (while retry + (setf fpath (elfeed--request-enclosure-path fname path) + retry (and (file-exists-p fpath) + (not (y-or-n-p (format "Overwrite '%s'?" fpath)))))) + (elfeed--download-enclosure url-enclosure fpath))) + +(defun elfeed-show-save-enclosure-multi (&optional entry) + "Offer to save multiple entry enclosures from the current entry. +Default is to save all enclosures, [1..n], where n is the number of +enclosures. You can type multiple values separated by space, e.g. + 1 3-6 8 +will save enclosures 1,3,4,5,6 and 8. + +Furthermore, there is a shortcut \"a\" which so means all +enclosures, but as this is the default, you may not need it." + (interactive) + (let* ((entry (or entry elfeed-show-entry)) + (attachstr (elfeed--get-enclosure-num + "Enclosure number range (or 'a' for 'all')" entry t)) + (count (length (elfeed-entry-enclosures entry))) + (attachnums (elfeed-split-ranges-to-numbers attachstr count)) + (path elfeed-enclosure-default-dir) + (fpath)) + (if elfeed-save-multiple-enclosures-without-asking + (let ((attachdir (elfeed--request-enclosures-dir path))) + (dolist (enclosure-index attachnums) + (let* ((url-enclosure + (aref (elfeed-entry-enclosures entry) enclosure-index)) + (fname + (funcall elfeed-show-enclosure-filename-function + entry url-enclosure)) + (retry t)) + (while retry + (setf fpath (expand-file-name (concat attachdir fname) path) + retry + (and (file-exists-p fpath) + (not (y-or-n-p (format "Overwrite '%s'?" fpath)))))) + (elfeed--download-enclosure url-enclosure fpath)))) + (dolist (enclosure-index attachnums) + (elfeed-show-save-enclosure-single entry enclosure-index))))) + +(defun elfeed-show-save-enclosure (&optional multi) + "Offer to save enclosure(s). +If MULTI (prefix-argument) is nil, save a single one, otherwise, +offer to save a range of enclosures." + (interactive "P") + (if multi + (elfeed-show-save-enclosure-multi) + (elfeed-show-save-enclosure-single))) + +(defun elfeed--enclosure-maybe-prompt-index (entry) + "Prompt for an enclosure if there are multiple in ENTRY." + (if (= 1 (length (elfeed-entry-enclosures entry))) + 1 + (elfeed--get-enclosure-num "Enclosure to play" entry))) + +(defun elfeed-show-play-enclosure (enclosure-index) + "Play enclosure number ENCLOSURE-INDEX from current entry using EMMS. +Prompts for ENCLOSURE-INDEX when called interactively." + (interactive (list (elfeed--enclosure-maybe-prompt-index elfeed-show-entry))) + (elfeed-show-add-enclosure-to-playlist enclosure-index) + (with-no-warnings + (with-current-emms-playlist + (save-excursion + (emms-playlist-last) + (emms-playlist-mode-play-current-track))))) + +(defun elfeed-show-add-enclosure-to-playlist (enclosure-index) + "Add enclosure number ENCLOSURE-INDEX to current EMMS playlist. +Prompts for ENCLOSURE-INDEX when called interactively." + + (interactive (list (elfeed--enclosure-maybe-prompt-index elfeed-show-entry))) + (require 'emms) ;; optional + (with-no-warnings ;; due to lazy (require ) + (emms-add-url (car (elt (elfeed-entry-enclosures elfeed-show-entry) + (- enclosure-index 1)))))) + +(defun elfeed-show-next-link () + "Skip to the next link, exclusive of the Link header." + (interactive) + (let ((properties (text-properties-at (line-beginning-position)))) + (when (memq 'message-header-name properties) + (forward-paragraph)) + (shr-next-link))) + +(defun elfeed-kill-link-url-at-point () + "Get link URL at point and store in kill-ring." + (interactive) + (let ((url (or (elfeed-get-link-at-point) + (elfeed-get-url-at-point)))) + (if url + (progn (kill-new url) (message url)) + (call-interactively 'shr-copy-url)))) + +(provide 'elfeed-show) + +;;; elfeed-show.el ends here diff --git a/elpa/elfeed-20191227.426/elfeed.el b/elpa/elfeed-20191227.426/elfeed.el new file mode 100644 index 00000000..b8b8d851 --- /dev/null +++ b/elpa/elfeed-20191227.426/elfeed.el @@ -0,0 +1,673 @@ +;;; elfeed.el --- an Emacs Atom/RSS feed reader -*- lexical-binding: t; -*- + +;; This is free and unencumbered software released into the public domain. + +;; Author: Christopher Wellons +;; URL: https://github.com/skeeto/elfeed + +;;; Commentary: + +;; Elfeed is a web feed client for Emacs, inspired by notmuch. See +;; the README for full documentation. + +;; Notice: Before stamping a new release the following places need to +;; be updated: +;; * NEWS.md +;; * elfeed.el (`elfeed-version') +;; * elfeed-pkg.el +;; * web/elfeed-web-pkg.el +;; * Makefile (VERSION) + +;;; Code: + +(require 'cl-lib) +(require 'xml) +(require 'xml-query) +(require 'url-parse) +(require 'url-queue) + +(require 'elfeed-db) +(require 'elfeed-lib) +(require 'elfeed-log) +(require 'elfeed-curl) + +;; Interface to elfeed-search (lazy required) +(declare-function elfeed-search-buffer 'elfeed-search ()) +(declare-function elfeed-search-mode 'elfeed-search ()) + +(defgroup elfeed () + "An Emacs web feed reader." + :group 'comm) + +(defconst elfeed-version "3.3.0") + +(defcustom elfeed-feeds () + "List of all feeds that Elfeed should follow. +You must add your feeds to this list. + +In its simplest form this will be a list of strings of feed URLs. +Items in this list can also be list whose car is the feed URL +and cdr is a list of symbols to be applied to all discovered +entries as tags (\"autotags\"). For example, + + (setq elfeed-feeds '(\"http://foo/\" + \"http://bar/\" + (\"http://baz/\" comic))) + +All entries from the \"baz\" feed will be tagged as \"comic\" +when they are first discovered." + :group 'elfeed + :type '(repeat (choice string + (cons string (repeat symbol))))) + +(defcustom elfeed-feed-functions + '(elfeed-get-link-at-point + elfeed-get-url-at-point + elfeed-clipboard-get) + "List of functions to use to get possible feeds for `elfeed-add-feed'. +Each function should accept no arguments, and return a string or nil." + :group 'elfeed + :type 'hook + :options '(elfeed-get-link-at-point + elfeed-get-url-at-point + elfeed-clipboard-get)) + +(defcustom elfeed-use-curl + (not (null (executable-find elfeed-curl-program-name))) + "If non-nil, fetch feeds using curl instead of `url-retrieve'." + :group 'elfeed + :type 'boolean) + +(defcustom elfeed-user-agent (format "Emacs Elfeed %s" elfeed-version) + "User agent string to use for Elfeed (requires `elfeed-use-curl')." + :group 'elfeed + :type 'string) + +(defcustom elfeed-initial-tags '(unread) + "Initial tags for new entries." + :group 'elfeed + :type '(repeat symbol)) + +;; Fetching: + +(defvar elfeed-http-error-hooks () + "Hooks to run when an http connection error occurs. +It is called with 2 arguments. The first argument is the url of +the failing feed. The second argument is the http status code.") + +(defvar elfeed-parse-error-hooks () + "Hooks to run when an error occurs during the parsing of a feed. +It is called with 2 arguments. The first argument is the url of +the failing feed. The second argument is the error message .") + +(defvar elfeed-update-hooks () + "Hooks to run any time a feed update has completed a request. +It is called with 1 argument: the URL of the feed that was just +updated. The hook is called even when no new entries were +found.") + +(defvar elfeed-update-init-hooks () + "Hooks called when one or more feed updates have begun. +Receivers may want to, say, update a display to indicate that +updates are pending.") + +(defvar elfeed-tag-hooks () + "Hooks called when one or more entries add tags. +It is called with 2 arguments. The first argument is the entry +list. The second argument is the tag list.") + +(defvar elfeed-untag-hooks () + "Hooks called when one or more entries remove tags. +It is called with 2 arguments. The first argument is the entry +list. The second argument is the tag list.") + +(defvar elfeed--inhibit-update-init-hooks nil + "When non-nil, don't run `elfeed-update-init-hooks'.") + +(defun elfeed-queue-count-active () + "Return the number of items in process." + (if elfeed-use-curl + elfeed-curl-queue-active + (cl-count-if #'url-queue-buffer url-queue))) + +(defun elfeed-queue-count-total () + "Return the number of items in process." + (if elfeed-use-curl + (+ (length elfeed-curl-queue) elfeed-curl-queue-active) + (length url-queue))) + +(defun elfeed-set-max-connections (n) + "Limit the maximum number of concurrent connections to N." + (if elfeed-use-curl + (setf elfeed-curl-max-connections n) + (setf url-queue-parallel-processes n))) + +(defun elfeed-get-max-connections () + "Get the maximum number of concurrent connections." + (if elfeed-use-curl + elfeed-curl-max-connections + url-queue-parallel-processes)) + +(defun elfeed-set-timeout (seconds) + "Limit the time for fetching a feed to SECONDS." + (if elfeed-use-curl + (setf elfeed-curl-timeout seconds) + (setf url-queue-timeout seconds))) + +(defun elfeed-get-timeout () + "Get the time limit for fetching feeds in SECONDS." + (if elfeed-use-curl + elfeed-curl-timeout + url-queue-timeout)) + +(defun elfeed-is-status-error (status use-curl) + "Check if HTTP request returned status means a error." + (or (and use-curl (null status)) ; nil = error + (and (not use-curl) (eq (car status) :error)))) + +(defmacro elfeed-with-fetch (url &rest body) + "Asynchronously run BODY in a buffer with the contents from URL. +This macro is anaphoric, with STATUS referring to the status from +`url-retrieve'/cURL and USE-CURL being the original invoked-value +of `elfeed-use-curl'." + (declare (indent defun)) + `(let* ((use-curl elfeed-use-curl) ; capture current value in closure + (cb (lambda (status) ,@body))) + (if elfeed-use-curl + (let* ((feed (elfeed-db-get-feed url)) + (last-modified (elfeed-meta feed :last-modified)) + (etag (elfeed-meta feed :etag)) + (headers `(("User-Agent" . ,elfeed-user-agent)))) + (when etag + (push `("If-None-Match" . ,etag) headers)) + (when last-modified + (push `("If-Modified-Since" . ,last-modified) headers)) + (elfeed-curl-enqueue ,url cb :headers headers)) + (url-queue-retrieve ,url cb () t t)))) + +(defun elfeed-unjam () + "Manually clear the connection pool when connections fail to timeout. +This is a workaround for issues in `url-queue-retrieve'." + (interactive) + (if elfeed-use-curl + (setf elfeed-curl-queue nil + elfeed-curl-queue-active 0) + (let ((fails (mapcar #'url-queue-url url-queue))) + (when fails + (elfeed-log 'warn "Elfeed aborted feeds: %s" + (mapconcat #'identity fails " "))) + (setf url-queue nil))) + (run-hooks 'elfeed-update-init-hooks)) + +;; Parsing: + +(defun elfeed-feed-type (content) + "Return the feed type (:atom, :rss, :rss1.0) or nil for unknown." + (let ((top (xml-query-strip-ns (caar content)))) + (cadr (assoc top '((feed :atom) + (rss :rss) + (RDF :rss1.0)))))) + +(defun elfeed-generate-id (&optional content) + "Generate an ID based on CONTENT or from the current time." + (concat "urn:sha1:" (sha1 (format "%s" (or content (float-time)))))) + +(defun elfeed--atom-content (entry) + "Get content string from ENTRY." + (let ((content-type (xml-query* (content :type) entry))) + (if (equal content-type "xhtml") + (with-temp-buffer + (let ((xhtml (cddr (xml-query* (content) entry)))) + (dolist (element xhtml) + (if (stringp element) + (insert element) + (elfeed-xml-unparse element)))) + (buffer-string)) + (let ((all-content + (or (xml-query-all* (content *) entry) + (xml-query-all* (summary *) entry)))) + (when all-content + (apply #'concat all-content)))))) + +(defvar elfeed-new-entry-parse-hook '() + "Hook to be called after parsing a new entry. + +Take three arguments: the feed TYPE, the XML structure for the +entry, and the Elfeed ENTRY object. Return value is ignored, and +is called for side-effects on the ENTRY object.") + +(defsubst elfeed--fixup-protocol (protocol url) + "Prepend PROTOCOL to URL if it is protocol-relative. +If PROTOCOL is nil, returns URL." + (if (and protocol url (string-match-p "^//[^/]" url)) + (concat protocol ":" url) + url)) + +(defsubst elfeed--atom-authors-to-plist (authors) + "Parse list of author XML tags into list of plists." + (let ((result ())) + (dolist (author authors) + (let ((plist ()) + (name (xml-query* (name *) author)) + (uri (xml-query* (uri *) author)) + (email (xml-query* (email *) author))) + (when email + (setf plist (list :email (elfeed-cleanup email)))) + (when uri + (setf plist (nconc (list :uri (elfeed-cleanup uri)) plist))) + (when name + (setf plist (nconc (list :name (elfeed-cleanup name)) plist))) + (push plist result))) + (nreverse result))) + +(defsubst elfeed--creators-to-plist (creators) + "Convert Dublin Core list of creators into an authors plist." + (cl-loop for creator in creators + collect (list :name creator))) + +(defun elfeed-entries-from-atom (url xml) + "Turn parsed Atom content into a list of elfeed-entry structs." + (let* ((feed-id url) + (protocol (url-type (url-generic-parse-url url))) + (namespace (elfeed-url-to-namespace url)) + (feed (elfeed-db-get-feed feed-id)) + (title (elfeed-cleanup (xml-query* (feed title *) xml))) + (authors (xml-query-all* (feed author) xml)) + (xml-base (or (xml-query* (feed :base) xml) url)) + (autotags (elfeed-feed-autotags url))) + (setf (elfeed-feed-url feed) url + (elfeed-feed-title feed) title + (elfeed-feed-author feed) (elfeed--atom-authors-to-plist authors)) + (cl-loop for entry in (xml-query-all* (feed entry) xml) collect + (let* ((title (or (xml-query* (title *) entry) "")) + (xml-base (elfeed-update-location + xml-base (xml-query* (:base) (list entry)))) + (anylink (xml-query* (link :href) entry)) + (altlink (xml-query* (link [rel "alternate"] :href) entry)) + (link (elfeed--fixup-protocol + protocol + (elfeed-update-location xml-base + (or altlink anylink)))) + (date (or (xml-query* (published *) entry) + (xml-query* (updated *) entry) + (xml-query* (date *) entry) + (xml-query* (modified *) entry) ; Atom 0.3 + (xml-query* (issued *) entry))) ; Atom 0.3 + (authors (nconc (elfeed--atom-authors-to-plist + (xml-query-all* (author) entry)) + ;; Dublin Core + (elfeed--creators-to-plist + (xml-query-all* (creator *) entry)))) + (categories (xml-query-all* (category :term) entry)) + (content (elfeed--atom-content entry)) + (id (or (xml-query* (id *) entry) link + (elfeed-generate-id content))) + (type (or (xml-query* (content :type) entry) + (xml-query* (summary :type) entry) + "")) + (tags (elfeed-normalize-tags autotags elfeed-initial-tags)) + (content-type (if (string-match-p "html" type) 'html nil)) + (etags (xml-query-all* (link [rel "enclosure"]) entry)) + (enclosures + (cl-loop for enclosure in etags + for wrap = (list enclosure) + for href = (xml-query* (:href) wrap) + for type = (xml-query* (:type) wrap) + for length = (xml-query* (:length) wrap) + collect (list href type length))) + (db-entry (elfeed-entry--create + :title (elfeed-cleanup title) + :feed-id feed-id + :id (cons namespace (elfeed-cleanup id)) + :link (elfeed-cleanup link) + :tags tags + :date (or (elfeed-float-time date) (float-time)) + :content content + :enclosures enclosures + :content-type content-type + :meta `(,@(when authors + (list :authors authors)) + ,@(when categories + (list :categories categories)))))) + (dolist (hook elfeed-new-entry-parse-hook) + (funcall hook :atom entry db-entry)) + db-entry)))) + +(defsubst elfeed--rss-author-to-plist (author) + "Parse an RSS author element into an authors plist." + (when author + (let ((clean (elfeed-cleanup author))) + (if (string-match "^\\(.*\\) (\\([^)]+\\))$" clean) + (list (list :name (match-string 2 clean) + :email (match-string 1 clean))) + (list (list :email clean)))))) + +(defun elfeed-entries-from-rss (url xml) + "Turn parsed RSS content into a list of elfeed-entry structs." + (let* ((feed-id url) + (protocol (url-type (url-generic-parse-url url))) + (namespace (elfeed-url-to-namespace url)) + (feed (elfeed-db-get-feed feed-id)) + (title (elfeed-cleanup (xml-query* (rss channel title *) xml))) + (autotags (elfeed-feed-autotags url))) + (setf (elfeed-feed-url feed) url + (elfeed-feed-title feed) title) + (cl-loop for item in (xml-query-all* (rss channel item) xml) collect + (let* ((title (or (xml-query* (title *) item) "")) + (guid (xml-query* (guid *) item)) + (link (elfeed--fixup-protocol + protocol + (or (xml-query* (link *) item) guid))) + (date (or (xml-query* (pubDate *) item) + (xml-query* (date *) item))) + (authors (nconc (elfeed--rss-author-to-plist + (xml-query* (author *) item)) + ;; Dublin Core + (elfeed--creators-to-plist + (xml-query-all* (creator *) item)))) + (categories (xml-query-all* (category *) item)) + (content (or (xml-query-all* (encoded *) item) + (xml-query-all* (description *) item))) + (description (apply #'concat content)) + (id (or guid link (elfeed-generate-id description))) + (full-id (cons namespace (elfeed-cleanup id))) + (original (elfeed-db-get-entry full-id)) + (original-date (and original (elfeed-entry-date original))) + (tags (elfeed-normalize-tags autotags elfeed-initial-tags)) + (etags (xml-query-all* (enclosure) item)) + (enclosures + (cl-loop for enclosure in etags + for wrap = (list enclosure) + for url = (xml-query* (:url) wrap) + for type = (xml-query* (:type) wrap) + for length = (xml-query* (:length) wrap) + collect (list url type length))) + (db-entry (elfeed-entry--create + :title (elfeed-cleanup title) + :id full-id + :feed-id feed-id + :link (elfeed-cleanup link) + :tags tags + :date (elfeed-new-date-for-entry + original-date date) + :enclosures enclosures + :content description + :content-type 'html + :meta `(,@(when authors + (list :authors authors)) + ,@(when categories + (list :categories categories)))))) + (dolist (hook elfeed-new-entry-parse-hook) + (funcall hook :rss item db-entry)) + db-entry)))) + +(defun elfeed-entries-from-rss1.0 (url xml) + "Turn parsed RSS 1.0 content into a list of elfeed-entry structs." + (let* ((feed-id url) + (namespace (elfeed-url-to-namespace url)) + (feed (elfeed-db-get-feed feed-id)) + (title (elfeed-cleanup (xml-query* (RDF channel title *) xml))) + (autotags (elfeed-feed-autotags url))) + (setf (elfeed-feed-url feed) url + (elfeed-feed-title feed) title) + (cl-loop for item in (xml-query-all* (RDF item) xml) collect + (let* ((title (or (xml-query* (title *) item) "")) + (link (xml-query* (link *) item)) + (date (or (xml-query* (pubDate *) item) + (xml-query* (date *) item))) + (description + (apply #'concat (xml-query-all* (description *) item))) + (id (or link (elfeed-generate-id description))) + (full-id (cons namespace (elfeed-cleanup id))) + (original (elfeed-db-get-entry full-id)) + (original-date (and original (elfeed-entry-date original))) + (tags (elfeed-normalize-tags autotags elfeed-initial-tags)) + (db-entry (elfeed-entry--create + :title (elfeed-cleanup title) + :id full-id + :feed-id feed-id + :link (elfeed-cleanup link) + :tags tags + :date (elfeed-new-date-for-entry + original-date date) + :content description + :content-type 'html))) + (dolist (hook elfeed-new-entry-parse-hook) + (funcall hook :rss1.0 item db-entry)) + db-entry)))) + +(defun elfeed-feed-list () + "Return a flat list version of `elfeed-feeds'. +Only a list of strings will be returned." + ;; Validate elfeed-feeds and fail early rather than asynchronously later. + (dolist (feed elfeed-feeds) + (unless (cl-typecase feed + (list (and (stringp (car feed)) + (cl-every #'symbolp (cdr feed)))) + (string t)) + (error "elfeed-feeds malformed, bad entry: %S" feed))) + (cl-loop for feed in elfeed-feeds + when (listp feed) collect (car feed) + else collect feed)) + +(defun elfeed-feed-autotags (url-or-feed) + "Return tags to automatically apply to all entries from URL-OR-FEED." + (let ((url (if (elfeed-feed-p url-or-feed) + (or (elfeed-feed-url url-or-feed) + (elfeed-feed-id url-or-feed)) + url-or-feed))) + (mapcar #'elfeed-keyword->symbol (cdr (assoc url elfeed-feeds))))) + +(defun elfeed-apply-autotags-now () + "Apply autotags to existing entries according to `elfeed-feeds'." + (interactive) + (with-elfeed-db-visit (entry feed) + (apply #'elfeed-tag entry (elfeed-feed-autotags feed)))) + +(defun elfeed-handle-http-error (url status) + "Handle an http error during retrieval of URL with STATUS code." + (cl-incf (elfeed-meta (elfeed-db-get-feed url) :failures 0)) + (run-hook-with-args 'elfeed-http-error-hooks url status) + (elfeed-log 'error "%s: %S" url status)) + +(defun elfeed-handle-parse-error (url error) + "Handle parse error during parsing of URL with ERROR message." + (cl-incf (elfeed-meta (elfeed-db-get-feed url) :failures 0)) + (run-hook-with-args 'elfeed-parse-error-hooks url error) + (elfeed-log 'error "%s: %s" url error)) + +(defun elfeed-update-feed (url) + "Update a specific feed." + (interactive (list (completing-read "Feed: " (elfeed-feed-list)))) + (unless elfeed--inhibit-update-init-hooks + (run-hooks 'elfeed-update-init-hooks)) + (elfeed-with-fetch url + (if (elfeed-is-status-error status use-curl) + (let ((print-escape-newlines t)) + (elfeed-handle-http-error + url (if use-curl elfeed-curl-error-message status))) + (condition-case error + (let ((feed (elfeed-db-get-feed url))) + (unless use-curl + (elfeed-move-to-first-empty-line) + (set-buffer-multibyte t)) + (unless (eql elfeed-curl-status-code 304) + ;; Update Last-Modified and Etag + (setf (elfeed-meta feed :last-modified) + (cdr (assoc "last-modified" elfeed-curl-headers)) + (elfeed-meta feed :etag) + (cdr (assoc "etag" elfeed-curl-headers))) + (if (equal url elfeed-curl-location) + (setf (elfeed-meta feed :canonical-url) nil) + (setf (elfeed-meta feed :canonical-url) elfeed-curl-location)) + (let* ((xml (elfeed-xml-parse-region (point) (point-max))) + (entries (cl-case (elfeed-feed-type xml) + (:atom (elfeed-entries-from-atom url xml)) + (:rss (elfeed-entries-from-rss url xml)) + (:rss1.0 (elfeed-entries-from-rss1.0 url xml)) + (otherwise + (error (elfeed-handle-parse-error + url "Unknown feed type.")))))) + (elfeed-db-add entries)))) + (error (elfeed-handle-parse-error url error)))) + (unless use-curl + (kill-buffer)) + (run-hook-with-args 'elfeed-update-hooks url))) + +(defun elfeed-candidate-feeds () + "Return a list of possible feeds from `elfeed-feed-functions'." + (let (res) + (run-hook-wrapped + 'elfeed-feed-functions + (lambda (fun) + (let* ((val (elfeed-cleanup (funcall fun)))) + (when (and (not (zerop (length val))) + (elfeed-looks-like-url-p val)) + (cl-pushnew val res :test #'equal))) + nil)) + (nreverse res))) + +(cl-defun elfeed-add-feed (url &key save) + "Manually add a feed to the database. +If SAVE is non-nil the new value of ‘elfeed-feeds’ is saved. When +called interactively, SAVE is set to t." + (interactive + (list + (let* ((feeds (elfeed-candidate-feeds)) + (prompt (if feeds (concat "URL (default " (car feeds) "): ") + "URL: ")) + (input (read-from-minibuffer prompt nil nil nil nil feeds)) + (result (elfeed-cleanup input))) + (cond ((not (zerop (length result))) result) + (feeds (car feeds)) + ((user-error "No feed to add")))) + :save t)) + (cl-pushnew url elfeed-feeds :test #'equal) + (when save + (customize-save-variable 'elfeed-feeds elfeed-feeds)) + (elfeed-update-feed url)) + +;;;###autoload +(defun elfeed-update () + "Update all the feeds in `elfeed-feeds'." + (interactive) + (elfeed-log 'info "Elfeed update: %s" + (format-time-string "%B %e %Y %H:%M:%S %Z")) + (let ((elfeed--inhibit-update-init-hooks t)) + (mapc #'elfeed-update-feed (elfeed--shuffle (elfeed-feed-list)))) + (run-hooks 'elfeed-update-init-hooks) + (elfeed-db-save)) + +;;;###autoload +(defun elfeed () + "Enter elfeed." + (interactive) + (switch-to-buffer (elfeed-search-buffer)) + (unless (eq major-mode 'elfeed-search-mode) + (elfeed-search-mode))) + +;; New entry filtering + +(cl-defun elfeed-make-tagger + (&key feed-title feed-url entry-title entry-link after before + add remove callback) + "Create a function that adds or removes tags on matching entries. + +FEED-TITLE, FEED-URL, ENTRY-TITLE, and ENTRY-LINK are regular +expressions or a list (not ), which indicates a negative +match. AFTER and BEFORE are relative times (see +`elfeed-time-duration'). Entries must match all provided +expressions. If an entry matches, add tags ADD and remove tags +REMOVE. + +Examples, + + (elfeed-make-tagger :feed-url \"youtube\\\\.com\" + :add '(video youtube)) + + (elfeed-make-tagger :before \"1 week ago\" + :remove 'unread) + + (elfeed-make-tagger :feed-url \"example\\\\.com\" + :entry-title '(not \"something interesting\") + :add 'junk) + +The returned function should be added to `elfeed-new-entry-hook'." + (let ((after-time (and after (elfeed-time-duration after))) + (before-time (and before (elfeed-time-duration before)))) + (when (and add (symbolp add)) (setf add (list add))) + (when (and remove (symbolp remove)) (setf remove (list remove))) + (lambda (entry) + (let ((feed (elfeed-entry-feed entry)) + (date (elfeed-entry-date entry)) + (case-fold-search t)) + (cl-flet ((match (r s) + (or (null r) + (if (listp r) + (not (string-match-p (cl-second r) s)) + (string-match-p r s))))) + (when (and + (match feed-title (elfeed-feed-title feed)) + (match feed-url (elfeed-feed-url feed)) + (match entry-title (elfeed-entry-title entry)) + (match entry-link (elfeed-entry-link entry)) + (or (not after-time) (> date (- (float-time) after-time))) + (or (not before-time) (< date (- (float-time) before-time)))) + (when add + (apply #'elfeed-tag entry add)) + (when remove + (apply #'elfeed-untag entry remove)) + (when callback + (funcall callback entry)) + entry)))))) + +;; OPML + +(defun elfeed--parse-opml (xml) + "Parse XML (from `xml-parse-region') into `elfeed-feeds' list." + (cl-loop for (tag attr . content) in (cl-remove-if-not #'listp xml) + count tag into work-around-bug ; bug#15326 + when (assoc 'xmlUrl attr) collect (cdr it) + else append (elfeed--parse-opml content))) + +;;;###autoload +(defun elfeed-load-opml (file) + "Load feeds from an OPML file into `elfeed-feeds'. +When called interactively, the changes to `elfeed-feeds' are +saved to your customization file." + (interactive "fOPML file: ") + (let* ((xml (xml-parse-file file)) + (feeds (elfeed--parse-opml xml)) + (full (append feeds elfeed-feeds))) + (prog1 (setf elfeed-feeds (cl-delete-duplicates full :test #'string=)) + (when (called-interactively-p 'any) + (customize-save-variable 'elfeed-feeds elfeed-feeds) + (elfeed-log 'notice "%d feeds loaded from %s" (length feeds) file))))) + +;;;###autoload +(defun elfeed-export-opml (file) + "Export the current feed listing to OPML-formatted FILE." + (interactive "FOutput OPML file: ") + (with-temp-file file + (let ((standard-output (current-buffer))) + (princ "\n") + (xml-print + `((opml ((version . "1.0")) + (head () (title () "Elfeed Export")) + (body () + ,@(cl-loop for url in (elfeed-feed-list) + for feed = (elfeed-db-get-feed url) + for title = (or (elfeed-feed-title feed) "") + collect `(outline ((xmlUrl . ,url) + (title . ,title))))))))))) + +(provide 'elfeed) + +(cl-eval-when (load eval) + ;; run-time only, so don't load when compiling other files + (unless byte-compile-root-dir + (require 'elfeed-csv) + (require 'elfeed-show) + (require 'elfeed-search))) + +;;; elfeed.el ends here diff --git a/elpa/elfeed-20191227.426/xml-query.el b/elpa/elfeed-20191227.426/xml-query.el new file mode 100644 index 00000000..fd3cc2d8 --- /dev/null +++ b/elpa/elfeed-20191227.426/xml-query.el @@ -0,0 +1,231 @@ +;;; 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 diff --git a/elpa/elfeed-readme.txt b/elpa/elfeed-readme.txt index 325474f0..1bc0be0d 100644 --- a/elpa/elfeed-readme.txt +++ b/elpa/elfeed-readme.txt @@ -1,4 +1,10 @@ -Elfreed is a web feed client for Emacs, inspired by notmuch. See +Elfeed is a web feed client for Emacs, inspired by notmuch. See the README for full documentation. -Elfreed requires Emacs 24 (lexical closures). +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)