elfeed-search.el (37283B)
1 ;;; elfeed-search.el --- list 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 'browse-url) 9 (require 'wid-edit) ; widget-inactive face 10 (require 'bookmark) 11 (bookmark-maybe-load-default-file) 12 13 (require 'elfeed) 14 (require 'elfeed-db) 15 (require 'elfeed-lib) 16 17 ;; Interface to elfeed-show (lazy required) 18 (declare-function elfeed-show-entry 'elfeed-show (entry)) 19 20 (defvar elfeed-search-entries () 21 "List of the entries currently on display.") 22 23 (defvar elfeed-search-filter-history nil 24 "Filter history for `completing-read'.") 25 26 (defvar elfeed-search-last-update 0 27 "The last time the buffer was redrawn in epoch seconds.") 28 29 (defvar elfeed-search-update-hook () 30 "List of functions to run immediately following a search buffer update.") 31 32 (defcustom elfeed-search-filter "@6-months-ago +unread" 33 "Query string filtering shown entries." 34 :group 'elfeed 35 :type 'string) 36 37 (defcustom elfeed-sort-order 'descending 38 "The order in which entries should be displayed. 39 40 Changing this from the default will lead to misleading results 41 during live filter editing, but the results be will correct when 42 live filter editing is exited. " 43 :group 'elfeed 44 :type '(choice (const descending) (const ascending))) 45 46 (defcustom elfeed-search-sort-function nil 47 "Sort predicate applied to the list of entries before display. 48 49 This function must take two entries as arguments, an interface 50 suitable as the predicate for `sort'. 51 52 Changing this from the default will lead to misleading results 53 during live filter editing, but the results be will correct when 54 live filter editing is exited." 55 :group 'elfeed 56 :type '(choice function (const nil))) 57 58 (defcustom elfeed-search-remain-on-entry nil 59 "When non-nil, keep point at entry after performing a command. 60 61 When nil, move to next entry." 62 :group 'elfeed 63 :type 'boolean) 64 65 (defcustom elfeed-search-clipboard-type 'PRIMARY 66 "Selects the clipboard `elfeed-search-yank' should use. 67 Choices are the symbols PRIMARY, SECONDARY, or CLIPBOARD." 68 :group 'elfeed 69 :type '(choice (const PRIMARY) (const SECONDARY) (const CLIPBOARD))) 70 71 (defcustom elfeed-search-date-format '("%Y-%m-%d" 10 :left) 72 "The `format-time-string' format, target width, and alignment for dates. 73 74 This should be (string integer keyword) for (format width alignment). 75 Possible alignments are :left and :right." 76 :group 'elfeed 77 :type '(list string integer (choice (const :left) (const :right)))) 78 79 (defcustom elfeed-search-compile-filter t 80 "If non-nil, compile search filters into bytecode on the fly." 81 :group 'elfeed 82 :type 'boolean) 83 84 (defvar elfeed-search-filter-active nil 85 "When non-nil, Elfeed is currently reading a filter from the minibuffer. 86 When live editing the filter, it is bound to :live.") 87 88 (defvar elfeed-search-filter-overflowing nil 89 "When non-nil, the current live filter overflows the window.") 90 91 (defvar elfeed-search--offset 1 92 "Offset between line numbers and entry list position.") 93 94 (defvar elfeed-search-header-function #'elfeed-search--header 95 "Function that returns the string to be used for the Elfeed search header.") 96 97 (defvar elfeed-search-print-entry-function #'elfeed-search-print-entry--default 98 "Function to print entries into the *elfeed-search* buffer.") 99 100 (defalias 'elfeed-search-tag-all-unread 101 (elfeed-expose #'elfeed-search-tag-all 'unread) 102 "Add the `unread' tag to all selected entries.") 103 104 (defalias 'elfeed-search-untag-all-unread 105 (elfeed-expose #'elfeed-search-untag-all 'unread) 106 "Remove the `unread' tag from all selected entries.") 107 108 (defalias 'elfeed-search-update--force 109 (elfeed-expose #'elfeed-search-update :force) 110 "Force refresh view of the feed listing.") 111 112 (defun elfeed-search-quit-window () 113 "Save the database, then `quit-window'." 114 (interactive) 115 (elfeed-db-save) 116 (quit-window)) 117 118 (defun elfeed-search-last-entry () 119 "Place point on last entry." 120 (interactive) 121 (setf (point) (point-max)) 122 (forward-line -1)) 123 124 (defun elfeed-search-first-entry () 125 "Place point on first entry." 126 (interactive) 127 (setf (point) (point-min))) 128 129 (defvar elfeed-search-mode-map 130 (let ((map (make-sparse-keymap))) 131 (prog1 map 132 (suppress-keymap map) 133 (define-key map "h" #'describe-mode) 134 (define-key map "q" #'elfeed-search-quit-window) 135 (define-key map "g" #'elfeed-search-update--force) 136 (define-key map "G" #'elfeed-search-fetch) 137 (define-key map (kbd "RET") #'elfeed-search-show-entry) 138 (define-key map "s" #'elfeed-search-live-filter) 139 (define-key map "S" #'elfeed-search-set-filter) 140 (define-key map "c" #'elfeed-search-clear-filter) 141 (define-key map "b" #'elfeed-search-browse-url) 142 (define-key map "y" #'elfeed-search-yank) 143 (define-key map "u" #'elfeed-search-tag-all-unread) 144 (define-key map "r" #'elfeed-search-untag-all-unread) 145 (define-key map "n" #'next-line) 146 (define-key map "p" #'previous-line) 147 (define-key map "+" #'elfeed-search-tag-all) 148 (define-key map "-" #'elfeed-search-untag-all) 149 (define-key map "<" #'elfeed-search-first-entry) 150 (define-key map ">" #'elfeed-search-last-entry))) 151 "Keymap for elfeed-search-mode.") 152 153 (defun elfeed-search--intro-header () 154 "Return the header shown to new users." 155 (with-temp-buffer 156 (cl-flet ((button (f) 157 (insert-button (symbol-name f) 158 'follow-link t 159 'action (lambda (_) (call-interactively f))))) 160 (insert "Database empty. Use ") 161 (button 'elfeed-add-feed) 162 (insert ", or ") 163 (button 'elfeed-load-opml) 164 (insert ", or ") 165 (button 'elfeed-update) 166 (insert ".") 167 (buffer-string)))) 168 169 (defun elfeed-search--count-unread () 170 "Count the number of entries and feeds being currently displayed." 171 (if (and elfeed-search-filter-active elfeed-search-filter-overflowing) 172 "?/?:?" 173 (cl-loop with feeds = (make-hash-table :test 'equal) 174 for entry in elfeed-search-entries 175 for feed = (elfeed-entry-feed entry) 176 for url = (elfeed-feed-url feed) 177 count entry into entry-count 178 count (elfeed-tagged-p 'unread entry) into unread-count 179 do (puthash url t feeds) 180 finally 181 (cl-return 182 (format "%d/%d:%d" 183 unread-count entry-count 184 (hash-table-count feeds)))))) 185 186 (defun elfeed-search--header () 187 "Computes the string to be used as the Elfeed header." 188 (cond 189 ((zerop (elfeed-db-last-update)) 190 (elfeed-search--intro-header)) 191 ((> (elfeed-queue-count-total) 0) 192 (let ((total (elfeed-queue-count-total)) 193 (in-process (elfeed-queue-count-active))) 194 (format "%d jobs pending, %d active..." 195 (- total in-process) in-process))) 196 ((let* ((db-time (seconds-to-time (elfeed-db-last-update))) 197 (update (format-time-string "%Y-%m-%d %H:%M" db-time)) 198 (unread (elfeed-search--count-unread))) 199 (format "Updated %s, %s%s" 200 (propertize update 'face 'elfeed-search-last-update-face) 201 (propertize unread 'face 'elfeed-search-unread-count-face) 202 (cond 203 (elfeed-search-filter-active "") 204 ((string-match-p "[^ ]" elfeed-search-filter) 205 (concat ", " (propertize elfeed-search-filter 206 'face 'elfeed-search-filter-face))) 207 (""))))))) 208 209 (defun elfeed-search-mode () 210 "Major mode for listing elfeed feed entries. 211 \\{elfeed-search-mode-map}" 212 (interactive) 213 (kill-all-local-variables) 214 (use-local-map elfeed-search-mode-map) 215 (setq major-mode 'elfeed-search-mode 216 mode-name "elfeed-search" 217 truncate-lines t 218 buffer-read-only t 219 desktop-save-buffer #'elfeed-search-desktop-save 220 header-line-format '(:eval (funcall elfeed-search-header-function))) 221 (set (make-local-variable 'bookmark-make-record-function) 222 #'elfeed-search-bookmark-make-record) 223 (buffer-disable-undo) 224 (hl-line-mode) 225 (make-local-variable 'elfeed-search-entries) 226 (make-local-variable 'elfeed-search-filter) 227 (add-hook 'elfeed-update-hooks #'elfeed-search-update) 228 (add-hook 'elfeed-update-init-hooks #'elfeed-search-update--force) 229 (add-hook 'kill-buffer-hook #'elfeed-db-save t t) 230 (add-hook 'elfeed-db-unload-hook #'elfeed-search--unload) 231 (elfeed-search-update :force) 232 (run-mode-hooks 'elfeed-search-mode-hook)) 233 234 (defun elfeed-search-buffer () 235 (get-buffer-create "*elfeed-search*")) 236 237 (defun elfeed-search--unload () 238 "Hook function for `elfeed-db-unload-hook'." 239 (with-current-buffer (elfeed-search-buffer) 240 ;; don't try to save the database in this case 241 (remove-hook 'kill-buffer-hook #'elfeed-db-save t) 242 (kill-buffer ))) 243 244 (defun elfeed-search-format-date (date) 245 "Format a date for printing in `elfeed-search-mode'. 246 The customization `elfeed-search-date-format' sets the formatting." 247 (cl-destructuring-bind (format target alignment) elfeed-search-date-format 248 (let* ((string (format-time-string format (seconds-to-time date))) 249 (width (string-width string))) 250 (cond 251 ((> width target) 252 (if (eq alignment :left) 253 (substring string 0 target) 254 (substring string (- width target) width))) 255 ((< width target) 256 (let ((pad (make-string (- target width) ?\s))) 257 (if (eq alignment :left) 258 (concat string pad) 259 (concat pad string)))) 260 (string))))) 261 262 (defface elfeed-search-date-face 263 '((((class color) (background light)) (:foreground "#aaa")) 264 (((class color) (background dark)) (:foreground "#77a"))) 265 "Face used in search mode for dates." 266 :group 'elfeed) 267 268 (defface elfeed-search-title-face 269 '((((class color) (background light)) (:foreground "#000")) 270 (((class color) (background dark)) (:foreground "#fff"))) 271 "Face used in search mode for titles." 272 :group 'elfeed) 273 274 (defface elfeed-search-unread-title-face 275 '((t :weight bold)) 276 "Face used in search mode for unread entry titles." 277 :group 'elfeed) 278 279 (defface elfeed-search-feed-face 280 '((((class color) (background light)) (:foreground "#aa0")) 281 (((class color) (background dark)) (:foreground "#ff0"))) 282 "Face used in search mode for feed titles." 283 :group 'elfeed) 284 285 (defface elfeed-search-tag-face 286 '((((class color) (background light)) (:foreground "#070")) 287 (((class color) (background dark)) (:foreground "#0f0"))) 288 "Face used in search mode for tags." 289 :group 'elfeed) 290 291 (defface elfeed-search-last-update-face 292 '((t)) 293 "Face for showing the date and time the database was last updated." 294 :group 'elfeed) 295 296 (defface elfeed-search-unread-count-face 297 '((((class color) (background light)) (:foreground "#000")) 298 (((class color) (background dark)) (:foreground "#fff"))) 299 "Face used in search mode for unread entry titles." 300 :group 'elfeed) 301 302 (defface elfeed-search-filter-face 303 '((t :inherit mode-line-buffer-id)) 304 "Face for showing the current Elfeed search filter." 305 :group 'elfeed) 306 307 (defcustom elfeed-search-title-max-width 70 308 "Maximum column width for titles in the elfeed-search buffer." 309 :group 'elfeed 310 :type 'integer) 311 312 (defcustom elfeed-search-title-min-width 16 313 "Minimum column width for titles in the elfeed-search buffer." 314 :group 'elfeed 315 :type 'integer) 316 317 (defcustom elfeed-search-trailing-width 30 318 "Space reserved for displaying the feed and tag information." 319 :group 'elfeed 320 :type 'integer) 321 322 (defcustom elfeed-search-face-alist 323 '((unread elfeed-search-unread-title-face)) 324 "Mapping of tags to faces in the Elfeed entry listing." 325 :group 'elfeed 326 :type '(alist :key-type symbol :value-type (repeat face))) 327 328 (defun elfeed-search--faces (tags) 329 "Return all the faces that apply to an entry with TAGS." 330 (nconc (cl-loop for (tag . faces) in elfeed-search-face-alist 331 when (memq tag tags) 332 append faces) 333 (list 'elfeed-search-title-face))) 334 335 (defun elfeed-search-print-entry--default (entry) 336 "Print ENTRY to the buffer." 337 (let* ((date (elfeed-search-format-date (elfeed-entry-date entry))) 338 (title (or (elfeed-meta entry :title) (elfeed-entry-title entry) "")) 339 (title-faces (elfeed-search--faces (elfeed-entry-tags entry))) 340 (feed (elfeed-entry-feed entry)) 341 (feed-title 342 (when feed 343 (or (elfeed-meta feed :title) (elfeed-feed-title feed)))) 344 (tags (mapcar #'symbol-name (elfeed-entry-tags entry))) 345 (tags-str (mapconcat 346 (lambda (s) (propertize s 'face 'elfeed-search-tag-face)) 347 tags ",")) 348 (title-width (- (window-width) 10 elfeed-search-trailing-width)) 349 (title-column (elfeed-format-column 350 title (elfeed-clamp 351 elfeed-search-title-min-width 352 title-width 353 elfeed-search-title-max-width) 354 :left))) 355 (insert (propertize date 'face 'elfeed-search-date-face) " ") 356 (insert (propertize title-column 'face title-faces 'kbd-help title) " ") 357 (when feed-title 358 (insert (propertize feed-title 'face 'elfeed-search-feed-face) " ")) 359 (when tags 360 (insert "(" tags-str ")")))) 361 362 (defun elfeed-search-parse-filter (filter) 363 "Parse the elements of a search filter into a plist." 364 (let ((must-have ()) 365 (must-not-have ()) 366 (before nil) 367 (after nil) 368 (matches ()) 369 (not-matches ()) 370 (limit nil) 371 (feeds ()) 372 (not-feeds ())) 373 (cl-loop for element in (split-string filter) 374 for type = (aref element 0) 375 do (cl-case type 376 (?+ 377 (let ((symbol (intern (substring element 1)))) 378 (unless (eq '## symbol) 379 (push symbol must-have)))) 380 (?- 381 (let ((symbol (intern (substring element 1)))) 382 (unless (eq '## symbol) 383 (push symbol must-not-have)))) 384 (?@ (cl-multiple-value-bind (a b) 385 (split-string (substring element 1) "--") 386 (let ((duration-a (elfeed-time-duration a)) 387 (duration-b (and b (elfeed-time-duration b)))) 388 (when (and duration-b (> duration-b duration-a)) 389 (cl-rotatef duration-a duration-b)) 390 (when duration-b (setf before duration-b)) 391 (setf after duration-a)))) 392 (?! (let ((re (substring element 1))) 393 (when (elfeed-valid-regexp-p re) 394 (push re not-matches)))) 395 (?# (setf limit (string-to-number (substring element 1)))) 396 (?= (let ((re (substring element 1))) 397 (when (elfeed-valid-regexp-p re) 398 (push re feeds)))) 399 (?~ (let ((re (substring element 1))) 400 (when (elfeed-valid-regexp-p re) 401 (push re not-feeds)))) 402 (otherwise (when (elfeed-valid-regexp-p element) 403 (push element matches))))) 404 `(,@(when before 405 (list :before before)) 406 ,@(when after 407 (list :after after)) 408 ,@(when must-have 409 (list :must-have must-have)) 410 ,@(when must-not-have 411 (list :must-not-have must-not-have)) 412 ,@(when matches 413 (list :matches matches)) 414 ,@(when not-matches 415 (list :not-matches not-matches)) 416 ,@(when limit 417 (list :limit limit)) 418 ,@(when feeds 419 (list :feeds feeds)) 420 ,@(when not-feeds 421 (list :not-feeds not-feeds))))) 422 423 (defun elfeed-search--recover-time (seconds) 424 "Pick a reasonable filter representation for SECONDS." 425 (let ((units '((60 1 "minute") 426 (60 1 "hour") 427 (24 1 "day") 428 (7 1 "week") 429 (30 7 "month") 430 (1461 120 "year"))) 431 (value (float seconds)) 432 (name "second")) 433 (cl-loop for (n d unit) in units 434 for next-value = (/ (* value d) n) 435 when (< next-value 1.0) 436 return t 437 do (setf name unit 438 value next-value)) 439 (let ((count (format "%.4g" value))) 440 (format "%s-%s%s-ago" count name (if (equal count "1") "" "s"))))) 441 442 (defun elfeed-search--recover-units (after-seconds &optional before-seconds) 443 "Stringify the age or optionally the date range specified by 444 AFTER-SECONDS and BEFORE-SECONDS." 445 (apply 'concat "@" 446 (elfeed-search--recover-time after-seconds) 447 (when before-seconds 448 (list "--"(elfeed-search--recover-time before-seconds))))) 449 450 (defun elfeed-search-unparse-filter (filter) 451 "Inverse of `elfeed-search-parse-filter', returning a string. 452 453 The time (@n-units-ago) filter may not exactly match the 454 original, but will be equal in its effect." 455 (let ((output ())) 456 (cl-destructuring-bind (&key after before 457 must-have must-not-have 458 matches not-matches 459 feeds not-feeds 460 limit &allow-other-keys) 461 filter 462 (when after 463 (push (elfeed-search--recover-units after before) output)) 464 (dolist (tag must-have) 465 (push (format "+%S" tag) output)) 466 (dolist (tag must-not-have) 467 (push (format "-%S" tag) output)) 468 (dolist (re matches) 469 (push re output)) 470 (dolist (re not-matches) 471 (push (concat "!" re) output)) 472 (when limit 473 (push (format "#%d" limit) output)) 474 (dolist (feed feeds) 475 (push (format "=%s" feed) output)) 476 (dolist (feed not-feeds) 477 (push (format "~%s" feed) output)) 478 (mapconcat #'identity (nreverse output) " ")))) 479 480 (defun elfeed-search-filter (filter entry feed &optional count) 481 "Return non-nil if ENTRY and FEED pass FILTER. 482 483 COUNT is the total number of entries collected so far, for 484 filtering against a limit filter (ex. #10). 485 486 See `elfeed-search-set-filter' for format/syntax documentation. 487 This function must *only* be called within the body of 488 `with-elfeed-db-visit' because it may perform a non-local exit." 489 (cl-destructuring-bind (&key must-have must-not-have 490 matches not-matches 491 feeds not-feeds 492 after limit &allow-other-keys) 493 filter 494 (let* ((tags (elfeed-entry-tags entry)) 495 (date (elfeed-entry-date entry)) 496 (age (- (float-time) date)) 497 (title (or (elfeed-meta entry :title) (elfeed-entry-title entry))) 498 (link (elfeed-entry-link entry)) 499 (feed-title 500 (or (elfeed-meta feed :title) (elfeed-feed-title feed) "")) 501 (feed-id (elfeed-feed-id feed))) 502 (when (or (and after (> age after)) 503 (and limit (<= limit 0)) 504 (and limit count (>= count limit))) 505 (elfeed-db-return)) 506 (and (cl-every (lambda (tag) (memq tag tags)) must-have) 507 (cl-notany (lambda (tag) (memq tag tags)) must-not-have) 508 (or (null matches) 509 (cl-every 510 (lambda (m) 511 (or (and title (string-match-p m title)) 512 (and link (string-match-p m link)))) 513 matches)) 514 (cl-notany (lambda (m) 515 (or (and title (string-match-p m title)) 516 (and link (string-match-p m link)))) 517 not-matches) 518 (or (null feeds) 519 (cl-some (lambda (f) 520 (or (string-match-p f feed-id) 521 (string-match-p f feed-title))) 522 feeds)) 523 (cl-notany (lambda (f) 524 (or (string-match-p f feed-id) 525 (string-match-p f feed-title))) 526 not-feeds))))) 527 528 (defun elfeed-search-compile-filter (filter) 529 "Compile FILTER into a lambda function for `byte-compile'. 530 531 Executing a filter in bytecode form is generally faster than 532 \"interpreting\" the filter with `elfeed-search-filter'." 533 (cl-destructuring-bind (&key after before 534 must-have must-not-have 535 matches not-matches 536 feeds not-feeds 537 limit &allow-other-keys) 538 filter 539 `(lambda (,(if (or after matches not-matches must-have must-not-have) 540 'entry 541 '_entry) 542 ,(if (or feeds not-feeds) 543 'feed 544 '_feed) 545 ,(if limit 546 'count 547 '_count)) 548 (let* (,@(when after 549 '((date (elfeed-entry-date entry)) 550 (age (- (float-time) date)))) 551 ,@(when (or must-have must-not-have) 552 '((tags (elfeed-entry-tags entry)))) 553 ,@(when (or matches not-matches) 554 '((title (or (elfeed-meta entry :title) 555 (elfeed-entry-title entry))) 556 (link (elfeed-entry-link entry)))) 557 ,@(when (or feeds not-feeds) 558 '((feed-id (elfeed-feed-id feed)) 559 (feed-title (or (elfeed-meta feed :title) 560 (elfeed-feed-title feed) ""))))) 561 ,@(when after 562 `((when (> age ,after) 563 (elfeed-db-return)))) 564 ,@(when limit 565 `((when (>= count ,limit) 566 (elfeed-db-return)))) 567 (and ,@(cl-loop for forbid in must-not-have 568 collect `(not (memq ',forbid tags))) 569 ,@(cl-loop for forbid in must-have 570 collect `(memq ',forbid tags)) 571 ,@(cl-loop for regex in matches collect 572 `(or (string-match-p ,regex title) 573 (string-match-p ,regex link))) 574 ,@(cl-loop for regex in not-matches collect 575 `(not 576 (or (string-match-p ,regex title) 577 (string-match-p ,regex link)))) 578 ,@(when feeds 579 `((or ,@(cl-loop 580 for regex in feeds 581 collect `(string-match-p ,regex feed-id) 582 collect `(string-match-p ,regex feed-title))))) 583 ,@(when not-feeds 584 `((not 585 (or ,@(cl-loop 586 for regex in not-feeds 587 collect `(string-match-p ,regex feed-id) 588 collect `(string-match-p ,regex feed-title)))))) 589 ,@(when before 590 `((> age ,before)))))))) 591 592 (defun elfeed-search--prompt (current) 593 "Prompt for a new filter, starting with CURRENT." 594 (read-from-minibuffer 595 "Filter: " 596 (if (or (string= "" current) 597 (string-match-p " $" current)) 598 current 599 (concat current " ")) 600 nil nil 'elfeed-search-filter-history)) 601 602 (defun elfeed-search-clear-filter () 603 "Reset the search filter to the default value of `elfeed-search-filter'." 604 (interactive) 605 (setf elfeed-search-filter (default-value 'elfeed-search-filter)) 606 (elfeed-search-update--force)) 607 608 (defun elfeed-search-set-filter (new-filter) 609 "Set a new search filter for the elfeed-search buffer. 610 611 When NEW-FILTER is nil, reset the filter to the default value. 612 613 When given a prefix argument, the current filter is not displayed 614 in the minibuffer when prompting for a new filter. 615 616 Any component beginning with a + or - is treated as a tag. If + 617 the tag must be present on the entry. If - the tag must *not* be 618 present on the entry. Ex. \"+unread\" or \"+unread -comic\". 619 620 Any component beginning with an @ is an age limit or an age 621 range. If a limit, no posts older than this are allowed. If a 622 range, posts dates have to be inbetween the specified date 623 range. Examples: 624 - \"@3-days-ago\" 625 - \"@1-year-old\" 626 - \"@2019-06-24\" 627 - \"@2019-06-24--2019-06-24\" 628 - \"@5-days-ago--1-day-ago\" 629 630 Any component beginning with a # is an entry count maximum. The 631 number following # determines the maxiumum number of entries 632 to be shown (descending by date). Ex. \"#20\" or \"#100\". 633 634 Any component beginning with a = is a regular expression matching 635 the entry's feed (title or URL). Only entries belonging to a feed 636 that match at least one of the = expressions will be shown. 637 638 Every other space-seperated element is treated like a regular 639 expression, matching against entry link, title, and feed title." 640 (interactive 641 (let ((elfeed-search-filter-active :non-interactive)) 642 (list (elfeed-search--prompt 643 (if current-prefix-arg "" elfeed-search-filter))))) 644 (with-current-buffer (elfeed-search-buffer) 645 (setf elfeed-search-filter 646 (or new-filter (default-value 'elfeed-search-filter))) 647 (elfeed-search-update :force))) 648 649 (defun elfeed-search--update-list () 650 "Update `elfeed-search-filter' list." 651 (let* ((filter (elfeed-search-parse-filter elfeed-search-filter)) 652 (head (list nil)) 653 (tail head) 654 (count 0)) 655 (if elfeed-search-compile-filter 656 ;; Force lexical bindings regardless of the current 657 ;; buffer-local value. Lexical scope uses the faster 658 ;; stack-ref opcode instead of the traditional varref opcode. 659 (let ((lexical-binding t) 660 (func (byte-compile (elfeed-search-compile-filter filter)))) 661 (with-elfeed-db-visit (entry feed) 662 (when (funcall func entry feed count) 663 (setf (cdr tail) (list entry) 664 tail (cdr tail) 665 count (1+ count))))) 666 (with-elfeed-db-visit (entry feed) 667 (when (elfeed-search-filter filter entry feed count) 668 (setf (cdr tail) (list entry) 669 tail (cdr tail) 670 count (1+ count))))) 671 ;; Determine the final list order 672 (let ((entries (cdr head))) 673 (when elfeed-search-sort-function 674 (setf entries (sort entries elfeed-search-sort-function))) 675 (when (eq elfeed-sort-order 'ascending) 676 (setf entries (nreverse entries))) 677 (setf elfeed-search-entries 678 entries)))) 679 680 (defmacro elfeed-save-excursion (&rest body) 681 "Like `save-excursion', but by entry/line/column instead of point." 682 (declare (indent defun)) 683 `(let ((entry (elfeed-search-selected :single)) 684 (line (line-number-at-pos)) 685 (column (current-column))) 686 (unwind-protect 687 (progn ,@body) 688 (let ((entry-position (cl-position entry elfeed-search-entries))) 689 (elfeed-goto-line (if entry-position 690 (+ elfeed-search--offset entry-position) 691 line)) 692 (move-to-column column))))) 693 694 (defun elfeed-search-update (&optional force) 695 "Update the elfeed-search buffer listing to match the database. 696 When FORCE is non-nil, redraw even when the database hasn't changed." 697 (interactive) 698 (with-current-buffer (elfeed-search-buffer) 699 (when (or force (and (not elfeed-search-filter-active) 700 (< elfeed-search-last-update (elfeed-db-last-update)))) 701 (elfeed-save-excursion 702 (let ((inhibit-read-only t) 703 (standard-output (current-buffer))) 704 (erase-buffer) 705 (elfeed-search--update-list) 706 (dolist (entry elfeed-search-entries) 707 (funcall elfeed-search-print-entry-function entry) 708 (insert "\n")) 709 (setf elfeed-search-last-update (float-time)))) 710 (when (zerop (buffer-size)) 711 ;; If nothing changed, force a header line update 712 (force-mode-line-update)) 713 (run-hooks 'elfeed-search-update-hook)))) 714 715 (defun elfeed-search-fetch (prefix) 716 "Update all feeds via `elfeed-update', or only visible feeds with PREFIX. 717 Given a prefix, this function becomes `elfeed-search-fetch-visible'." 718 (interactive "P") 719 (if prefix 720 (elfeed-search-fetch-visible) 721 (elfeed-update))) 722 723 (defun elfeed-search-fetch-visible () 724 "Update any feed with an entry currently displayed in the search buffer." 725 (interactive) 726 (cl-loop with seen = (make-hash-table :test 'equal) 727 for entry in elfeed-search-entries 728 for feed = (elfeed-entry-feed entry) 729 for url = (elfeed-feed-url feed) 730 when (not (gethash url seen)) 731 do (elfeed-update-feed (setf (gethash url seen) url)))) 732 733 (defun elfeed-search-update-line (&optional n) 734 "Redraw the current line." 735 (let ((inhibit-read-only t)) 736 (save-excursion 737 (when n (elfeed-goto-line n)) 738 (let ((entry (elfeed-search-selected :ignore-region))) 739 (when entry 740 (elfeed-kill-line) 741 (funcall elfeed-search-print-entry-function entry)))))) 742 743 (defun elfeed-search-update-entry (entry) 744 "Redraw a specific entry." 745 (let ((n (cl-position entry elfeed-search-entries))) 746 (when n (elfeed-search-update-line (+ elfeed-search--offset n))))) 747 748 (defun elfeed-search-selected (&optional ignore-region-p) 749 "Return a list of the currently selected feeds. 750 751 If IGNORE-REGION-P is non-nil, only return the entry under point." 752 (let ((use-region (and (not ignore-region-p) (use-region-p)))) 753 (let ((start (if use-region (region-beginning) (point))) 754 (end (if use-region (region-end) (point)))) 755 (cl-loop for line from (line-number-at-pos start) 756 to (line-number-at-pos end) 757 for offset = (- line elfeed-search--offset) 758 when (and (>= offset 0) (nth offset elfeed-search-entries)) 759 collect it into selected 760 finally (return (if ignore-region-p 761 (car selected) 762 selected)))))) 763 764 (defun elfeed-search-browse-url (&optional use-generic-p) 765 "Visit the current entry in your browser using `browse-url'. 766 If there is a prefix argument, visit the current entry in the 767 browser defined by `browse-url-generic-program'." 768 (interactive "P") 769 (let ((entries (elfeed-search-selected))) 770 (cl-loop for entry in entries 771 do (elfeed-untag entry 'unread) 772 when (elfeed-entry-link entry) 773 do (if use-generic-p 774 (browse-url-generic it) 775 (browse-url it))) 776 (mapc #'elfeed-search-update-entry entries) 777 (unless (or elfeed-search-remain-on-entry (use-region-p)) 778 (forward-line)))) 779 780 (defun elfeed-search-yank () 781 "Copy the selected feed items to clipboard and kill-ring." 782 (interactive) 783 (let* ((entries (elfeed-search-selected)) 784 (links (mapcar #'elfeed-entry-link entries)) 785 (links-str (mapconcat #'identity links " "))) 786 (when entries 787 (elfeed-untag entries 'unread) 788 (kill-new links-str) 789 (if (fboundp 'gui-set-selection) 790 (gui-set-selection elfeed-search-clipboard-type links-str) 791 (with-no-warnings 792 (x-set-selection elfeed-search-clipboard-type links-str))) 793 (message "Copied: %s" links-str) 794 (mapc #'elfeed-search-update-entry entries) 795 (unless (or elfeed-search-remain-on-entry (use-region-p)) 796 (forward-line))))) 797 798 (defun elfeed-search-tag-all (tag) 799 "Apply TAG to all selected entries." 800 (interactive (list (intern (read-from-minibuffer "Tag: ")))) 801 (let ((entries (elfeed-search-selected))) 802 (elfeed-tag entries tag) 803 (mapc #'elfeed-search-update-entry entries) 804 (unless (or elfeed-search-remain-on-entry (use-region-p)) 805 (forward-line)))) 806 807 (defun elfeed-search-untag-all (tag) 808 "Remove TAG from all selected entries." 809 (interactive (list (intern (read-from-minibuffer "Tag: ")))) 810 (let ((entries (elfeed-search-selected))) 811 (elfeed-untag entries tag) 812 (mapc #'elfeed-search-update-entry entries) 813 (unless (or elfeed-search-remain-on-entry (use-region-p)) 814 (forward-line)))) 815 816 (defun elfeed-search-toggle-all (tag) 817 "Toggle TAG on all selected entries." 818 (interactive (list (intern (read-from-minibuffer "Tag: ")))) 819 (let ((entries (elfeed-search-selected)) entries-tag entries-untag) 820 (cl-loop for entry in entries 821 when (elfeed-tagged-p tag entry) 822 do (push entry entries-untag) 823 else do (push entry entries-tag)) 824 (elfeed-tag entries-tag tag) 825 (elfeed-untag entries-untag tag) 826 (mapc #'elfeed-search-update-entry entries) 827 (unless (or elfeed-search-remain-on-entry (use-region-p)) 828 (forward-line)))) 829 830 (defun elfeed-search-show-entry (entry) 831 "Display the currently selected item in a buffer." 832 (interactive (list (elfeed-search-selected :ignore-region))) 833 (require 'elfeed-show) 834 (when (elfeed-entry-p entry) 835 (elfeed-untag entry 'unread) 836 (elfeed-search-update-entry entry) 837 (unless elfeed-search-remain-on-entry (forward-line)) 838 (elfeed-show-entry entry))) 839 840 (defun elfeed-search-set-entry-title (title) 841 "Manually set the title for the entry under point. 842 Sets the :title key of the entry's metadata. See `elfeed-meta'." 843 (interactive "sTitle: ") 844 (let ((entry (elfeed-search-selected :ignore-region))) 845 (unless entry 846 (error "No entry selected!")) 847 (setf (elfeed-meta entry :title) title) 848 (elfeed-search-update-entry entry))) 849 850 (defun elfeed-search-set-feed-title (title) 851 "Manually set the title for the feed belonging to the entry under point. 852 Sets the :title key of the feed's metadata. See `elfeed-meta'." 853 (interactive "sTitle: ") 854 (let ((entry (elfeed-search-selected :ignore-region))) 855 (unless entry 856 (error "No entry selected!")) 857 (let ((feed (elfeed-entry-feed entry))) 858 (setf (elfeed-meta feed :title) title) 859 (dolist (to-fix elfeed-search-entries) 860 (elfeed-search-update-entry to-fix))))) 861 862 ;; Live Filters 863 864 (defvar elfeed-search-filter-syntax-table 865 (let ((table (make-syntax-table))) 866 (prog1 table 867 (modify-syntax-entry ?+ "w" table) 868 (modify-syntax-entry ?- "w" table) 869 (modify-syntax-entry ?= "w" table) 870 (modify-syntax-entry ?@ "w" table))) 871 "Syntax table active when editing the filter in the minibuffer.") 872 873 (defun elfeed-search--minibuffer-setup () 874 "Set up the minibuffer for live filtering." 875 (when elfeed-search-filter-active 876 (set-syntax-table elfeed-search-filter-syntax-table) 877 (when (eq :live elfeed-search-filter-active) 878 (add-hook 'post-command-hook 'elfeed-search--live-update nil :local)))) 879 880 (add-hook 'minibuffer-setup-hook 'elfeed-search--minibuffer-setup) 881 882 (defun elfeed-search--live-update () 883 "Update the elfeed-search buffer based on the contents of the minibuffer." 884 (when (eq :live elfeed-search-filter-active) 885 (let ((buffer (elfeed-search-buffer)) 886 (current-filter (minibuffer-contents-no-properties))) 887 (when buffer 888 (with-current-buffer buffer 889 (let* ((window (get-buffer-window (elfeed-search-buffer))) 890 (height (window-total-height window)) 891 (limiter (if window 892 (format "#%d " height) 893 "#1 ")) 894 (elfeed-search-filter (concat limiter current-filter))) 895 (elfeed-search-update :force) 896 (setf elfeed-search-filter-overflowing 897 (= (length elfeed-search-entries) 898 height)))))))) 899 900 (defun elfeed-search-live-filter () 901 "Filter the elfeed-search buffer as the filter is written." 902 (interactive) 903 (unwind-protect 904 (let ((elfeed-search-filter-active :live)) 905 (setq elfeed-search-filter 906 (read-from-minibuffer "Filter: " elfeed-search-filter))) 907 (elfeed-search-update :force))) 908 909 ;; Bookmarks 910 911 ;;;###autoload 912 (defun elfeed-search-bookmark-handler (record) 913 "Jump to an elfeed-search bookmarked location." 914 (elfeed) 915 (elfeed-search-set-filter (bookmark-prop-get record 'location))) 916 917 (defun elfeed-search-bookmark-make-record () 918 "Return a bookmark record for the current elfeed-search buffer." 919 (let* ((filter (elfeed-search-parse-filter elfeed-search-filter)) 920 (tags (plist-get filter :must-have))) 921 `(,(format "elfeed %s" elfeed-search-filter) 922 (location . ,elfeed-search-filter) 923 (tags ,@(mapcar #'symbol-name tags)) 924 (handler . elfeed-search-bookmark-handler)))) 925 926 ;; Desktop Save 927 928 (defun elfeed-search-desktop-save (_desktop-dirname) 929 "Save the state of the current elfeed-search buffer so that it 930 may be restored as part of a saved desktop. Also save the state 931 of the db for when `desktop-auto-save-timeout' is enabled." 932 (elfeed-db-save) 933 elfeed-search-filter) 934 935 ;;;###autoload 936 (defun elfeed-search-desktop-restore (_file-name _buffer-name search-filter) 937 "Restore the state of an elfeed-search buffer on desktop restore." 938 (elfeed) 939 (elfeed-search-set-filter search-filter) 940 (current-buffer)) 941 942 ;;;###autoload 943 (add-to-list 'desktop-buffer-mode-handlers 944 '(elfeed-search-mode . elfeed-search-desktop-restore)) 945 946 (provide 'elfeed-search) 947 948 ;;; elfeed-search.el ends here