elfeed-show.el (19344B)
1 ;;; elfeed-show.el --- display feed entries -*- lexical-binding: t; -*- 2 3 ;; This is free and unencumbered software released into the public domain. 4 5 ;;; Code: 6 7 (require 'cl-lib) 8 (require 'shr) 9 (require 'url-parse) 10 (require 'browse-url) 11 (require 'message) ; faces 12 (require 'bookmark) 13 (bookmark-maybe-load-default-file) 14 15 (require 'elfeed) 16 (require 'elfeed-db) 17 (require 'elfeed-lib) 18 (require 'elfeed-search) 19 20 (defcustom elfeed-show-truncate-long-urls t 21 "When non-nil, use an ellipsis to shorten very long displayed URLs." 22 :group 'elfeed 23 :type 'boolean) 24 25 (defcustom elfeed-show-entry-author t 26 "When non-nil, show the entry's author (if it's in the entry's metadata)." 27 :group 'elfeed 28 :type 'boolean) 29 30 (defvar elfeed-show-entry nil 31 "The entry being displayed in this buffer.") 32 33 (defcustom elfeed-show-entry-switch #'switch-to-buffer 34 "Function used to display the feed entry buffer." 35 :group 'elfeed 36 :type '(choice (function-item switch-to-buffer) 37 (function-item pop-to-buffer) 38 function)) 39 40 (defcustom elfeed-show-entry-delete #'elfeed-kill-buffer 41 "Function called when quitting from the elfeed-entry buffer. 42 Called without arguments." 43 :group 'elfeed 44 :type '(choice (function-item elfeed-kill-buffer) 45 (function-item delete-window) 46 function)) 47 48 (defvar elfeed-show-refresh-function #'elfeed-show-refresh--mail-style 49 "Function called to refresh the `*elfeed-entry*' buffer.") 50 51 (defvar elfeed-show-mode-map 52 (let ((map (make-sparse-keymap))) 53 (prog1 map 54 (suppress-keymap map) 55 (define-key map "h" #'describe-mode) 56 (define-key map "d" #'elfeed-show-save-enclosure) 57 (define-key map "q" #'elfeed-kill-buffer) 58 (define-key map "g" #'elfeed-show-refresh) 59 (define-key map "n" #'elfeed-show-next) 60 (define-key map "p" #'elfeed-show-prev) 61 (define-key map "s" #'elfeed-show-new-live-search) 62 (define-key map "b" #'elfeed-show-visit) 63 (define-key map "y" #'elfeed-show-yank) 64 (define-key map "u" #'elfeed-show-tag--unread) 65 (define-key map "+" #'elfeed-show-tag) 66 (define-key map "-" #'elfeed-show-untag) 67 (define-key map "<" #'beginning-of-buffer) 68 (define-key map ">" #'end-of-buffer) 69 (define-key map (kbd "SPC") #'scroll-up-command) 70 (define-key map (kbd "DEL") #'scroll-down-command) 71 (define-key map (kbd "TAB") #'elfeed-show-next-link) 72 (define-key map "\e\t" #'shr-previous-link) 73 (define-key map [backtab] #'shr-previous-link) 74 (define-key map "c" #'elfeed-kill-link-url-at-point) 75 (define-key map [mouse-2] #'shr-browse-url) 76 (define-key map "A" #'elfeed-show-add-enclosure-to-playlist) 77 (define-key map "P" #'elfeed-show-play-enclosure))) 78 "Keymap for `elfeed-show-mode'.") 79 80 (defun elfeed-show-mode () 81 "Mode for displaying Elfeed feed entries. 82 \\{elfeed-show-mode-map}" 83 (interactive) 84 (kill-all-local-variables) 85 (use-local-map elfeed-show-mode-map) 86 (setq major-mode 'elfeed-show-mode 87 mode-name "elfeed-show" 88 buffer-read-only t) 89 (buffer-disable-undo) 90 (make-local-variable 'elfeed-show-entry) 91 (set (make-local-variable 'bookmark-make-record-function) 92 #'elfeed-show-bookmark-make-record) 93 (run-mode-hooks 'elfeed-show-mode-hook)) 94 95 (defalias 'elfeed-show-tag--unread 96 (elfeed-expose #'elfeed-show-tag 'unread) 97 "Mark the current entry unread.") 98 99 (defun elfeed-insert-html (html &optional base-url) 100 "Converted HTML markup to a propertized string." 101 (shr-insert-document 102 (if (elfeed-libxml-supported-p) 103 (with-temp-buffer 104 ;; insert <base> to work around libxml-parse-html-region bug 105 (when base-url 106 (insert (format "<base href=\"%s\">" base-url))) 107 (insert html) 108 (libxml-parse-html-region (point-min) (point-max) base-url)) 109 '(i () "Elfeed: libxml2 functionality is unavailable")))) 110 111 (cl-defun elfeed-insert-link (url &optional (content url)) 112 "Insert a clickable hyperlink to URL titled CONTENT." 113 (when (and elfeed-show-truncate-long-urls 114 (integerp shr-width) 115 (> (length content) (- shr-width 8))) 116 (let ((len (- (/ shr-width 2) 10))) 117 (setq content (format "%s[...]%s" 118 (substring content 0 len) 119 (substring content (- len)))))) 120 (elfeed-insert-html (format "<a href=\"%s\">%s</a>" url content))) 121 122 (defun elfeed-compute-base (url) 123 "Return the base URL for URL, useful for relative paths." 124 (let ((obj (url-generic-parse-url url))) 125 (setf (url-filename obj) nil) 126 (setf (url-target obj) nil) 127 (url-recreate-url obj))) 128 129 (defun elfeed--show-format-author (author) 130 "Format author plist for the header." 131 (cl-destructuring-bind (&key name uri email &allow-other-keys) 132 author 133 (cond ((and name uri email) 134 (format "%s <%s> (%s)" name email uri)) 135 ((and name email) 136 (format "%s <%s>" name email)) 137 ((and name uri) 138 (format "%s (%s)" name uri)) 139 (name name) 140 (email email) 141 (uri uri) 142 ("[unknown]")))) 143 144 (defun elfeed-show-refresh--mail-style () 145 "Update the buffer to match the selected entry, using a mail-style." 146 (interactive) 147 (let* ((inhibit-read-only t) 148 (title (elfeed-entry-title elfeed-show-entry)) 149 (date (seconds-to-time (elfeed-entry-date elfeed-show-entry))) 150 (authors (elfeed-meta elfeed-show-entry :authors)) 151 (link (elfeed-entry-link elfeed-show-entry)) 152 (tags (elfeed-entry-tags elfeed-show-entry)) 153 (tagsstr (mapconcat #'symbol-name tags ", ")) 154 (nicedate (format-time-string "%a, %e %b %Y %T %Z" date)) 155 (content (elfeed-deref (elfeed-entry-content elfeed-show-entry))) 156 (type (elfeed-entry-content-type elfeed-show-entry)) 157 (feed (elfeed-entry-feed elfeed-show-entry)) 158 (feed-title (elfeed-feed-title feed)) 159 (base (and feed (elfeed-compute-base (elfeed-feed-url feed))))) 160 (erase-buffer) 161 (insert (format (propertize "Title: %s\n" 'face 'message-header-name) 162 (propertize title 'face 'message-header-subject))) 163 (when elfeed-show-entry-author 164 (dolist (author authors) 165 (let ((formatted (elfeed--show-format-author author))) 166 (insert 167 (format (propertize "Author: %s\n" 'face 'message-header-name) 168 (propertize formatted 'face 'message-header-to)))))) 169 (insert (format (propertize "Date: %s\n" 'face 'message-header-name) 170 (propertize nicedate 'face 'message-header-other))) 171 (insert (format (propertize "Feed: %s\n" 'face 'message-header-name) 172 (propertize feed-title 'face 'message-header-other))) 173 (when tags 174 (insert (format (propertize "Tags: %s\n" 'face 'message-header-name) 175 (propertize tagsstr 'face 'message-header-other)))) 176 (insert (propertize "Link: " 'face 'message-header-name)) 177 (elfeed-insert-link link link) 178 (insert "\n") 179 (cl-loop for enclosure in (elfeed-entry-enclosures elfeed-show-entry) 180 do (insert (propertize "Enclosure: " 'face 'message-header-name)) 181 do (elfeed-insert-link (car enclosure)) 182 do (insert "\n")) 183 (insert "\n") 184 (if content 185 (if (eq type 'html) 186 (elfeed-insert-html content base) 187 (insert content)) 188 (insert (propertize "(empty)\n" 'face 'italic))) 189 (goto-char (point-min)))) 190 191 (defun elfeed-show-refresh () 192 "Update the buffer to match the selected entry." 193 (interactive) 194 (call-interactively elfeed-show-refresh-function)) 195 196 (defcustom elfeed-show-unique-buffers nil 197 "When non-nil, every entry buffer gets a unique name. 198 This allows for displaying multiple show buffers at the same 199 time." 200 :group 'elfeed 201 :type 'boolean) 202 203 (defun elfeed-show--buffer-name (entry) 204 "Return the appropriate buffer name for ENTRY. 205 The result depends on the value of `elfeed-show-unique-buffers'." 206 (if elfeed-show-unique-buffers 207 (format "*elfeed-entry-<%s %s>*" 208 (elfeed-entry-title entry) 209 (format-time-string "%F" (elfeed-entry-date entry))) 210 "*elfeed-entry*")) 211 212 (defun elfeed-show-entry (entry) 213 "Display ENTRY in the current buffer." 214 (let ((buff (get-buffer-create (elfeed-show--buffer-name entry)))) 215 (with-current-buffer buff 216 (elfeed-show-mode) 217 (setq elfeed-show-entry entry) 218 (elfeed-show-refresh)) 219 (funcall elfeed-show-entry-switch buff))) 220 221 (defun elfeed-show-next () 222 "Show the next item in the elfeed-search buffer." 223 (interactive) 224 (funcall elfeed-show-entry-delete) 225 (with-current-buffer (elfeed-search-buffer) 226 (when elfeed-search-remain-on-entry (forward-line 1)) 227 (call-interactively #'elfeed-search-show-entry))) 228 229 (defun elfeed-show-prev () 230 "Show the previous item in the elfeed-search buffer." 231 (interactive) 232 (funcall elfeed-show-entry-delete) 233 (with-current-buffer (elfeed-search-buffer) 234 (when elfeed-search-remain-on-entry (forward-line 1)) 235 (forward-line -2) 236 (call-interactively #'elfeed-search-show-entry))) 237 238 (defun elfeed-show-new-live-search () 239 "Kill the current buffer, search again in *elfeed-search*." 240 (interactive) 241 (elfeed-kill-buffer) 242 (elfeed) 243 (elfeed-search-live-filter)) 244 245 (defun elfeed-show-visit (&optional use-generic-p) 246 "Visit the current entry in your browser using `browse-url'. 247 If there is a prefix argument, visit the current entry in the 248 browser defined by `browse-url-generic-program'." 249 (interactive "P") 250 (let ((link (elfeed-entry-link elfeed-show-entry))) 251 (when link 252 (message "Sent to browser: %s" link) 253 (if use-generic-p 254 (browse-url-generic link) 255 (browse-url link))))) 256 257 (defun elfeed-show-yank () 258 "Copy the current entry link URL to the clipboard." 259 (interactive) 260 (let ((link (elfeed-entry-link elfeed-show-entry))) 261 (when link 262 (kill-new link) 263 (if (fboundp 'gui-set-selection) 264 (gui-set-selection 'PRIMARY link) 265 (with-no-warnings 266 (x-set-selection 'PRIMARY link))) 267 (message "Yanked: %s" link)))) 268 269 (defun elfeed-show-tag (&rest tags) 270 "Add TAGS to the displayed entry." 271 (interactive (list (intern (read-from-minibuffer "Tag: ")))) 272 (let ((entry elfeed-show-entry)) 273 (apply #'elfeed-tag entry tags) 274 (with-current-buffer (elfeed-search-buffer) 275 (elfeed-search-update-entry entry)) 276 (elfeed-show-refresh))) 277 278 (defun elfeed-show-untag (&rest tags) 279 "Remove TAGS from the displayed entry." 280 (interactive (let* ((tags (elfeed-entry-tags elfeed-show-entry)) 281 (names (mapcar #'symbol-name tags)) 282 (select (completing-read "Untag: " names nil :match))) 283 (list (intern select)))) 284 (let ((entry elfeed-show-entry)) 285 (apply #'elfeed-untag entry tags) 286 (with-current-buffer (elfeed-search-buffer) 287 (elfeed-search-update-entry entry)) 288 (elfeed-show-refresh))) 289 290 ;; Enclosures: 291 292 (defcustom elfeed-enclosure-default-dir (expand-file-name "~") 293 "Default directory for saving enclosures. 294 This can be either a string (a file system path), or a function 295 that takes a filename and the mime-type as arguments, and returns 296 the enclosure dir." 297 :type 'directory 298 :group 'elfeed 299 :safe 'stringp) 300 301 (defcustom elfeed-save-multiple-enclosures-without-asking nil 302 "If non-nil, saving multiple enclosures asks once for a 303 directory and saves all attachments in the chosen directory." 304 :type 'boolean 305 :group 'elfeed) 306 307 (defvar elfeed-show-enclosure-filename-function 308 #'elfeed-show-enclosure-filename-remote 309 "Function called to generate the filename for an enclosure.") 310 311 (defun elfeed--download-enclosure (url path) 312 "Download asynchronously the enclosure from URL to PATH." 313 (if (require 'async nil :noerror) 314 (with-no-warnings 315 (async-start 316 (lambda () 317 (url-copy-file url path t)) 318 (lambda (_) 319 (message (format "%s downloaded" url))))) 320 (url-copy-file url path t))) 321 322 (defun elfeed--get-enclosure-num (prompt entry &optional multi) 323 "Ask the user with PROMPT for an enclosure number for ENTRY. 324 The number is [1..n] for enclosures \[0..(n-1)] in the entry. If 325 MULTI is nil, return the number for the enclosure; 326 otherwise (MULTI is non-nil), accept ranges of enclosure numbers, 327 as per `elfeed-split-ranges-to-numbers', and return the 328 corresponding string." 329 (let* ((count (length (elfeed-entry-enclosures entry))) 330 def) 331 (when (zerop count) 332 (error "No enclosures to this entry")) 333 (if (not multi) 334 (if (= count 1) 335 (read-number (format "%s: " prompt) 1) 336 (read-number (format "%s (1-%d): " prompt count))) 337 (progn 338 (setq def (if (= count 1) "1" (format "1-%d" count))) 339 (read-string (format "%s (default %s): " prompt def) 340 nil nil def))))) 341 342 (defun elfeed--request-enclosure-path (fname path) 343 "Ask the user where to save FNAME (default is PATH/FNAME)." 344 (let ((fpath (expand-file-name 345 (read-file-name "Save as: " path nil nil fname) path))) 346 (if (file-directory-p fpath) 347 (expand-file-name fname fpath) 348 fpath))) 349 350 (defun elfeed--request-enclosures-dir (path) 351 "Ask the user where to save multiple enclosures (default is PATH)." 352 (let ((fpath (expand-file-name 353 (read-directory-name 354 (format "Save in directory: ") path nil nil nil) path))) 355 (if (file-directory-p fpath) 356 fpath))) 357 358 (defun elfeed-show-enclosure-filename-remote (_entry url-enclosure) 359 "Returns the remote filename as local filename for an enclosure." 360 (file-name-nondirectory 361 (url-unhex-string 362 (car (url-path-and-query (url-generic-parse-url 363 url-enclosure)))))) 364 365 (defun elfeed-show-save-enclosure-single (&optional entry enclosure-index) 366 "Save enclosure number ENCLOSURE-INDEX from ENTRY. 367 If ENTRY is nil use the elfeed-show-entry variable. 368 If ENCLOSURE-INDEX is nil ask for the enclosure number." 369 (interactive) 370 (let* ((path elfeed-enclosure-default-dir) 371 (entry (or entry elfeed-show-entry)) 372 (enclosure-index (or enclosure-index 373 (elfeed--get-enclosure-num 374 "Enclosure to save" entry))) 375 (url-enclosure (car (elt (elfeed-entry-enclosures entry) 376 (- enclosure-index 1)))) 377 (fname 378 (funcall elfeed-show-enclosure-filename-function 379 entry url-enclosure)) 380 (retry t) 381 (fpath)) 382 (while retry 383 (setf fpath (elfeed--request-enclosure-path fname path) 384 retry (and (file-exists-p fpath) 385 (not (y-or-n-p (format "Overwrite '%s'?" fpath)))))) 386 (elfeed--download-enclosure url-enclosure fpath))) 387 388 (defun elfeed-show-save-enclosure-multi (&optional entry) 389 "Offer to save multiple entry enclosures from the current entry. 390 Default is to save all enclosures, [1..n], where n is the number of 391 enclosures. You can type multiple values separated by space, e.g. 392 1 3-6 8 393 will save enclosures 1,3,4,5,6 and 8. 394 395 Furthermore, there is a shortcut \"a\" which so means all 396 enclosures, but as this is the default, you may not need it." 397 (interactive) 398 (let* ((entry (or entry elfeed-show-entry)) 399 (attachstr (elfeed--get-enclosure-num 400 "Enclosure number range (or 'a' for 'all')" entry t)) 401 (count (length (elfeed-entry-enclosures entry))) 402 (attachnums (elfeed-split-ranges-to-numbers attachstr count)) 403 (path elfeed-enclosure-default-dir) 404 (fpath)) 405 (if elfeed-save-multiple-enclosures-without-asking 406 (let ((attachdir (elfeed--request-enclosures-dir path))) 407 (dolist (enclosure-index attachnums) 408 (let* ((url-enclosure 409 (aref (elfeed-entry-enclosures entry) enclosure-index)) 410 (fname 411 (funcall elfeed-show-enclosure-filename-function 412 entry url-enclosure)) 413 (retry t)) 414 (while retry 415 (setf fpath (expand-file-name (concat attachdir fname) path) 416 retry 417 (and (file-exists-p fpath) 418 (not (y-or-n-p (format "Overwrite '%s'?" fpath)))))) 419 (elfeed--download-enclosure url-enclosure fpath)))) 420 (dolist (enclosure-index attachnums) 421 (elfeed-show-save-enclosure-single entry enclosure-index))))) 422 423 (defun elfeed-show-save-enclosure (&optional multi) 424 "Offer to save enclosure(s). 425 If MULTI (prefix-argument) is nil, save a single one, otherwise, 426 offer to save a range of enclosures." 427 (interactive "P") 428 (if multi 429 (elfeed-show-save-enclosure-multi) 430 (elfeed-show-save-enclosure-single))) 431 432 (defun elfeed--enclosure-maybe-prompt-index (entry) 433 "Prompt for an enclosure if there are multiple in ENTRY." 434 (if (= 1 (length (elfeed-entry-enclosures entry))) 435 1 436 (elfeed--get-enclosure-num "Enclosure to play" entry))) 437 438 (defun elfeed-show-play-enclosure (enclosure-index) 439 "Play enclosure number ENCLOSURE-INDEX from current entry using EMMS. 440 Prompts for ENCLOSURE-INDEX when called interactively." 441 (interactive (list (elfeed--enclosure-maybe-prompt-index elfeed-show-entry))) 442 (elfeed-show-add-enclosure-to-playlist enclosure-index) 443 (with-no-warnings 444 (with-current-emms-playlist 445 (save-excursion 446 (emms-playlist-last) 447 (emms-playlist-mode-play-current-track))))) 448 449 (defun elfeed-show-add-enclosure-to-playlist (enclosure-index) 450 "Add enclosure number ENCLOSURE-INDEX to current EMMS playlist. 451 Prompts for ENCLOSURE-INDEX when called interactively." 452 453 (interactive (list (elfeed--enclosure-maybe-prompt-index elfeed-show-entry))) 454 (require 'emms) ;; optional 455 (with-no-warnings ;; due to lazy (require ) 456 (emms-add-url (car (elt (elfeed-entry-enclosures elfeed-show-entry) 457 (- enclosure-index 1)))))) 458 459 (defun elfeed-show-next-link () 460 "Skip to the next link, exclusive of the Link header." 461 (interactive) 462 (let ((properties (text-properties-at (line-beginning-position)))) 463 (when (memq 'message-header-name properties) 464 (forward-paragraph)) 465 (shr-next-link))) 466 467 (defun elfeed-kill-link-url-at-point () 468 "Get link URL at point and store in kill-ring." 469 (interactive) 470 (let ((url (or (elfeed-get-link-at-point) 471 (elfeed-get-url-at-point)))) 472 (if url 473 (progn (kill-new url) (message url)) 474 (call-interactively 'shr-copy-url)))) 475 476 ;; Bookmarks 477 478 ;;;###autoload 479 (defun elfeed-show-bookmark-handler (record) 480 "Show the bookmarked entry saved in the `RECORD'." 481 (let* ((id (bookmark-prop-get record 'id)) 482 (entry (elfeed-db-get-entry id)) 483 (position (bookmark-get-position record))) 484 (elfeed-show-entry entry) 485 (goto-char position))) 486 487 (defun elfeed-show-bookmark-make-record () 488 "Save the current position and the entry into a bookmark." 489 (let ((id (elfeed-entry-id elfeed-show-entry)) 490 (position (point)) 491 (title (elfeed-entry-title elfeed-show-entry))) 492 `(,(format "elfeed entry \"%s\"" title) 493 (id . ,id) 494 (location . ,title) 495 (position . ,position) 496 (handler . elfeed-show-bookmark-handler)))) 497 498 (provide 'elfeed-show) 499 500 ;;; elfeed-show.el ends here