#+BEGIN_SRC emacs-lisp
(if (>= emacs-major-version 24)
(progn
- (add-to-list 'load-path "~/.emacs.d/elpa/elfeed-20150101.1457")
- (add-to-list 'load-path "~/.emacs.d/elpa/elfeed-org-20150108.1406")
+ (add-to-list 'load-path "~/.emacs.d/elpa/elfeed-20150608.13027")
+ (add-to-list 'load-path "~/.emacs.d/elpa/elfeed-org-20150412.145")
(require 'elfeed-org)
(elfeed-org)
(setq rmh-elfeed-org-files (list "~/org/elfeed.org"))))
+++ /dev/null
-;;; elfeed-autoloads.el --- automatically extracted autoloads
-;;
-;;; Code:
-
-\f
-;;;### (autoloads (elfeed-export-opml elfeed-load-opml elfeed elfeed-update)
-;;;;;; "elfeed" "elfeed.el" (21691 56987 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)
-
-;;;***
-\f
-;;;### (autoloads nil nil ("elfeed-db.el" "elfeed-lib.el" "elfeed-pkg.el"
-;;;;;; "elfeed-search.el" "elfeed-show.el" "xml-query.el") (21691
-;;;;;; 56987 496165 0))
-
-;;;***
-\f
-(provide 'elfeed-autoloads)
-;; Local Variables:
-;; version-control: never
-;; no-byte-compile: t
-;; no-update-autoloads: t
-;; coding: utf-8
-;; End:
-;;; elfeed-autoloads.el ends here
+++ /dev/null
-;;; elfeed-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 "0.0.2"
- "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 cutoms 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.")
-
-;; 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))
- (not
- (zerop
- (cl-loop for i from 0 below (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."
- (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 (copy-sequence (apply #'append tags more-tags))))
- (cl-remove-duplicates (cl-sort all #'string< :key #'symbol-name))))
-
-(defun elfeed-tag (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 (entry &rest tags)
- "Remove TAGS from ENTRY."
- (setf (elfeed-entry-tags entry)
- (cl-loop for tag in (elfeed-entry-tags entry)
- unless (member tag tags) collect tag)))
-
-(defun elfeed-tagged-p (tag entry)
- "Return true if ENTRY is tagged by TAG."
- (member 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-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))
-
-;; Saving and Loading:
-
-(defun elfeed-db-save ()
- "Write the database index to the filesystem."
- (elfeed-db-ensure)
- (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))
- (prin1 elfeed-db)
- :success))))
-
-(defun elfeed-db-upgrade ()
- "Upgrade the database from a previous format.
-This function increases the size of the structs in the database."
- (cl-loop with feed-size = (length (elfeed-feed--create))
- for feed hash-values in elfeed-db-feeds
- using (hash-key id)
- unless (elfeed-feed-p feed)
- do (setf (gethash id elfeed-db-feeds)
- (elfeed-resize-vector feed feed-size)))
- (cl-loop with entry-size = (length (elfeed-entry--create))
- for entry hash-values in elfeed-db-entries
- using (hash-key id)
- unless (elfeed-entry-p entry)
- do (setf (gethash id elfeed-db-entries)
- (elfeed-resize-vector entry entry-size)))
- (plist-put elfeed-db :version elfeed-db-version)
- elfeed-db-version)
-
-(defun elfeed-db-load ()
- "Load the database index from the filesystem."
- (let ((index (expand-file-name "index" elfeed-db-directory)))
- (if (not (file-exists-p index))
- (let ((db (setf elfeed-db (list :version elfeed-db-version))))
- (plist-put db :feeds (make-hash-table :test 'equal))
- (plist-put db :entries (make-hash-table :test 'equal))
- ;; Compiler will warn about this (bug#15327):
- (plist-put db :index (avl-tree-create #'elfeed-db-compare)))
- (with-current-buffer (find-file-noselect index)
- (goto-char (point-min))
- (setf elfeed-db (read (current-buffer)))
- (kill-buffer)))
- (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)
- (when (version< (or (plist-get elfeed-db :version) "0") elfeed-db-version)
- (elfeed-db-upgrade))))
-
-(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-meta (thing key)
- "Access metadata for THING (entry, feed) under KEY."
- (plist-get (elfeed-meta--plist thing) key))
-
-(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 new-plist))))
-
-(gv-define-simple-setter elfeed-meta elfeed-meta--put)
-
-;; 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")))
- (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 (&optional stats-p)
- "Clean up unused content from the content database. If STATS is
-true, return the space cleared in bytes."
- (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))
-
-(provide 'elfeed-db)
-
-;;; elfeed-db.el ends here
+++ /dev/null
-;;; elfeed-lib.el --- misc functions for elfeed -*- lexical-binding: t; -*-
-
-;; This is free and unencumbered software released into the public domain.
-
-;;; Commentary:
-
-;; These are general functions that aren't specific to web feeds. It's
-;; a library of useful functions to Elfeed.
-
-;;; Code:
-
-(require 'cl-lib)
-(require 'time-date)
-(require 'url-parse)
-
-(defun elfeed-expose (function &rest args)
- "Return an interactive version of FUNCTION, 'exposing' it to the user."
- (lambda () (interactive) (apply function args)))
-
-(defun elfeed-goto-line (n)
- "Like `goto-line' but for non-interactive use."
- (goto-char (point-min))
- (forward-line (1- n)))
-
-(defun elfeed-kill-buffer ()
- "Kill the current buffer."
- (interactive)
- (kill-buffer (current-buffer)))
-
-(defun elfeed-kill-line ()
- "Clear out the current line without touching anything else."
- (beginning-of-line)
- (let ((start (point)))
- (end-of-line)
- (delete-region start (point))))
-
-(defun elfeed-time-duration (time)
- "Turn a time expression into a number of seconds. Uses
-`timer-duration' but allows a bit more flair."
- (if (numberp time)
- time
- (timer-duration (replace-regexp-in-string "\\(ago\\|old\\|-\\)" "" time))))
-
-(defun elfeed-looks-like-url-p (string)
- "Return true if STRING looks like it could be a URL."
- (and (stringp string)
- (not (string-match-p "[ \n\t\r]" string))
- (not (null (url-type (url-generic-parse-url string))))))
-
-(defun elfeed-format-column (string width &optional align)
- "Return STRING truncated or padded to WIDTH following ALIGNment.
-Align should be a keyword :left or :right."
- (if (<= width 0)
- ""
- (format (format "%%%s%d.%ds" (if (eq align :left) "-" "") width width)
- string)))
-
-(defun elfeed-clamp (min value max)
- "Clamp a value between two values."
- (min max (max min value)))
-
-(defun elfeed-valid-regexp-p (regexp)
- "Return t if REGEXP is a valid REGEXP."
- (ignore-errors
- (prog1 t
- (string-match-p regexp ""))))
-
-(defun elfeed-cleanup (name)
- "Trim trailing and leading spaces and collapse multiple spaces."
- (let ((trim (replace-regexp-in-string "[\n\t]+" " " (or name ""))))
- (replace-regexp-in-string "^ +\\| +$" "" trim)))
-
-(defun elfeed-float-time (&optional date)
- "Like `float-time' but accept anything reasonable for DATE,
-defaulting to the current time if DATE could not be parsed. Date
-is allowed to be relative to now (`elfeed-time-duration')."
- (cl-typecase date
- (string
- (let ((duration (elfeed-time-duration date)))
- (if duration
- (- (float-time) duration)
- (let ((time (ignore-errors (date-to-time date))))
- (if (equal time '(14445 17280)) ; date-to-time silently failed
- (float-time)
- (float-time time))))))
- (integer date)
- (list (float-time date))
- (otherwise (float-time))))
-
-(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."
- (let ((coding-system nil))
- (progn
- (unless beg (setq beg (point-min)))
- (unless end (setq end (point-max)))
- (goto-char beg)
- (if (re-search-forward
- "<\\?xml.*?encoding=[\"']\\([^\"']+\\)[\"'].*?\\?>" nil t)
- (setq coding-system
- (ignore-errors (check-coding-system
- (intern (downcase (match-string 1)))))))
- (when coding-system
- (setq end (+ beg
- (decode-coding-region beg end coding-system))))
- (goto-char beg)))
- (xml-parse-region beg end buffer parse-dtd parse-ns))
-
-(defun elfeed-directory-empty-p (dir)
- "Return non-nil if DIR is empty."
- (null (cddr (directory-files dir))))
-
-(defun elfeed-slurp (file &optional literally)
- "Return the contents of FILE as a string."
- (with-temp-buffer
- (if literally
- (insert-file-contents-literally file)
- (insert-file-contents file))
- (buffer-string)))
-
-(cl-defun elfeed-spit (file string &key fsync append (encoding 'utf-8))
- "Write STRING to FILE."
- (let ((coding-system-for-write encoding)
- (write-region-inhibit-fsync (not fsync)))
- (with-temp-buffer
- (insert string)
- (write-region nil nil file append 0))))
-
-(defvar elfeed-gzip-supported-p--cache :unknown
- "To avoid running the relatively expensive test more than once.")
-
-(defun elfeed-gzip-supported-p ()
- "Return non-nil if `auto-compression-mode' can handle gzip."
- (if (not (eq elfeed-gzip-supported-p--cache :unknown))
- elfeed-gzip-supported-p--cache
- (setf elfeed-gzip-supported-p--cache
- (and (executable-find "gzip")
- (ignore-errors
- (save-window-excursion
- (let ((file (make-temp-file "gziptest" nil ".gz"))
- (data (cl-loop for i from 32 to 3200
- collect i into chars
- finally
- (return (apply #'string chars)))))
- (unwind-protect
- (progn
- (elfeed-spit file data)
- (and (string= data (elfeed-slurp file))
- (not (string= data (elfeed-slurp file t)))))
- (delete-file file)))))))))
-
-(defun elfeed-libxml-supported-p ()
- "Return non-nil if `libxml-parse-html-region' is available."
- (with-temp-buffer
- (insert "<html></html>")
- (and (fboundp 'libxml-parse-html-region)
- (not (null (libxml-parse-html-region (point-min) (point-max)))))))
-
-(defun elfeed-keyword->symbol (keyword)
- "If a keyword, convert KEYWORD into a plain symbol (remove the colon)."
- (if (keywordp keyword)
- (intern (substring (symbol-name keyword) 1))
- keyword))
-
-(defun elfeed-resize-vector (vector length)
- "Return a copy of VECTOR set to size LENGTH."
- (let ((new-vector (make-vector length nil)))
- (prog1 new-vector ; don't use dotimes result (bug#16206)
- (dotimes (i (min (length new-vector) (length vector)))
- (setf (aref new-vector i) (aref vector i))))))
-
-(defun elfeed-readable-p (value)
- "Return non-nil if VALUE can be serialized."
- (condition-case _
- (prog1 t (read (prin1-to-string value)))
- (error nil)))
-
-(defun elfeed-strip-properties (string)
- "Return a copy of STRING with all properties removed.
-If STRING is nil, returns nil."
- (when string
- (let ((copy (copy-sequence string)))
- (prog1 copy
- (set-text-properties 0 (length copy) nil copy)))))
-
-(defun elfeed-clipboard-get ()
- "Try to get a sensible value from the system clipboard.
-On systems running X, it will try to use the PRIMARY selection
-first, then fall back onto the standard clipboard like other
-systems."
- (elfeed-strip-properties
- (or (and (fboundp 'x-get-selection-value)
- (funcall 'x-get-selection-value))
- (and (functionp interprogram-paste-function)
- (funcall interprogram-paste-function))
- (and (fboundp 'w32-get-clipboard-data)
- (funcall 'w32-get-clipboard-data))
- (current-kill 0 :non-destructively))))
-
-(defun elfeed-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))))
-
-(provide 'elfeed-lib)
-
-;;; elfeed-lib.el ends here
+++ /dev/null
-(define-package "elfeed" "20150101.1457" "an Emacs Atom/RSS feed reader"
- '((emacs "24.1")))
-;; Local Variables:
-;; no-byte-compile: t
-;; End:
+++ /dev/null
-;;; elfeed-search.el --- list feed entries -*- lexical-binding: t; -*-
-
-;; This is free and unencumbered software released into the public domain.
-
-;;; Code:
-
-(require 'cl-lib)
-(require 'browse-url)
-(require 'wid-edit) ; widget-inactive face
-
-(provide 'elfeed-search)
-
-(require 'elfeed)
-(require 'elfeed-db)
-(require 'elfeed-lib)
-(require 'elfeed-show)
-
-(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-refresh-timer nil
- "The timer used to keep things updated as the database updates.")
-
-(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, by time."
- :group 'elfeed
- :type '(choice (const descending) (const ascending)))
-
-(defcustom elfeed-search-refresh-rate 3
- "How often the buffer should update against the datebase in seconds."
- :group 'elfeed
- :type 'number)
-
-(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)))
-
-(defvar elfeed-search-live nil
- "When true, Elfeed is currently reading a filter from the minibuffer.")
-
-(defvar elfeed-search-cache (make-hash-table :test 'equal)
- "Cache the generated entry buffer lines and such.")
-
-(defvar elfeed-search--offset 2
- "Offset between line numbers and entry list position.")
-
-(defalias 'elfeed-search-tag-all-unread
- (elfeed-expose #'elfeed-search-tag-all 'unread))
-
-(defalias 'elfeed-search-untag-all-unread
- (elfeed-expose #'elfeed-search-untag-all 'unread))
-
-(defalias 'elfeed-search-update--force
- (elfeed-expose #'elfeed-search-update :force))
-
-(defvar elfeed-search-mode-map
- (let ((map (make-sparse-keymap)))
- (prog1 map
- (suppress-keymap map)
- (define-key map "q" 'quit-window)
- (define-key map "g" 'elfeed-search-update--force)
- (define-key map "G" 'elfeed-update)
- (define-key map (kbd "RET") 'elfeed-search-show-entry)
- (define-key map "s" 'elfeed-search-live-filter)
- (define-key map "S" 'elfeed-search-set-filter)
- (define-key map "b" 'elfeed-search-browse-url)
- (define-key map "y" 'elfeed-search-yank)
- (define-key map "u" 'elfeed-search-tag-all-unread)
- (define-key map "r" 'elfeed-search-untag-all-unread)
- (define-key map "n" 'next-line)
- (define-key map "p" 'previous-line)
- (define-key map "+" 'elfeed-search-tag-all)
- (define-key map "-" 'elfeed-search-untag-all)))
- "Keymap for elfeed-search-mode.")
-
-(defun elfeed-search-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)
- (buffer-disable-undo)
- (hl-line-mode)
- (make-local-variable 'elfeed-search-entries)
- (make-local-variable 'elfeed-search-filter)
- (when (null elfeed-search-refresh-timer)
- (setf elfeed-search-refresh-timer
- (run-at-time elfeed-search-refresh-rate elfeed-search-refresh-rate
- #'elfeed-search-update)))
- (add-hook 'kill-buffer-hook #'elfeed-db-save t t)
- (add-hook 'kill-buffer-hook
- (lambda ()
- (ignore-errors (cancel-timer elfeed-search-refresh-timer))
- (setf elfeed-search-refresh-timer nil))
- t t)
- (elfeed-search-update :force)
- (run-hooks 'elfeed-search-mode-hook))
-
-(defun elfeed-search-buffer ()
- (get-buffer-create "*elfeed-search*"))
-
-(defun elfeed-search-format-date (date)
- "Format a date for printing in elfeed-search-mode."
- (let ((string (format-time-string "%Y-%m-%d" (seconds-to-time date))))
- (format "%-10.10s" 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-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)
-
-(defcustom elfeed-search-title-max-width 70
- "Maximum column width for titles in the elfeed-search buffer.
-Clear `elfeed-search-cache' (or restart Emacs) after setting."
- :group 'elfeed
- :type 'integer)
-
-(defcustom elfeed-search-title-min-width 16
- "Minimum column width for titles in the elfeed-search buffer.
-Clear `elfeed-search-cache' (or restart Emacs) after setting."
- :group 'elfeed
- :type 'integer)
-
-(defcustom elfeed-search-trailing-width 30
- "Space reserved for displaying the feed and tag information.
-Clear `elfeed-search-cache' (or restart Emacs) after setting."
- :group 'elfeed
- :type 'integer)
-
-(defun elfeed-search-print (entry)
- "Print ENTRY to the buffer."
- (let* ((date (elfeed-search-format-date (elfeed-entry-date entry)))
- (title (or (elfeed-entry-title entry) ""))
- (title-faces '(elfeed-search-title-face))
- (feed (elfeed-entry-feed entry))
- (feed-title (if feed (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)))
- (when (elfeed-tagged-p 'unread entry)
- (push 'bold title-faces))
- (insert (propertize date 'face 'elfeed-search-date-face) " ")
- (insert (propertize title-column 'face title-faces) " ")
- (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."
- (let ((must-have ())
- (must-not-have ())
- (after nil)
- (matches ())
- (not-matches ()))
- (cl-loop for element in (split-string filter)
- for type = (aref element 0)
- do (cl-case type
- (?+ (push (intern (substring element 1)) must-have))
- (?- (push (intern (substring element 1)) must-not-have))
- (?@ (setf after (elfeed-time-duration (substring element 1))))
- (?! (let ((re (substring element 1)))
- (when (elfeed-valid-regexp-p re)
- (push re not-matches))))
- (otherwise (when (elfeed-valid-regexp-p element)
- (push element matches)))))
- (list after must-have must-not-have matches not-matches)))
-
-(defun elfeed-search-filter (filter entry feed)
- "Filter out only entries that match the filter. See
-`elfeed-search-set-filter' for format/syntax documentation."
- (cl-destructuring-bind (after must-have must-not-have matches not-matches) filter
- (let* ((tags (elfeed-entry-tags entry))
- (date (elfeed-entry-date entry))
- (age (- (float-time) date))
- (title (elfeed-entry-title entry))
- (link (elfeed-entry-link entry))
- (feed-title (or (elfeed-feed-title feed) "")))
- (when (and after (> age after))
- (elfeed-db-return))
- (and (cl-every (lambda (tag) (member tag tags)) must-have)
- (cl-notany (lambda (tag) (member 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))
- (and feed-title (string-match-p m feed-title))))
- matches))
- (cl-notany (lambda (m)
- (or (and title (string-match-p m title))
- (and link (string-match-p m link))
- (and feed-title (string-match-p m feed-title))))
- not-matches)))))
-
-(defun elfeed-search--prompt (current)
- "Prompt for a new filter, starting with CURRENT."
- (read-from-minibuffer
- "Filter: "
- (if (or (string= "" current)
- (string-match-p " $" current))
- current
- (concat current " "))
- nil nil 'elfeed-search-filter-history))
-
-(defun elfeed-search-set-filter (new-filter)
- "Set a new search filter for the elfeed-search buffer.
-
-When given a prefix argument, the current filter is not displayed
-in the minibuffer when prompting for a new filter.
-
-Any component beginning with a + or - is treated as a tag. If +
-the tag must be present on the entry. If - the tag must *not* be
-present on the entry. Ex. \"+unread\" or \"+unread -comic\".
-
-Any component beginning with an @ is an age limit. No posts older
-than this are allowed. Ex. \"@3-days-ago\" or \"@1-year-old\".
-
-Every other space-seperated element is treated like a regular
-expression, matching against entry link, title, and feed title."
- (interactive (list (elfeed-search--prompt
- (if current-prefix-arg "" elfeed-search-filter))))
- (with-current-buffer (elfeed-search-buffer)
- (setf elfeed-search-filter new-filter)
- (elfeed-search-update :force)))
-
-(defun elfeed-search-insert-header-text (text)
- "Insert TEXT into buffer using header face."
- (insert (propertize text 'face '(widget-inactive italic))))
-
-(defun elfeed-search-insert-intro-header ()
- "Insert the intro header with buttons."
- (cl-flet ((button (f)
- (insert-button (symbol-name f)
- 'follow-link t
- 'action (lambda (_) (call-interactively f)))))
- (elfeed-search-insert-header-text "Database empty. Use ")
- (button 'elfeed-add-feed)
- (elfeed-search-insert-header-text ", or ")
- (button 'elfeed-load-opml)
- (elfeed-search-insert-header-text ", or ")
- (button 'elfeed-update)
- (elfeed-search-insert-header-text ".")))
-
-(defun elfeed-search-insert-header ()
- "Insert a one-line status header."
- (if (or elfeed-waiting elfeed-connections)
- (elfeed-search-insert-header-text
- (format "%d feeds pending, %d in process ..."
- (length elfeed-waiting) (length elfeed-connections)))
- (let ((time (seconds-to-time (elfeed-db-last-update))))
- (if (zerop (float-time time))
- (elfeed-search-insert-intro-header)
- (elfeed-search-insert-header-text
- (format "Database last updated %s"
- (format-time-string "%A, %B %d %Y %H:%M:%S %Z" time)))))))
-
-(defun elfeed-search--update-list ()
- "Update `elfeed-search-filter' list."
- (let* ((filter (elfeed-search-parse-filter elfeed-search-filter))
- (head (list nil))
- (tail head))
- (with-elfeed-db-visit (entry feed)
- (when (elfeed-search-filter filter entry feed)
- (setf (cdr tail) (list entry)
- tail (cdr tail))))
- (setf elfeed-search-entries
- (if (eq elfeed-sort-order 'ascending)
- (nreverse (cdr head))
- (cdr head)))))
-
-(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 display to match the database."
- (interactive)
- (with-current-buffer (elfeed-search-buffer)
- (if (or force (and (not elfeed-search-live)
- (< elfeed-search-last-update (elfeed-db-last-update))))
- (elfeed-save-excursion
- (let ((inhibit-read-only t)
- (standard-output (current-buffer)))
- (erase-buffer)
- (elfeed-search-insert-header)
- (insert "\n")
- (elfeed-search--update-list)
- (cl-loop for entry in elfeed-search-entries
- when (gethash (list (window-width) entry)
- elfeed-search-cache)
- do (insert it)
- else
- do (insert
- (with-temp-buffer
- (elfeed-search-print entry)
- (setf (gethash (list (window-width)
- (copy-sequence entry))
- elfeed-search-cache)
- (buffer-string))))
- do (insert "\n"))
- (insert "End of entries.\n")
- (setf elfeed-search-last-update (float-time))))
- (let ((inhibit-read-only t))
- (elfeed-save-excursion
- (goto-char (point-min))
- (elfeed-kill-line)
- (elfeed-search-insert-header))))))
-
-(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)
- (elfeed-search-print 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)
- "Return a list of the currently selected feeds."
- (let ((use-region (and (not ignore-region) (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 (car selected) selected))))))
-
-(defun elfeed-search-browse-url ()
- "Visit the current entry in your browser using `browse-url'."
- (interactive)
- (let ((entries (elfeed-search-selected)))
- (cl-loop for entry in entries
- do (elfeed-untag entry 'unread)
- when (elfeed-entry-link entry)
- do (browse-url it))
- (mapc #'elfeed-search-update-entry entries)
- (unless (use-region-p) (forward-line))))
-
-(defun elfeed-search-yank ()
- "Copy the selected feed item to "
- (interactive)
- (let* ((entry (elfeed-search-selected :ignore-region))
- (link (and entry (elfeed-entry-link entry))))
- (when entry
- (elfeed-untag entry 'unread)
- (x-set-selection elfeed-search-clipboard-type link)
- (message "Copied: %s" link)
- (elfeed-search-update-line)
- (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)))
- (cl-loop for entry in entries do (elfeed-tag entry 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)))
- (cl-loop for entry in entries do (elfeed-untag entry 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)))
- (when (elfeed-entry-p entry)
- (elfeed-untag entry 'unread)
- (elfeed-search-update-entry entry)
- (forward-line)
- (elfeed-show-entry entry)))
-
-;; Live Filters
-
-(defun elfeed-search--minibuffer-setup ()
- "Set up the minibuffer for live filtering."
- (when elfeed-search-live
- (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 elfeed-search-live
- (let ((buffer (elfeed-search-buffer))
- (current-filter (minibuffer-contents-no-properties)))
- (when buffer
- (with-current-buffer buffer
- (let ((elfeed-search-filter current-filter))
- (elfeed-search-update :force)))))))
-
-(defun elfeed-search-live-filter ()
- "Filter the elfeed-search buffer as the filter is written."
- (interactive)
- (unwind-protect
- (let ((elfeed-search-live t))
- (setq elfeed-search-filter
- (read-from-minibuffer "Filter: " elfeed-search-filter)))
- (elfeed-search-update :force)))
-
-;;; elfeed-search.el ends here
+++ /dev/null
-;;; elfeed-show.el --- display feed entries -*- lexical-binding: t; -*-
-
-;; This is free and unencumbered software released into the public domain.
-
-;;; Code:
-
-(require 'cl-lib)
-(require 'shr)
-(require 'url-parse)
-(require 'browse-url)
-(require 'message) ; faces
-(require 'elfeed-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 'bool)
-
-(defvar elfeed-show-entry nil
- "The entry being displayed in this buffer.")
-
-(defvar elfeed-show-mode-map
- (let ((map (make-sparse-keymap)))
- (prog1 map
- (suppress-keymap map)
- (define-key map "q" 'elfeed-kill-buffer)
- (define-key map "g" 'elfeed-show-refresh)
- (define-key map "n" 'elfeed-show-next)
- (define-key map "p" 'elfeed-show-prev)
- (define-key map "s" 'elfeed-show-new-live-search)
- (define-key map "b" 'elfeed-show-visit)
- (define-key map "y" 'elfeed-show-yank)
- (define-key map "u" (elfeed-expose #'elfeed-show-tag 'unread))
- (define-key map "+" 'elfeed-show-tag)
- (define-key map "-" 'elfeed-show-untag)
- (define-key map (kbd "SPC") 'scroll-up-command)
- (define-key map (kbd "DEL") 'scroll-down-command)
- (define-key map "\t" 'shr-next-link)
- (define-key map [tab] 'shr-next-link)
- (define-key map "\e\t" 'shr-previous-link)
- (define-key map [backtab] 'shr-previous-link)
- (define-key map [mouse-2] 'shr-browse-url)))
- "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-hooks 'elfeed-show-mode-hook))
-
-(defun elfeed-insert-html (html &optional base-url)
- "Converted HTML markup to a propertized string."
- (shr-insert-document
- (if (elfeed-libxml-supported-p)
- (with-temp-buffer
- ;; insert <base> to work around libxml-parse-html-region bug
- (insert (format "<base href=\"%s\">" base-url))
- (insert html)
- (libxml-parse-html-region (point-min) (point-max) base-url))
- '(i () "Elfeed: libxml2 functionality is unavailable"))))
-
-(cl-defun elfeed-insert-link (url &optional (content url))
- "Insert a clickable hyperlink to URL titled CONTENT."
- (when (and elfeed-show-truncate-long-urls
- (integerp shr-width)
- (> (length content) (- shr-width 8)))
- (let ((len (- (/ shr-width 2) 10)))
- (setq content (format "%s[...]%s"
- (substring content 0 len)
- (substring content (- len))))))
- (elfeed-insert-html (format "<a href=\"%s\">%s</a>" url content)))
-
-(defun elfeed-compute-base (url)
- "Return the base URL for URL, useful for relative paths."
- (let ((obj (url-generic-parse-url url)))
- (setf (url-filename obj) nil)
- (setf (url-target obj) nil)
- (url-recreate-url obj)))
-
-(defun elfeed-show-refresh ()
- "Update the buffer to match the selected entry."
- (interactive)
- (let* ((inhibit-read-only t)
- (title (elfeed-entry-title elfeed-show-entry))
- (date (seconds-to-time (elfeed-entry-date elfeed-show-entry)))
- (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)))
- (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-entry (entry)
- "Display ENTRY in the current buffer."
- (let ((title (elfeed-entry-title entry)))
- (switch-to-buffer (get-buffer-create (format "*elfeed %s*" title)))
- (unless (eq major-mode 'elfeed-show-mode)
- (elfeed-show-mode))
- (setq elfeed-show-entry entry)
- (elfeed-show-refresh)))
-
-(defun elfeed-show-next ()
- "Show the next item in the elfeed-search buffer."
- (interactive)
- (elfeed-kill-buffer)
- (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)
- (elfeed-kill-buffer)
- (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 ()
- "Visit the current entry in the browser."
- (interactive)
- (let ((link (elfeed-entry-link elfeed-show-entry)))
- (when link
- (message "Sent to browser: %s" 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
- (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)))
-
-(provide 'elfeed-show)
-
-;;; elfeed-show.el ends here
+++ /dev/null
-;;; elfeed.el --- an Emacs Atom/RSS feed reader -*- lexical-binding: t; -*-
-
-;; This is free and unencumbered software released into the public domain.
-
-;; Author: Christopher Wellons <wellonsNOSPAMnullprogram.com>
-;; URL: https://github.com/skeeto/elfeed
-
-;;; Commentary:
-
-;; Elfreed is a web feed client for Emacs, inspired by notmuch. See
-;; the README for full documentation.
-
-;; Elfreed requires Emacs 24 (lexical closures).
-
-;;; History:
-
-;; Version 1.1.2: fixes
-;; * Fixed support for non-HTTP protocols
-;; * Add ! search syntax
-;; * Add elfeed-unjam
-;; * Combine regexp search terms by AND instead of OR
-;; * Link navigation keybindings (tab)
-;; * Add elfeed-show-truncate-long-urls
-;; * Add elfeed-search-filter customization
-;; * Various bug fixes
-;; Version 1.1.1: fixes
-;; * Fix database corruption issue
-;; * Properly handle URLs from XML
-;; * Slightly better RSS date guessing
-;; * User interface tweaks
-;; * Add `elfeed-sort-order'
-;; * Use tab and backtab to move between links
-;; Version 1.1.0: features and fixes
-;; * Autotagging support
-;; * Better database performance
-;; * Database packing
-;; * Arbitrary struct metadata
-;; * Added `elfeed-search-clipboard-type'
-;; * Update to cl-lib from cl
-;; * Lots of bug fixes
-;; Version 1.0.1: features and fixes
-;; * Live filter editing
-;; * Support for RSS 1.0
-;; * OPML import/export
-;; * Fix multibyte support (thanks cellscape)
-;; * Fix date-change database corruption
-;; * Add n and p bindings to elfeed-search, like notmuch
-;; * Friendlier intro header
-;; * Automated builds
-;; * Lots of small bug fixes
-;; Version 1.0.0: initial public release
-
-;;; Code:
-
-(require 'cl-lib)
-(require 'xml)
-(require 'xml-query)
-(require 'url-parse)
-
-(defgroup elfeed nil
- "An Emacs web feed reader."
- :group 'comm)
-
-(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 'list)
-
-(provide 'elfeed)
-
-(require 'elfeed-search)
-(require 'elfeed-lib)
-(require 'elfeed-db)
-
-(defcustom elfeed-initial-tags '(unread)
- "Initial tags for new entries."
- :group 'elfeed
- :type 'list)
-
-;; Fetching:
-
-(defcustom elfeed-max-connections
- ;; Windows Emacs cannot open many sockets at once.
- (if (or (not (and (fboundp 'gnutls-available-p) (gnutls-available-p)))
- (eq system-type 'windows-nt))
- 1
- 4)
- "The maximum number of feeds to be fetched in parallel."
- :group 'elfeed
- :type 'integer)
-
-(defvar elfeed-connections nil
- "List of callbacks awaiting responses.")
-
-(defvar elfeed-waiting nil
- "List of requests awaiting connections.")
-
-(defvar elfeed--connection-counter 0
- "Provides unique connection identifiers.")
-
-(defun elfeed--check-queue ()
- "Start waiting connections if connection slots are available."
- (while (and elfeed-waiting
- (< (length elfeed-connections) elfeed-max-connections))
- (let ((request (pop elfeed-waiting)))
- (cl-destructuring-bind (_ url cb) request
- (push request elfeed-connections)
- (condition-case error
- (url-retrieve url cb nil :silent)
- (error (with-temp-buffer (funcall cb (list :error error)))))))))
-
-(defun elfeed--wrap-callback (id cb)
- "Return a function that manages the elfeed queue."
- (lambda (status)
- (unwind-protect
- (funcall cb status)
- (setf elfeed-connections (cl-delete id elfeed-connections :key #'car))
- (elfeed--check-queue))))
-
-(defun elfeed-fetch (url callback)
- "Basically wraps `url-retrieve' but uses the connection limiter."
- (let* ((id (cl-incf elfeed--connection-counter))
- (cb (elfeed--wrap-callback id callback)))
- (push (list id url cb) elfeed-waiting)
- (elfeed--check-queue)))
-
-(defmacro with-elfeed-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'."
- (declare (indent defun))
- `(elfeed-fetch ,url (lambda (status) ,@body (kill-buffer))))
-
-(defun elfeed-unjam ()
- "Manually clear the connection pool when connections fail to timeout.
-This is a short-term workaround for connection handling issues."
- (interactive)
- (let ((fails (mapcar #'cl-second elfeed-connections)))
- (when fails
- (message "Elfeed aborted feeds: %s" (mapconcat #'identity fails " ")))
- (setf elfeed-connections nil)
- (elfeed--check-queue)))
-
-;; Parsing:
-
-(defun elfeed-feed-type (content)
- "Return the feed type given the parsed content (:atom, :rss) 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-entries-from-atom (url xml)
- "Turn parsed Atom content into a list of elfeed-entry structs."
- (let* ((feed-id url)
- (feed (elfeed-db-get-feed feed-id))
- (title (elfeed-cleanup (xml-query '(feed title *) xml)))
- (autotags (elfeed-feed-autotags url)))
- (setf (elfeed-feed-url feed) url
- (elfeed-feed-title feed) title)
- (cl-loop for entry in (xml-query-all '(feed entry) xml) collect
- (let* ((title (or (xml-query '(title *) entry) ""))
- (anylink (xml-query '(link :href) entry))
- (altlink (xml-query '(link [rel "alternate"] :href) entry))
- (link (or altlink anylink))
- (date (or (xml-query '(published *) entry)
- (xml-query '(updated *) entry)
- (xml-query '(date *) entry)))
- (content (or (xml-query '(content *) entry)
- (xml-query '(summary *) entry)))
- (id (or (xml-query '(id *) entry) link
- (elfeed-generate-id content)))
- (type (or (xml-query '(content :type) entry)
- (xml-query '(summary :type) entry)
- ""))
- (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))))
- (elfeed-entry--create
- :title (elfeed-cleanup title)
- :feed-id feed-id
- :id (cons feed-id (elfeed-cleanup id))
- :link (elfeed-cleanup link)
- :tags (elfeed-normalize-tags autotags elfeed-initial-tags)
- :date (elfeed-float-time date)
- :content content
- :enclosures enclosures
- :content-type (if (string-match-p "html" type) 'html nil))))))
-
-(defun elfeed-entries-from-rss (url xml)
- "Turn parsed RSS content into a list of elfeed-entry structs."
- (let* ((feed-id 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 (or (xml-query '(link *) item) guid))
- (date (or (xml-query '(pubDate *) item)
- (xml-query '(date *) item)))
- (description (xml-query '(description *) item))
- (id (or guid link (elfeed-generate-id description)))
- (full-id (cons feed-id (elfeed-cleanup id)))
- (original (elfeed-db-get-entry full-id))
- (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))))
- (elfeed-entry--create
- :title (elfeed-cleanup title)
- :id full-id
- :feed-id feed-id
- :link (elfeed-cleanup link)
- :tags (elfeed-normalize-tags autotags elfeed-initial-tags)
- :date (if (and original (null date))
- (elfeed-entry-date original)
- (elfeed-float-time date))
- :enclosures enclosures
- :content description
- :content-type 'html)))))
-
-(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)
- (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 (xml-query '(description *) item))
- (id (or link (elfeed-generate-id description)))
- (full-id (cons feed-id (elfeed-cleanup id)))
- (original (elfeed-db-get-entry full-id)))
- (elfeed-entry--create
- :title (elfeed-cleanup title)
- :id full-id
- :feed-id feed-id
- :link (elfeed-cleanup link)
- :tags (elfeed-normalize-tags autotags elfeed-initial-tags)
- :date (if (and original (null date))
- (elfeed-entry-date original)
- (elfeed-float-time date))
- :content description
- :content-type 'html)))))
-
-(defun elfeed-feed-list ()
- "Return a flat list version of `elfeed-feeds'.
-Only a list of strings will be returned."
- (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-update-feed (url)
- "Update a specific feed."
- (interactive (list (completing-read "Feed: " (elfeed-feed-list))))
- (with-elfeed-fetch url
- (if (and status (eq (car status) :error))
- (let ((print-escape-newlines t))
- (message "Elfeed update failed for %s: %S" url status))
- (condition-case error
- (progn
- (elfeed-move-to-first-empty-line)
- (set-buffer-multibyte t)
- (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 "Unknown feed type.")))))
- (elfeed-db-add entries)))
- (error (message "Elfeed update failed for %s: %s" url error))))))
-
-(defun elfeed-add-feed (url)
- "Manually add a feed to the database."
- (interactive (list
- (let ((clipboard (elfeed-cleanup (elfeed-clipboard-get))))
- (read-from-minibuffer
- "URL: " (when (elfeed-looks-like-url-p clipboard)
- clipboard)))))
- (cl-pushnew url elfeed-feeds)
- (when (called-interactively-p 'any)
- (customize-save-variable 'elfeed-feeds elfeed-feeds))
- (elfeed-update-feed url))
-
-;;;###autoload
-(defun elfeed-update ()
- "Update all the feeds in `elfeed-feeds'."
- (interactive)
- (message "Elfeed update: %s" (format-time-string "%B %e %Y %H:%M:%S %Z"))
- (mapc #'elfeed-update-feed (elfeed-feed-list))
- (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))
- (elfeed-search-update))
-
-;; New entry filtering
-
-(cl-defun elfeed-make-tagger
- (&key feed-title feed-url entry-title entry-link after before
- add remove callback)
- "Create a function that adds or removes tags on matching entries.
-
-FEED-TITLE, FEED-URL, ENTRY-TITLE, and ENTRY-LINK are regular
-expressions or a list (not <regex>), which indicates a negative
-match. AFTER and BEFORE are relative times (see
-`elfeed-time-duration'). Entries must match all provided
-expressions. If an entry matches, add tags ADD and remove tags
-REMOVE.
-
-Examples,
-
- (elfeed-make-tagger :feed-url \"youtube\\\\.com\"
- :add '(video youtube))
-
- (elfeed-make-tagger :before \"1 week ago\"
- :remove 'unread)
-
- (elfeed-make-tagger :feed-url \"example\\\\.com\"
- :entry-title '(not \"something interesting\")
- :add 'junk)
-
-The returned function should be added to `elfeed-new-entry-hook'."
- (let ((after-time (and after (elfeed-time-duration after)))
- (before-time (and before (elfeed-time-duration before))))
- (when (and add (symbolp add)) (setf add (list add)))
- (when (and remove (symbolp remove)) (setf remove (list remove)))
- (lambda (entry)
- (let ((feed (elfeed-entry-feed entry))
- (date (elfeed-entry-date entry))
- (case-fold-search t))
- (cl-flet ((match (r s)
- (or (null r)
- (if (listp r)
- (not (string-match-p (cl-second r) s))
- (string-match-p r s)))))
- (when (and
- (match feed-title (elfeed-feed-title feed))
- (match feed-url (elfeed-feed-url feed))
- (match entry-title (elfeed-entry-title entry))
- (match entry-link (elfeed-entry-link entry))
- (or (not after-time) (> date (- (float-time) after-time)))
- (or (not before-time) (< date (- (float-time) before-time))))
- (when add
- (apply #'elfeed-tag entry add))
- (when remove
- (apply #'elfeed-untag entry remove))
- (when callback
- (funcall callback entry))
- entry))))))
-
-;; OPML
-
-(defun elfeed--parse-opml (xml)
- "Parse XML (from `xml-parse-region') into `elfeed-feeds' list."
- (cl-loop for (tag attr . content) in (cl-remove-if-not #'listp xml)
- count tag into work-around-bug ; bug#15326
- when (assoc 'xmlUrl attr) collect (cdr it)
- else append (elfeed--parse-opml content)))
-
-;;;###autoload
-(defun elfeed-load-opml (file)
- "Load feeds from an OPML file into `elfeed-feeds'.
-When called interactively, the changes to `elfeed-feeds' are
-saved to your customization file."
- (interactive "fOPML file: ")
- (let* ((xml (xml-parse-file file))
- (feeds (elfeed--parse-opml xml))
- (full (append feeds elfeed-feeds)))
- (prog1 (setf elfeed-feeds (cl-delete-duplicates full :test #'string=))
- (when (called-interactively-p 'any)
- (customize-save-variable 'elfeed-feeds elfeed-feeds)
- (message "%d feeds loaded from %s" (length feeds) file)))))
-
-;;;###autoload
-(defun elfeed-export-opml (file)
- "Export the current feed listing to OPML-formatted FILE."
- (interactive "FOutput OPML file: ")
- (with-temp-file file
- (let ((standard-output (current-buffer)))
- (princ "<?xml version=\"1.0\"?>\n")
- (xml-print
- `((opml ((version . "1.0"))
- (head () (title () "Elfeed Export"))
- (body ()
- ,@(cl-loop for url in (elfeed-feed-list)
- for feed = (elfeed-db-get-feed url)
- for title = (or (elfeed-feed-title feed) "")
- collect `(outline ((xmlUrl . ,url)
- (title . ,title)))))))))))
-
-;;; elfeed.el ends here
+++ /dev/null
-;;; xml-query.el --- query engine complimenting the xml package
-
-;; This is free and unencumbered software released into the public domain.
-
-;;; Commentary:
-
-;; This provides a very rudimentary s-expression oriented, jQuery-like
-;; XML query 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'.
-
-;; 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-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 '*)
- (let ((strings (cl-remove-if-not #'stringp (xml-query--append xml))))
- (when strings
- (mapconcat #'identity strings " "))))
- (: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 (stringp result)
- result
- (car (xml-query-all query xml)))))
-
-(provide 'xml-query)
-
-;;; xml-query.el ends here
--- /dev/null
+;;; elfeed-autoloads.el --- automatically extracted autoloads
+;;
+;;; Code:
+(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
+\f
+;;;### (autoloads nil "elfeed" "elfeed.el" (21908 14285 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)
+
+;;;***
+\f
+;;;### (autoloads nil nil ("elfeed-db.el" "elfeed-lib.el" "elfeed-pkg.el"
+;;;;;; "elfeed-search.el" "elfeed-show.el" "xml-query.el") (21908
+;;;;;; 14285 676992 0))
+
+;;;***
+\f
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; End:
+;;; elfeed-autoloads.el ends here
--- /dev/null
+;;; elfeed-db.el --- database and model for elfeed -*- lexical-binding: t; -*-
+
+;; This is free and unencumbered software released into the public domain.
+
+;;; Commentary:
+
+;; Elfeed is aware of two type of things: feeds and entries. All dates
+;; are stored as floating point epoch seconds.
+
+;; Feeds are keyed by their user-provided feed URL, which acts as the
+;; feed identity regardless of any other stated identity. Feeds have a
+;; list of entries.
+
+;; Entries are keyed in order of preference by id (Atom), guid (RSS),
+;; or link. To avoid circular references, entries refer to their
+;; parent feeds by URL.
+
+;; Feed content is stored in a content-addressable loose-file
+;; database, very similar to an unpacked Git object database. Entries
+;; have references to items in this database (elfeed-ref), keeping the
+;; actual entry struct memory footprint small. Most importantly, this
+;; keeps the core index small so that it can quickly be written as a
+;; whole to the filesystem. The wire format is just the s-expression
+;; print form of the top-level hash table.
+
+;; The database can be compacted into a small number of compressed
+;; files with the interactive function `elfeed-db-compact'. This could
+;; be used as a kill-emacs hook.
+
+;; An AVL tree containing all database entries ordered by date is
+;; maintained as part of the database. We almost always want to look
+;; at entries ordered by date and this step accomplished that very
+;; efficiently with the AVL tree. This is the reasoning behind the
+;; `with-elfeed-db-visit' interface.
+
+;; Unfortunately there's a nasty bug (bug#15190) in the reader that
+;; makes hash tables and `print-circle' incompatible. It's been fixed
+;; in trunk, but many users will likely be stuck with this bug for the
+;; next few years. This means the database format can't exploit
+;; circular references.
+
+;; Entry and feed objects can have arbitrary metadata attached,
+;; automatically stored in the database. The setf-able `elfeed-meta'
+;; function is used to access these.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'avl-tree)
+(require 'elfeed-lib)
+
+(defcustom elfeed-db-directory "~/.elfeed"
+ "Directory where elfeed will store its database."
+ :group 'elfeed
+ :type 'directory)
+
+(defvar elfeed-db nil
+ "The core database for elfeed.")
+
+(defvar elfeed-db-feeds nil
+ "Feeds hash table, part of `elfeed-db'.")
+
+(defvar elfeed-db-entries nil
+ "Entries hash table, part of `elfeed-db'.")
+
+(defvar elfeed-db-index nil
+ "Collection of all entries sorted by date, part of `elfeed-db'.")
+
+(defvar elfeed-db-version "0.0.2"
+ "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 cutoms 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.")
+
+;; 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)
+ (elfeed-entry-meta b) (elfeed-entry-meta a))
+ (not
+ (zerop
+ (cl-loop for i from 0 below (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."
+ (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 (copy-sequence (apply #'append tags more-tags))))
+ (cl-remove-duplicates (cl-sort all #'string< :key #'symbol-name))))
+
+(defun elfeed-tag (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 (entry &rest tags)
+ "Remove TAGS from ENTRY."
+ (setf (elfeed-entry-tags entry)
+ (cl-loop for tag in (elfeed-entry-tags entry)
+ unless (member tag tags) collect tag)))
+
+(defun elfeed-tagged-p (tag entry)
+ "Return true if ENTRY is tagged by TAG."
+ (member 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)
+ (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))
+ (prin1 elfeed-db)
+ :success))))
+
+(defun elfeed-db-upgrade ()
+ "Upgrade the database from a previous format.
+This function increases the size of the structs in the database."
+ (cl-loop with feed-size = (length (elfeed-feed--create))
+ for feed hash-values in elfeed-db-feeds
+ using (hash-key id)
+ unless (elfeed-feed-p feed)
+ do (setf (gethash id elfeed-db-feeds)
+ (elfeed-resize-vector feed feed-size)))
+ (cl-loop with entry-size = (length (elfeed-entry--create))
+ for entry hash-values in elfeed-db-entries
+ using (hash-key id)
+ unless (elfeed-entry-p entry)
+ do (setf (gethash id elfeed-db-entries)
+ (elfeed-resize-vector entry entry-size)))
+ (plist-put elfeed-db :version elfeed-db-version)
+ elfeed-db-version)
+
+(defun elfeed-db-load ()
+ "Load the database index from the filesystem."
+ (let ((index (expand-file-name "index" elfeed-db-directory)))
+ (if (not (file-exists-p index))
+ (let ((db (setf elfeed-db (list :version elfeed-db-version))))
+ (plist-put db :feeds (make-hash-table :test 'equal))
+ (plist-put db :entries (make-hash-table :test 'equal))
+ ;; Compiler will warn about this (bug#15327):
+ (plist-put db :index (avl-tree-create #'elfeed-db-compare)))
+ (with-current-buffer (find-file-noselect index)
+ (goto-char (point-min))
+ (setf elfeed-db (read (current-buffer)))
+ (kill-buffer)))
+ (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)
+ (when (version< (or (plist-get elfeed-db :version) "0") elfeed-db-version)
+ (elfeed-db-upgrade))))
+
+(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")))
+ (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))
+
+(provide 'elfeed-db)
+
+;;; elfeed-db.el ends here
--- /dev/null
+;;; elfeed-lib.el --- misc functions for elfeed -*- lexical-binding: t; -*-
+
+;; This is free and unencumbered software released into the public domain.
+
+;;; Commentary:
+
+;; These are general functions that aren't specific to web feeds. It's
+;; a library of useful functions to Elfeed.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'time-date)
+(require 'url-parse)
+
+(defun elfeed-expose (function &rest args)
+ "Return an interactive version of FUNCTION, 'exposing' it to the user."
+ (lambda () (interactive) (apply function args)))
+
+(defun elfeed-goto-line (n)
+ "Like `goto-line' but for non-interactive use."
+ (goto-char (point-min))
+ (forward-line (1- n)))
+
+(defun elfeed-kill-buffer ()
+ "Kill the current buffer."
+ (interactive)
+ (kill-buffer (current-buffer)))
+
+(defun elfeed-kill-line ()
+ "Clear out the current line without touching anything else."
+ (beginning-of-line)
+ (let ((start (point)))
+ (end-of-line)
+ (delete-region start (point))))
+
+(defun elfeed-time-duration (time)
+ "Turn a time expression into a number of seconds. Uses
+`timer-duration' but allows a bit more flair."
+ (if (numberp time)
+ time
+ (when (string-match-p "[[:alpha:]]" time)
+ (let ((clean (replace-regexp-in-string "\\(ago\\|old\\|-\\)" " " time)))
+ (timer-duration clean)))))
+
+(defun elfeed-looks-like-url-p (string)
+ "Return true if STRING looks like it could be a URL."
+ (and (stringp string)
+ (not (string-match-p "[ \n\t\r]" string))
+ (not (null (url-type (url-generic-parse-url string))))))
+
+(defun elfeed-format-column (string width &optional align)
+ "Return STRING truncated or padded to WIDTH following ALIGNment.
+Align should be a keyword :left or :right."
+ (if (<= width 0)
+ ""
+ (format (format "%%%s%d.%ds" (if (eq align :left) "-" "") width width)
+ string)))
+
+(defun elfeed-clamp (min value max)
+ "Clamp a value between two values."
+ (min max (max min value)))
+
+(defun elfeed-valid-regexp-p (regexp)
+ "Return t if REGEXP is a valid REGEXP."
+ (ignore-errors
+ (prog1 t
+ (string-match-p regexp ""))))
+
+(defun elfeed-cleanup (name)
+ "Trim trailing and leading spaces and collapse multiple spaces."
+ (let ((trim (replace-regexp-in-string "[\n\t]+" " " (or name ""))))
+ (replace-regexp-in-string "^ +\\| +$" "" trim)))
+
+(defun elfeed-parse-simple-iso-8601 (string)
+ "Attempt to parse STRING as a simply formatted ISO 8601 date.
+Examples: 2015-02-22, 2015-02, 20150222"
+ (save-match-data
+ (let ((re "^\\([0-9]\\{4\\}\\)-?\\([0-9]\\{2\\}\\)-?\\([0-9]\\{2\\}\\)?$")
+ (clean (elfeed-cleanup string)))
+ (when (string-match re clean)
+ (let ((year (string-to-number (match-string 1 clean)))
+ (month (string-to-number (match-string 2 clean)))
+ (day (string-to-number (or (match-string 3 clean) "1"))))
+ (when (and (>= year 1900) (< year 2200))
+ (float-time (encode-time 0 0 0 day month year t))))))))
+
+(defun elfeed-float-time (&optional date)
+ "Like `float-time' but accept anything reasonable for DATE,
+defaulting to the current time 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))))
+ (if (equal time '(14445 17280)) ; date-to-time silently failed
+ (float-time)
+ (float-time time))))))))
+ (integer date)
+ (list (float-time date))
+ (otherwise (float-time))))
+
+(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."
+ (let ((coding-system nil))
+ (progn
+ (unless beg (setq beg (point-min)))
+ (unless end (setq end (point-max)))
+ (goto-char beg)
+ (if (re-search-forward
+ "<\\?xml.*?encoding=[\"']\\([^\"']+\\)[\"'].*?\\?>" nil t)
+ (setq coding-system
+ (ignore-errors (check-coding-system
+ (intern (downcase (match-string 1)))))))
+ (when coding-system
+ (setq end (+ beg
+ (decode-coding-region beg end coding-system))))
+ (goto-char beg)))
+ (xml-parse-region beg end buffer parse-dtd parse-ns))
+
+(defun elfeed-directory-empty-p (dir)
+ "Return non-nil if DIR is empty."
+ (null (cddr (directory-files dir))))
+
+(defun elfeed-slurp (file &optional literally)
+ "Return the contents of FILE as a string."
+ (with-temp-buffer
+ (if literally
+ (insert-file-contents-literally file)
+ (insert-file-contents file))
+ (buffer-string)))
+
+(cl-defun elfeed-spit (file string &key fsync append (encoding 'utf-8))
+ "Write STRING to FILE."
+ (let ((coding-system-for-write encoding)
+ (write-region-inhibit-fsync (not fsync)))
+ (with-temp-buffer
+ (insert string)
+ (write-region nil nil file append 0))))
+
+(defvar elfeed-gzip-supported-p--cache :unknown
+ "To avoid running the relatively expensive test more than once.")
+
+(defun elfeed-gzip-supported-p ()
+ "Return non-nil if `auto-compression-mode' can handle gzip."
+ (if (not (eq elfeed-gzip-supported-p--cache :unknown))
+ elfeed-gzip-supported-p--cache
+ (setf elfeed-gzip-supported-p--cache
+ (and (executable-find "gzip")
+ (ignore-errors
+ (save-window-excursion
+ (let ((file (make-temp-file "gziptest" nil ".gz"))
+ (data (cl-loop for i from 32 to 3200
+ collect i into chars
+ finally
+ (return (apply #'string chars)))))
+ (unwind-protect
+ (progn
+ (elfeed-spit file data)
+ (and (string= data (elfeed-slurp file))
+ (not (string= data (elfeed-slurp file t)))))
+ (delete-file file)))))))))
+
+(defun elfeed-libxml-supported-p ()
+ "Return non-nil if `libxml-parse-html-region' is available."
+ (with-temp-buffer
+ (insert "<html></html>")
+ (and (fboundp 'libxml-parse-html-region)
+ (not (null (libxml-parse-html-region (point-min) (point-max)))))))
+
+(defun elfeed-keyword->symbol (keyword)
+ "If a keyword, convert KEYWORD into a plain symbol (remove the colon)."
+ (if (keywordp keyword)
+ (intern (substring (symbol-name keyword) 1))
+ keyword))
+
+(defun elfeed-resize-vector (vector length)
+ "Return a copy of VECTOR set to size LENGTH."
+ (let ((new-vector (make-vector length nil)))
+ (prog1 new-vector ; don't use dotimes result (bug#16206)
+ (dotimes (i (min (length new-vector) (length vector)))
+ (setf (aref new-vector i) (aref vector i))))))
+
+(defun elfeed-readable-p (value)
+ "Return non-nil if VALUE can be serialized."
+ (condition-case _
+ (prog1 t (read (prin1-to-string value)))
+ (error nil)))
+
+(defun elfeed-strip-properties (string)
+ "Return a copy of STRING with all properties removed.
+If STRING is nil, returns nil."
+ (when string
+ (let ((copy (copy-sequence string)))
+ (prog1 copy
+ (set-text-properties 0 (length copy) nil copy)))))
+
+(defun elfeed-clipboard-get ()
+ "Try to get a sensible value from the system clipboard.
+On systems running X, it will try to use the PRIMARY selection
+first, then fall back onto the standard clipboard like other
+systems."
+ (elfeed-strip-properties
+ (or (and (fboundp 'x-get-selection-value)
+ (funcall 'x-get-selection-value))
+ (and (functionp interprogram-paste-function)
+ (funcall interprogram-paste-function))
+ (and (fboundp 'w32-get-clipboard-data)
+ (funcall 'w32-get-clipboard-data))
+ (current-kill 0 :non-destructively))))
+
+(defun elfeed-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)))))
+
+(provide 'elfeed-lib)
+
+;;; elfeed-lib.el ends here
--- /dev/null
+(define-package "elfeed" "20150608.1302" "an Emacs Atom/RSS feed reader"
+ '((emacs "24.3")))
+;; Local Variables:
+;; no-byte-compile: t
+;; End:
--- /dev/null
+;;; elfeed-search.el --- list feed entries -*- lexical-binding: t; -*-
+
+;; This is free and unencumbered software released into the public domain.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'browse-url)
+(require 'wid-edit) ; widget-inactive face
+
+(provide 'elfeed-search)
+
+(require 'elfeed)
+(require 'elfeed-db)
+(require 'elfeed-lib)
+(require 'elfeed-show)
+
+(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.")
+
+(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, by time."
+ :group 'elfeed
+ :type '(choice (const descending) (const ascending)))
+
+(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)))
+
+(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--offset 2
+ "Offset between line numbers and entry list position.")
+
+(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.")
+
+(defvar elfeed-search-mode-map
+ (let ((map (make-sparse-keymap)))
+ (prog1 map
+ (suppress-keymap map)
+ (define-key map "q" 'quit-window)
+ (define-key map "g" 'elfeed-search-update--force)
+ (define-key map "G" 'elfeed-update)
+ (define-key map (kbd "RET") 'elfeed-search-show-entry)
+ (define-key map "s" 'elfeed-search-live-filter)
+ (define-key map "S" 'elfeed-search-set-filter)
+ (define-key map "b" 'elfeed-search-browse-url)
+ (define-key map "y" 'elfeed-search-yank)
+ (define-key map "u" 'elfeed-search-tag-all-unread)
+ (define-key map "r" 'elfeed-search-untag-all-unread)
+ (define-key map "n" 'next-line)
+ (define-key map "p" 'previous-line)
+ (define-key map "+" 'elfeed-search-tag-all)
+ (define-key map "-" 'elfeed-search-untag-all)))
+ "Keymap for elfeed-search-mode.")
+
+(defun elfeed-search-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)
+ (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 'kill-buffer-hook #'elfeed-db-save t t)
+ (elfeed-search-update :force)
+ (run-hooks 'elfeed-search-mode-hook))
+
+(defun elfeed-search-buffer ()
+ (get-buffer-create "*elfeed-search*"))
+
+(defun elfeed-search-format-date (date)
+ "Format a date for printing in elfeed-search-mode."
+ (let ((string (format-time-string "%Y-%m-%d" (seconds-to-time date))))
+ (format "%-10.10s" 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 :inherit elfeed-search-title-face :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)
+
+(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)
+
+(defun elfeed-search-print (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 (if (elfeed-tagged-p 'unread entry)
+ '(elfeed-search-unread-title-face)
+ '(elfeed-search-title-face)))
+ (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) " ")
+ (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."
+ (let ((must-have ())
+ (must-not-have ())
+ (after nil)
+ (matches ())
+ (not-matches ()))
+ (cl-loop for element in (split-string filter)
+ for type = (aref element 0)
+ do (cl-case type
+ (?+
+ (let ((symbol (intern (substring element 1))))
+ (unless (eq '## symbol)
+ (push symbol must-have))))
+ (?-
+ (let ((symbol (intern (substring element 1))))
+ (unless (eq '## symbol)
+ (push symbol must-not-have))))
+ (?@ (setf after (elfeed-time-duration (substring element 1))))
+ (?! (let ((re (substring element 1)))
+ (when (elfeed-valid-regexp-p re)
+ (push re not-matches))))
+ (otherwise (when (elfeed-valid-regexp-p element)
+ (push element matches)))))
+ (list after must-have must-not-have matches not-matches)))
+
+(defun elfeed-search-filter (filter entry feed)
+ "Filter out only entries that match the filter. See
+`elfeed-search-set-filter' for format/syntax documentation."
+ (cl-destructuring-bind (after must-have must-not-have matches not-matches) filter
+ (let* ((tags (elfeed-entry-tags entry))
+ (date (elfeed-entry-date entry))
+ (age (- (float-time) date))
+ (title (or (elfeed-meta entry :title) (elfeed-entry-title entry)))
+ (link (elfeed-entry-link entry))
+ (feed-title
+ (or (elfeed-meta feed :title) (elfeed-feed-title feed) "")))
+ (when (and after (> age after))
+ (elfeed-db-return))
+ (and (cl-every (lambda (tag) (member tag tags)) must-have)
+ (cl-notany (lambda (tag) (member 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))
+ (and feed-title (string-match-p m feed-title))))
+ matches))
+ (cl-notany (lambda (m)
+ (or (and title (string-match-p m title))
+ (and link (string-match-p m link))
+ (and feed-title (string-match-p m feed-title))))
+ not-matches)))))
+
+(defun elfeed-search--prompt (current)
+ "Prompt for a new filter, starting with CURRENT."
+ (read-from-minibuffer
+ "Filter: "
+ (if (or (string= "" current)
+ (string-match-p " $" current))
+ current
+ (concat current " "))
+ nil nil 'elfeed-search-filter-history))
+
+(defun elfeed-search-set-filter (new-filter)
+ "Set a new search filter for the elfeed-search buffer.
+
+When NEW-FILTER is nil, reset the filter to the default value.
+
+When given a prefix argument, the current filter is not displayed
+in the minibuffer when prompting for a new filter.
+
+Any component beginning with a + or - is treated as a tag. If +
+the tag must be present on the entry. If - the tag must *not* be
+present on the entry. Ex. \"+unread\" or \"+unread -comic\".
+
+Any component beginning with an @ is an age limit. No posts older
+than this are allowed. Ex. \"@3-days-ago\" or \"@1-year-old\".
+
+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-insert-header-text (text)
+ "Insert TEXT into buffer using header face."
+ (insert (propertize text 'face '(widget-inactive italic))))
+
+(defun elfeed-search-insert-intro-header ()
+ "Insert the intro header with buttons."
+ (cl-flet ((button (f)
+ (insert-button (symbol-name f)
+ 'follow-link t
+ 'action (lambda (_) (call-interactively f)))))
+ (elfeed-search-insert-header-text "Database empty. Use ")
+ (button 'elfeed-add-feed)
+ (elfeed-search-insert-header-text ", or ")
+ (button 'elfeed-load-opml)
+ (elfeed-search-insert-header-text ", or ")
+ (button 'elfeed-update)
+ (elfeed-search-insert-header-text ".")))
+
+(defun elfeed-search-insert-header ()
+ "Insert a one-line status header."
+ (if url-queue
+ (let ((total (length url-queue))
+ (in-process (cl-count-if #'url-queue-buffer url-queue)))
+ (elfeed-search-insert-header-text
+ (format "%d feeds pending, %d in process ..."
+ (- total in-process) in-process)))
+ (let ((time (seconds-to-time (elfeed-db-last-update))))
+ (if (zerop (float-time time))
+ (elfeed-search-insert-intro-header)
+ (elfeed-search-insert-header-text
+ (format "Database last updated %s"
+ (format-time-string "%A, %B %d %Y %H:%M:%S %Z" time)))))))
+
+(defun elfeed-search--update-list ()
+ "Update `elfeed-search-filter' list."
+ (let* ((filter (elfeed-search-parse-filter elfeed-search-filter))
+ (head (list nil))
+ (tail head))
+ (with-elfeed-db-visit (entry feed)
+ (when (elfeed-search-filter filter entry feed)
+ (setf (cdr tail) (list entry)
+ tail (cdr tail))))
+ (setf elfeed-search-entries
+ (if (eq elfeed-sort-order 'ascending)
+ (nreverse (cdr head))
+ (cdr head)))))
+
+(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)
+ (if (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-insert-header)
+ (insert "\n")
+ (elfeed-search--update-list)
+ (dolist (entry elfeed-search-entries)
+ (elfeed-search-print entry)
+ (insert "\n"))
+ (insert "End of entries.\n")
+ (setf elfeed-search-last-update (float-time))))
+ (let ((inhibit-read-only t))
+ (elfeed-save-excursion
+ (goto-char (point-min))
+ (elfeed-kill-line)
+ (elfeed-search-insert-header))))))
+
+(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)
+ (elfeed-search-print 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)
+ "Return a list of the currently selected feeds."
+ (let ((use-region (and (not ignore-region) (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 (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 item to clipboard and kill-ring."
+ (interactive)
+ (let* ((entry (elfeed-search-selected :ignore-region))
+ (link (and entry (elfeed-entry-link entry))))
+ (when entry
+ (elfeed-untag entry 'unread)
+ (kill-new link)
+ (x-set-selection elfeed-search-clipboard-type link)
+ (message "Copied: %s" link)
+ (elfeed-search-update-line)
+ (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)))
+ (cl-loop for entry in entries do (elfeed-tag entry 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)))
+ (cl-loop for entry in entries do (elfeed-untag entry 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)))
+ (cl-loop for entry in entries
+ when (elfeed-tagged-p tag entry)
+ do (elfeed-untag entry tag)
+ else do (elfeed-tag entry 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)))
+ (when (elfeed-entry-p entry)
+ (elfeed-untag entry 'unread)
+ (elfeed-search-update-entry entry)
+ (forward-line)
+ (elfeed-show-entry entry)))
+
+;; 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)))
+ "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 ((elfeed-search-filter current-filter))
+ (elfeed-search-update :force)))))))
+
+(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)))
+
+;;; elfeed-search.el ends here
--- /dev/null
+;;; elfeed-show.el --- display feed entries -*- lexical-binding: t; -*-
+
+;; This is free and unencumbered software released into the public domain.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'shr)
+(require 'url-parse)
+(require 'browse-url)
+(require 'message) ; faces
+(require 'elfeed-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 'bool)
+
+(defvar elfeed-show-entry nil
+ "The entry being displayed in this buffer.")
+
+(defvar elfeed-show-mode-map
+ (let ((map (make-sparse-keymap)))
+ (prog1 map
+ (suppress-keymap map)
+ (define-key map "d" 'elfeed-show-save-enclosure)
+ (define-key map "q" 'elfeed-kill-buffer)
+ (define-key map "g" 'elfeed-show-refresh)
+ (define-key map "n" 'elfeed-show-next)
+ (define-key map "p" 'elfeed-show-prev)
+ (define-key map "s" 'elfeed-show-new-live-search)
+ (define-key map "b" 'elfeed-show-visit)
+ (define-key map "y" 'elfeed-show-yank)
+ (define-key map "u" (elfeed-expose #'elfeed-show-tag 'unread))
+ (define-key map "+" 'elfeed-show-tag)
+ (define-key map "-" 'elfeed-show-untag)
+ (define-key map (kbd "SPC") 'scroll-up-command)
+ (define-key map (kbd "DEL") 'scroll-down-command)
+ (define-key map "\t" 'shr-next-link)
+ (define-key map [tab] 'shr-next-link)
+ (define-key map "\e\t" 'shr-previous-link)
+ (define-key map [backtab] 'shr-previous-link)
+ (define-key map [mouse-2] 'shr-browse-url)))
+ "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-hooks 'elfeed-show-mode-hook))
+
+(defun elfeed-insert-html (html &optional base-url)
+ "Converted HTML markup to a propertized string."
+ (shr-insert-document
+ (if (elfeed-libxml-supported-p)
+ (with-temp-buffer
+ ;; insert <base> to work around libxml-parse-html-region bug
+ (insert (format "<base href=\"%s\">" base-url))
+ (insert html)
+ (libxml-parse-html-region (point-min) (point-max) base-url))
+ '(i () "Elfeed: libxml2 functionality is unavailable"))))
+
+(cl-defun elfeed-insert-link (url &optional (content url))
+ "Insert a clickable hyperlink to URL titled CONTENT."
+ (when (and elfeed-show-truncate-long-urls
+ (integerp shr-width)
+ (> (length content) (- shr-width 8)))
+ (let ((len (- (/ shr-width 2) 10)))
+ (setq content (format "%s[...]%s"
+ (substring content 0 len)
+ (substring content (- len))))))
+ (elfeed-insert-html (format "<a href=\"%s\">%s</a>" url content)))
+
+(defun elfeed-compute-base (url)
+ "Return the base URL for URL, useful for relative paths."
+ (let ((obj (url-generic-parse-url url)))
+ (setf (url-filename obj) nil)
+ (setf (url-target obj) nil)
+ (url-recreate-url obj)))
+
+(defun elfeed-show-refresh ()
+ "Update the buffer to match the selected entry."
+ (interactive)
+ (let* ((inhibit-read-only t)
+ (title (elfeed-entry-title elfeed-show-entry))
+ (date (seconds-to-time (elfeed-entry-date elfeed-show-entry)))
+ (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)))
+ (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-entry (entry)
+ "Display ENTRY in the current buffer."
+ (let ((title (elfeed-entry-title entry)))
+ (switch-to-buffer (get-buffer-create (format "*elfeed %s*" title)))
+ (unless (eq major-mode 'elfeed-show-mode)
+ (elfeed-show-mode))
+ (setq elfeed-show-entry entry)
+ (elfeed-show-refresh)))
+
+(defun elfeed-show-next ()
+ "Show the next item in the elfeed-search buffer."
+ (interactive)
+ (elfeed-kill-buffer)
+ (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)
+ (elfeed-kill-buffer)
+ (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 ()
+ "Visit the current entry in the browser."
+ (interactive)
+ (let ((link (elfeed-entry-link elfeed-show-entry)))
+ (when link
+ (message "Sent to browser: %s" 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)
+ (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)
+
+(defun elfeed--download-enclosure (url path)
+ "Download asynchronously the enclosure from URL to PATH."
+ (if (fboundp 'async-start)
+ ;; If async is available, don't hang emacs !
+ (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-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 (file-name-nondirectory
+ (url-unhex-string
+ (car (url-path-and-query (url-generic-parse-url
+ 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 (file-name-nondirectory
+ (url-unhex-string
+ (car (url-path-and-query
+ (url-generic-parse-url 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)))
+
+(provide 'elfeed-show)
+
+;;; elfeed-show.el ends here
--- /dev/null
+;;; elfeed.el --- an Emacs Atom/RSS feed reader -*- lexical-binding: t; -*-
+
+;; This is free and unencumbered software released into the public domain.
+
+;; Author: Christopher Wellons <wellonsNOSPAMnullprogram.com>
+;; URL: https://github.com/skeeto/elfeed
+
+;;; Commentary:
+
+;; Elfreed is a web feed client for Emacs, inspired by notmuch. See
+;; the README for full documentation.
+
+;; Elfreed requires Emacs 24 (lexical closures).
+
+;;; History:
+
+;; Version 1.1.2: fixes
+;; * Fixed support for non-HTTP protocols
+;; * Add ! search syntax
+;; * Add elfeed-unjam
+;; * Combine regexp search terms by AND instead of OR
+;; * Link navigation keybindings (tab)
+;; * Add elfeed-show-truncate-long-urls
+;; * Add elfeed-search-filter customization
+;; * Various bug fixes
+;; Version 1.1.1: fixes
+;; * Fix database corruption issue
+;; * Properly handle URLs from XML
+;; * Slightly better RSS date guessing
+;; * User interface tweaks
+;; * Add `elfeed-sort-order'
+;; * Use tab and backtab to move between links
+;; Version 1.1.0: features and fixes
+;; * Autotagging support
+;; * Better database performance
+;; * Database packing
+;; * Arbitrary struct metadata
+;; * Added `elfeed-search-clipboard-type'
+;; * Update to cl-lib from cl
+;; * Lots of bug fixes
+;; Version 1.0.1: features and fixes
+;; * Live filter editing
+;; * Support for RSS 1.0
+;; * OPML import/export
+;; * Fix multibyte support (thanks cellscape)
+;; * Fix date-change database corruption
+;; * Add n and p bindings to elfeed-search, like notmuch
+;; * Friendlier intro header
+;; * Automated builds
+;; * Lots of small bug fixes
+;; Version 1.0.0: initial public release
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'xml)
+(require 'xml-query)
+(require 'url-parse)
+(require 'url-queue)
+
+(defgroup elfeed nil
+ "An Emacs web feed reader."
+ :group 'comm)
+
+(defconst elfeed-version "1.1.2")
+
+(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)))))
+
+(provide 'elfeed)
+
+(require 'elfeed-search)
+(require 'elfeed-lib)
+(require 'elfeed-db)
+
+(defcustom elfeed-initial-tags '(unread)
+ "Initial tags for new entries."
+ :group 'elfeed
+ :type '(repeat symbol))
+
+;; Fetching:
+
+(define-obsolete-variable-alias
+ 'elfeed-max-connections 'url-queue-parallel-processes nil)
+
+(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.")
+
+(define-obsolete-variable-alias
+ 'elfeed-connections 'url-queue nil)
+
+(define-obsolete-variable-alias
+ 'elfeed-waiting 'url-queue nil)
+
+(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'."
+ (declare (indent defun))
+ `(url-queue-retrieve ,url (lambda (status) ,@body) () 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)
+ (let ((fails (mapcar #'url-queue-url elfeed-connections)))
+ (when fails
+ (message "Elfeed aborted feeds: %s" (mapconcat #'identity fails " ")))
+ (setf url-queue nil))
+ (elfeed-search-update :force))
+
+;; Parsing:
+
+(defun elfeed-feed-type (content)
+ "Return the feed type given the parsed content (:atom, :rss) 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-entries-from-atom (url xml)
+ "Turn parsed Atom content into a list of elfeed-entry structs."
+ (let* ((feed-id url)
+ (feed (elfeed-db-get-feed feed-id))
+ (title (elfeed-cleanup (xml-query '(feed title *) xml)))
+ (autotags (elfeed-feed-autotags url)))
+ (setf (elfeed-feed-url feed) url
+ (elfeed-feed-title feed) title)
+ (cl-loop for entry in (xml-query-all '(feed entry) xml) collect
+ (let* ((title (or (xml-query '(title *) entry) ""))
+ (anylink (xml-query '(link :href) entry))
+ (altlink (xml-query '(link [rel "alternate"] :href) entry))
+ (link (or altlink anylink))
+ (date (or (xml-query '(published *) entry)
+ (xml-query '(updated *) entry)
+ (xml-query '(date *) entry)))
+ (content
+ (let ((all-content
+ (or (xml-query-all '(content *) entry)
+ (xml-query-all '(summary *) entry))))
+ (when all-content
+ (apply #'concat all-content))))
+ (id (or (xml-query '(id *) entry) link
+ (elfeed-generate-id content)))
+ (type (or (xml-query '(content :type) entry)
+ (xml-query '(summary :type) entry)
+ ""))
+ (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))))
+ (elfeed-entry--create
+ :title (elfeed-cleanup title)
+ :feed-id feed-id
+ :id (cons feed-id (elfeed-cleanup id))
+ :link (elfeed-cleanup link)
+ :tags (elfeed-normalize-tags autotags elfeed-initial-tags)
+ :date (elfeed-float-time date)
+ :content content
+ :enclosures enclosures
+ :content-type (if (string-match-p "html" type) 'html nil))))))
+
+(defun elfeed-entries-from-rss (url xml)
+ "Turn parsed RSS content into a list of elfeed-entry structs."
+ (let* ((feed-id 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 (or (xml-query '(link *) item) guid))
+ (date (or (xml-query '(pubDate *) item)
+ (xml-query '(date *) 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 feed-id (elfeed-cleanup id)))
+ (original (elfeed-db-get-entry full-id))
+ (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))))
+ (elfeed-entry--create
+ :title (elfeed-cleanup title)
+ :id full-id
+ :feed-id feed-id
+ :link (elfeed-cleanup link)
+ :tags (elfeed-normalize-tags autotags elfeed-initial-tags)
+ :date (if (and original (null date))
+ (elfeed-entry-date original)
+ (elfeed-float-time date))
+ :enclosures enclosures
+ :content description
+ :content-type 'html)))))
+
+(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)
+ (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 feed-id (elfeed-cleanup id)))
+ (original (elfeed-db-get-entry full-id)))
+ (elfeed-entry--create
+ :title (elfeed-cleanup title)
+ :id full-id
+ :feed-id feed-id
+ :link (elfeed-cleanup link)
+ :tags (elfeed-normalize-tags autotags elfeed-initial-tags)
+ :date (if (and original (null date))
+ (elfeed-entry-date original)
+ (elfeed-float-time date))
+ :content description
+ :content-type 'html)))))
+
+(defun elfeed-feed-list ()
+ "Return a flat list version of `elfeed-feeds'.
+Only a list of strings will be returned."
+ (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-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)
+ (message "Elfeed fetch failed for %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)
+ (message "Elfeed parse failed for %s: %s" url error))
+
+(defun elfeed-update-feed (url)
+ "Update a specific feed."
+ (interactive (list (completing-read "Feed: " (elfeed-feed-list))))
+ (elfeed-with-fetch url
+ (if (and status (eq (car status) :error))
+ (let ((print-escape-newlines t))
+ (elfeed-handle-http-error url status))
+ (condition-case error
+ (progn
+ (elfeed-move-to-first-empty-line)
+ (set-buffer-multibyte t)
+ (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))))
+ (kill-buffer)
+ (run-hook-with-args 'elfeed-update-hooks url)))
+
+(defun elfeed-add-feed (url)
+ "Manually add a feed to the database."
+ (interactive (list
+ (let ((clipboard (elfeed-cleanup (elfeed-clipboard-get))))
+ (read-from-minibuffer
+ "URL: " (when (elfeed-looks-like-url-p clipboard)
+ clipboard)))))
+ (cl-pushnew url elfeed-feeds)
+ (when (called-interactively-p 'any)
+ (customize-save-variable 'elfeed-feeds elfeed-feeds))
+ (elfeed-update-feed url)
+ (elfeed-search-update :force))
+
+;;;###autoload
+(defun elfeed-update ()
+ "Update all the feeds in `elfeed-feeds'."
+ (interactive)
+ (message "Elfeed update: %s" (format-time-string "%B %e %Y %H:%M:%S %Z"))
+ (mapc #'elfeed-update-feed (elfeed--shuffle (elfeed-feed-list)))
+ (elfeed-search-update :force)
+ (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))
+ (elfeed-search-update))
+
+;; New entry filtering
+
+(cl-defun elfeed-make-tagger
+ (&key feed-title feed-url entry-title entry-link after before
+ add remove callback)
+ "Create a function that adds or removes tags on matching entries.
+
+FEED-TITLE, FEED-URL, ENTRY-TITLE, and ENTRY-LINK are regular
+expressions or a list (not <regex>), which indicates a negative
+match. AFTER and BEFORE are relative times (see
+`elfeed-time-duration'). Entries must match all provided
+expressions. If an entry matches, add tags ADD and remove tags
+REMOVE.
+
+Examples,
+
+ (elfeed-make-tagger :feed-url \"youtube\\\\.com\"
+ :add '(video youtube))
+
+ (elfeed-make-tagger :before \"1 week ago\"
+ :remove 'unread)
+
+ (elfeed-make-tagger :feed-url \"example\\\\.com\"
+ :entry-title '(not \"something interesting\")
+ :add 'junk)
+
+The returned function should be added to `elfeed-new-entry-hook'."
+ (let ((after-time (and after (elfeed-time-duration after)))
+ (before-time (and before (elfeed-time-duration before))))
+ (when (and add (symbolp add)) (setf add (list add)))
+ (when (and remove (symbolp remove)) (setf remove (list remove)))
+ (lambda (entry)
+ (let ((feed (elfeed-entry-feed entry))
+ (date (elfeed-entry-date entry))
+ (case-fold-search t))
+ (cl-flet ((match (r s)
+ (or (null r)
+ (if (listp r)
+ (not (string-match-p (cl-second r) s))
+ (string-match-p r s)))))
+ (when (and
+ (match feed-title (elfeed-feed-title feed))
+ (match feed-url (elfeed-feed-url feed))
+ (match entry-title (elfeed-entry-title entry))
+ (match entry-link (elfeed-entry-link entry))
+ (or (not after-time) (> date (- (float-time) after-time)))
+ (or (not before-time) (< date (- (float-time) before-time))))
+ (when add
+ (apply #'elfeed-tag entry add))
+ (when remove
+ (apply #'elfeed-untag entry remove))
+ (when callback
+ (funcall callback entry))
+ entry))))))
+
+;; OPML
+
+(defun elfeed--parse-opml (xml)
+ "Parse XML (from `xml-parse-region') into `elfeed-feeds' list."
+ (cl-loop for (tag attr . content) in (cl-remove-if-not #'listp xml)
+ count tag into work-around-bug ; bug#15326
+ when (assoc 'xmlUrl attr) collect (cdr it)
+ else append (elfeed--parse-opml content)))
+
+;;;###autoload
+(defun elfeed-load-opml (file)
+ "Load feeds from an OPML file into `elfeed-feeds'.
+When called interactively, the changes to `elfeed-feeds' are
+saved to your customization file."
+ (interactive "fOPML file: ")
+ (let* ((xml (xml-parse-file file))
+ (feeds (elfeed--parse-opml xml))
+ (full (append feeds elfeed-feeds)))
+ (prog1 (setf elfeed-feeds (cl-delete-duplicates full :test #'string=))
+ (when (called-interactively-p 'any)
+ (customize-save-variable 'elfeed-feeds elfeed-feeds)
+ (message "%d feeds loaded from %s" (length feeds) file)))))
+
+;;;###autoload
+(defun elfeed-export-opml (file)
+ "Export the current feed listing to OPML-formatted FILE."
+ (interactive "FOutput OPML file: ")
+ (with-temp-file file
+ (let ((standard-output (current-buffer)))
+ (princ "<?xml version=\"1.0\"?>\n")
+ (xml-print
+ `((opml ((version . "1.0"))
+ (head () (title () "Elfeed Export"))
+ (body ()
+ ,@(cl-loop for url in (elfeed-feed-list)
+ for feed = (elfeed-db-get-feed url)
+ for title = (or (elfeed-feed-title feed) "")
+ collect `(outline ((xmlUrl . ,url)
+ (title . ,title)))))))))))
+
+;;; elfeed.el ends here
--- /dev/null
+;;; xml-query.el --- query engine complimenting the xml package
+
+;; This is free and unencumbered software released into the public domain.
+
+;;; Commentary:
+
+;; This provides a very rudimentary s-expression oriented, jQuery-like
+;; XML query 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'.
+
+;; 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-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 #'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 (stringp result)
+ result
+ (car (xml-query-all query xml)))))
+
+(provide 'xml-query)
+
+;;; xml-query.el ends here
+++ /dev/null
-;;; elfeed-org-autoloads.el --- automatically extracted autoloads
-;;
-;;; Code:
-
-\f
-;;;### (autoloads (elfeed-org) "elfeed-org" "elfeed-org.el" (21691
-;;;;;; 57075 0 0))
-;;; Generated autoloads from elfeed-org.el
-
-(autoload 'elfeed-org "elfeed-org" "\
-Hook up rmh-elfeed-org to read the `org-mode' configuration when elfeed starts.
-
-\(fn)" t nil)
-
-;;;***
-\f
-;;;### (autoloads nil nil ("elfeed-org-pkg.el") (21691 57075 182397
-;;;;;; 0))
-
-;;;***
-\f
-(provide 'elfeed-org-autoloads)
-;; Local Variables:
-;; version-control: never
-;; no-byte-compile: t
-;; no-update-autoloads: t
-;; coding: utf-8
-;; End:
-;;; elfeed-org-autoloads.el ends here
+++ /dev/null
-(define-package "elfeed-org" "20150108.1406" "Configure elfeed with one or more org-mode files" (quote ((elfeed "1.1.1") (org "7"))))
+++ /dev/null
-;;; elfeed-org.el --- Configure elfeed with one or more org-mode files
-
-;; Copyright (C) 2014 Remy Honig
-
-;; Author : Remy Honig <remyhonigNOSPAMgmail.com>
-;; Package-Requires : ((elfeed "1.1.1") (org "7"))
-;; URL : https://github.com/remyhonig/elfeed-org
-;; Version: 20150108.1406
-;; X-Original-Version : 20141003.1
-;; Keywords : news
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;; Maintaining tags for all rss feeds is cumbersome using the regular
-;; flat list where there is no hierarchy and tag names are duplicated
-;; a lot. Org-mode makes the book keeping of tags and feeds much
-;; easier. Tags get inherited from parent headlines. Multiple files
-;; can be specified to separate your private from your work feeds for
-;; example. You may also use tagging rules to tag feeds by entry-title
-;; keywords. See https://github.com/remyhonig/elfeed-org for usage.
-
-;;; Code:
-
-(require 'elfeed)
-(require 'cl)
-(require 'org)
-
-
-(defgroup elfeed-org nil
- "Configure the Elfeed RSS reader with an Orgmode file"
- :group 'comm)
-
-
-(defcustom rmh-elfeed-org-tree-id "elfeed"
- "The ID property of the tree containing the RSS feeds."
- :group 'elfeed-org
- :type 'string)
-
-
-(defcustom rmh-elfeed-org-files (list "~/.emacs.d/elfeed.org")
- "The files where we look to find the tree with the `rmh-elfeed-org-tree-id'."
- :group 'elfeed-org
- :type '(repeat (file :tag "org-mode file")))
-
-
-(defun rmh-elfeed-org-read-tree (tree-id match)
- "Convert org tree with TREE-ID into a feed configuration structure for Elfeed.
-Filter out headlines that contain MATCH."
- (let* ((m (org-id-find tree-id 'marker))
- (buf (marker-buffer m)))
- (save-excursion
- (with-current-buffer buf
- (goto-char m)
- (move-marker m nil)
- (remove-if-not
- (lambda (x)
- (and (string-match match (car x)) x))
- (rmh-elfeed-org-tags-inherited
- (lambda ()
- (org-map-entries
- '(let ((url (substring-no-properties (org-get-heading t)))
- (tags (mapcar 'intern (org-get-tags-at))))
- (append (list url) tags))
- nil
- rmh-elfeed-org-files))))))))
-
-
-(defun rmh-elfeed-org-tags-inherited (func)
- "Call FUNC while ensuring tags are inherited."
- (let ((original org-use-tag-inheritance))
- (setq org-use-tag-inheritance 't)
- (let ((feeds (funcall func)))
- (setq org-use-tag-inheritance original) feeds)))
-
-
-(defun rmh-elfeed-org-add-new-entry-hooks (keywords)
- "Add new entry hooks for tagging KEYWORDS."
- (mapc
- (lambda (x)
- (let ((term (car (cdr (split-string (car x) ": "))))
- (tags (cdr x)))
- (add-hook 'elfeed-new-entry-hook (elfeed-make-tagger :entry-title term :add (cdr x)))))
- keywords))
-
-
-(defun rmh-elfeed-org-check-configuration-file (file)
- "Make sure FILE exists. If not, ask user what to do."
- (when (not (file-exists-p file))
- (error "Elfeed-org cannot open %s. Make sure it exists customize the variable \'rmh-elfeed-org-files\'"
- (abbreviate-file-name file))))
-
-
-(defun rmh-elfeed-org-configure ()
- "Clear and reload the elfeed feeds- and tagging configuration."
-
- ;; To regenerate the elfeed config after the org mode tree has
- ;; changed we want this function to be interactive
- (interactive)
-
- ;; Make sure all files really exists
- (mapc (lambda (file) (rmh-elfeed-org-check-configuration-file file)) rmh-elfeed-org-files)
-
- ;; Clear hooks for auto tagging
- (setq elfeed-new-entry-hook (list))
-
- ;; Clear registered feeds
- (setq elfeed-feeds (list))
-
- ;; Add feeds and auto tagging rules to elfeed configuration
- (mapc (lambda (file) (with-current-buffer (find-file-noselect file)
-
- ;; Extract tagging rules and feeds from the found file
- (let* ((tree-id rmh-elfeed-org-tree-id)
- (tagging-rules (rmh-elfeed-org-read-tree tree-id "entry-title"))
- (feeds (rmh-elfeed-org-read-tree tree-id "http")))
-
- ;; Add feeds to elfeed configuration
- (setq elfeed-feeds (append elfeed-feeds feeds))
-
- ;; Add auto tagging rules to elfeed configuration
- (rmh-elfeed-org-add-new-entry-hooks tagging-rules))))
-
- ;; The files we are operating on
- rmh-elfeed-org-files)
-
- ;; Tell user what we did
- (message "elfeed-org loaded %i feeds, %i rules"
- (length elfeed-feeds)
- (length elfeed-new-entry-hook)))
-
-
-;;;###autoload
-(defun elfeed-org ()
- "Hook up rmh-elfeed-org to read the `org-mode' configuration when elfeed starts."
- (interactive)
- (message "elfeed-org is set up to handle elfeed configuration.")
- ;; Use an advice to load the configuration.
- (defadvice elfeed (before configure-elfeed activate)
- "Load all feed settings before elfeed is started."
- (rmh-elfeed-org-configure)))
-
-
-(provide 'elfeed-org)
-;;; elfeed-org.el ends here
--- /dev/null
+;;; elfeed-org-autoloads.el --- automatically extracted autoloads
+;;
+;;; Code:
+(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
+\f
+;;;### (autoloads nil "elfeed-org" "elfeed-org.el" (21908 14284 0
+;;;;;; 0))
+;;; Generated autoloads from elfeed-org.el
+
+(autoload 'elfeed-org "elfeed-org" "\
+Hook up rmh-elfeed-org to read the `org-mode' configuration when elfeed is run.
+
+\(fn)" t nil)
+
+;;;***
+\f
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; End:
+;;; elfeed-org-autoloads.el ends here
--- /dev/null
+(define-package "elfeed-org" "20150412.145" "Configure elfeed with one or more org-mode files" '((elfeed "1.1.1") (org "8.2.7") (dash "2.10.0") (s "1.9.0")) :url "https://github.com/remyhonig/elfeed-org" :keywords '("news"))
--- /dev/null
+;;; elfeed-org.el --- Configure elfeed with one or more org-mode files
+
+;; Copyright (C) 2014 Remy Honig
+
+;; Author : Remy Honig <remyhonigNOSPAMgmail.com>
+;; Package-Requires : ((elfeed "1.1.1") (org "8.2.7") (dash "2.10.0") (s "1.9.0"))
+;; URL : https://github.com/remyhonig/elfeed-org
+;; Package-Version: 20150412.145
+;; Version : 20150412.1
+;; Keywords : news
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;; Maintaining tags for all rss feeds is cumbersome using the regular
+;; flat list where there is no hierarchy and tag names are duplicated
+;; a lot. Org-mode makes the book keeping of tags and feeds much
+;; easier. Tags get inherited from parent headlines. Multiple files
+;; can be specified to separate your private from your work feeds for
+;; example. You may also use tagging rules to tag feeds by entry-title
+;; keywords. See https://github.com/remyhonig/elfeed-org for usage.
+
+;;; Code:
+
+(require 'elfeed)
+(require 'org)
+(require 'dash)
+(require 's)
+
+
+(defgroup elfeed-org nil
+ "Configure the Elfeed RSS reader with an Orgmode file"
+ :group 'comm)
+
+
+(defcustom rmh-elfeed-org-tree-id "elfeed"
+ "The tag or ID property on the trees containing the RSS feeds."
+ :group 'elfeed-org
+ :type 'string)
+
+
+(defcustom rmh-elfeed-org-files (list "~/.emacs.d/elfeed.org")
+ "The files where we look to find trees with the `rmh-elfeed-org-tree-id'."
+ :group 'elfeed-org
+ :type '(repeat (file :tag "org-mode file")))
+
+
+(defun rmh-elfeed-org-check-configuration-file (file)
+ "Make sure FILE exists."
+ (when (not (file-exists-p file))
+ (error "Elfeed-org cannot open %s. Make sure it exists customize the variable \'rmh-elfeed-org-files\'"
+ (abbreviate-file-name file))))
+
+
+(defun rmh-elfeed-org-import-trees (tree-id)
+ "Get trees with \":ID:\" property or tag of value TREE-ID.
+Return trees with TREE-ID as the value of the id property or
+with a tag of the same value. Setting an \":ID:\" property is not
+recommended but I support it for backward compatibility of
+current users."
+ (org-element-map
+ (org-element-parse-buffer)
+ 'headline
+ (lambda (h)
+ (when (or (member tree-id (org-element-property :tags h))
+ (equal tree-id (org-element-property :ID h))) h))))
+
+
+(defun rmh-elfeed-org-convert-tree-to-headlines (parsed-org)
+ "Get the inherited tags from PARSED-ORG structure if MATCH-FUNC is t.
+The algorithm to gather inherited tags depends on the tree being
+visited depth first by `org-element-map'. The reason I don't use
+`org-get-tags-at' for this is that I can reuse the parsed org
+structure and I am not dependent on the setting of
+`org-use-tag-inheritance' or an org buffer being present at
+all. Which in my opinion makes the process more traceable."
+ (let* ((tags '())
+ (level 1))
+ (org-element-map parsed-org 'headline
+ (lambda (h)
+ (let* ((current-level (org-element-property :level h))
+ (delta-level (- current-level level))
+ (delta-tags (mapcar 'intern (org-element-property :tags h)))
+ (heading (org-element-property :raw-value h)))
+ ;; update the tags stack when we visit a parent or sibling
+ (unless (> delta-level 0)
+ (let ((drop-num (+ 1 (- delta-level))))
+ (setq tags (-drop drop-num tags))))
+ ;; save current level to compare with next heading that will be visited
+ (setq level current-level)
+ ;; save the tags that might apply to potential children of the current heading
+ (push (-concat (-first-item tags) delta-tags) tags)
+ ;; return the heading and inherited tags
+ (-concat (list heading)
+ (-first-item tags)))))))
+
+;; TODO: mark wrongly formatted feeds (PoC for unretrievable feeds)
+(defun rmh-elfeed-org-flag-headlines (parsed-org)
+ "Flag headlines in PARSED-ORG if they don't have a valid value."
+ (org-element-map parsed-org 'headline
+ (lambda (h)
+ (let ((tags (org-element-property :tags h)))
+ (org-element-put-property h :tags (push "_flag_" tags))))))
+
+
+(defun rmh-elfeed-org-filter-relevant (list)
+ "Filter relevant entries from the LIST."
+ (-filter
+ (lambda (entry)
+ (string-match "\\(http\\|entry-title\\)" (car entry)))
+ list))
+
+
+(defun rmh-elfeed-org-cleanup-headlines (headlines tree-id)
+ "In all HEADLINES given remove the TREE-ID."
+ (mapcar (lambda (e) (delete tree-id e)) headlines))
+
+
+(defun rmh-elfeed-org-import-headlines-from-files (files tree-id)
+ "Visit all FILES and return the headlines stored under tree tagged TREE-ID or with the \":ID:\" TREE-ID in one list, filter headlines on MATCH."
+ (-distinct (-mapcat (lambda (file)
+ (with-current-buffer (find-file-noselect (expand-file-name file))
+ (org-mode)
+ (rmh-elfeed-org-cleanup-headlines
+ (rmh-elfeed-org-filter-relevant
+ (rmh-elfeed-org-convert-tree-to-headlines
+ (rmh-elfeed-org-import-trees tree-id)))
+ (intern tree-id))))
+ files)))
+
+
+(defun rmh-elfeed-org-convert-headline-to-tagger-params (tagger-headline)
+ "Add new entry hooks for tagging configured with the found headline in TAGGER-HEADLINE."
+ (list
+ (s-trim (s-chop-prefix "entry-title:" (car tagger-headline)))
+ (cdr tagger-headline)))
+
+
+(defun rmh-elfeed-org-export-entry-hook (tagger-params)
+ "Export TAGGER-PARAMS to the proper `elfeed' structure."
+ (add-hook 'elfeed-new-entry-hook
+ (elfeed-make-tagger
+ :entry-title (car tagger-params)
+ :add (cdr tagger-params))))
+
+
+(defun rmh-elfeed-org-export-feed (headline)
+ "Export HEADLINE to the proper `elfeed' structure."
+ (add-to-list 'elfeed-feeds headline))
+
+
+(defun rmh-elfeed-org-process (files tree-id)
+ "Process headlines and taggers from FILES with org headlines with TREE-ID."
+
+ ;; Warn if needed
+ (-each files 'rmh-elfeed-org-check-configuration-file)
+
+ ;; Clear elfeed structures
+ (setq elfeed-feeds nil)
+ (setq elfeed-new-entry-hook nil)
+
+ ;; Convert org structure to elfeed structure
+ (-each (rmh-elfeed-org-import-headlines-from-files files tree-id)
+ (lambda (headline)
+ (let ((text (car headline)))
+ (when (s-starts-with? "http" text)
+ (rmh-elfeed-org-export-feed headline))
+ (when (s-starts-with? "entry-title" text)
+ (rmh-elfeed-org-export-entry-hook
+ (rmh-elfeed-org-convert-headline-to-tagger-params headline))))))
+
+ ;; Tell user what we did
+ (message "elfeed-org loaded %i feeds, %i rules"
+ (length elfeed-feeds)
+ (length elfeed-new-entry-hook)))
+
+
+;;;###autoload
+(defun elfeed-org ()
+ "Hook up rmh-elfeed-org to read the `org-mode' configuration when elfeed is run."
+ (interactive)
+ (message "elfeed-org is set up to handle elfeed configuration.")
+ ;; Use an advice to load the configuration.
+ (defadvice elfeed (before configure-elfeed activate)
+ "Load all feed settings before elfeed is started."
+ (rmh-elfeed-org-process rmh-elfeed-org-files rmh-elfeed-org-tree-id)))
+
+
+(provide 'elfeed-org)
+;;; elfeed-org.el ends here
projects / emacsconfig.git / commitdiff