diff options
| -rw-r--r-- | lisp/gnus/ChangeLog | 30 | ||||
| -rw-r--r-- | lisp/gnus/gnus-agent.el | 13 | ||||
| -rw-r--r-- | lisp/gnus/gnus-group.el | 4 | ||||
| -rw-r--r-- | lisp/gnus/gnus-html.el | 3 | ||||
| -rw-r--r-- | lisp/gnus/gnus-sum.el | 15 | ||||
| -rw-r--r-- | lisp/gnus/nnir.el | 79 | ||||
| -rw-r--r-- | lisp/gnus/shr.el | 30 |
7 files changed, 118 insertions, 56 deletions
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 1ba2f75b00c..2697a1c5409 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog | |||
| @@ -1,3 +1,33 @@ | |||
| 1 | 2010-10-24 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 2 | |||
| 3 | * gnus-html.el (gnus-html-prefetch-images): Decode entities before | ||
| 4 | prefetching images. | ||
| 5 | |||
| 6 | * gnus-sum.el (gnus-group-make-articles-read): Propagate marks to the | ||
| 7 | backend for unknown groups. This is mainly useful for nnimap groups. | ||
| 8 | |||
| 9 | * gnus-agent.el (gnus-agent-fetch-group): Don't download stuff if the | ||
| 10 | group isn't covered by the agent. | ||
| 11 | |||
| 12 | 2010-10-22 Andrew Cohen <cohen@andy.bu.edu> | ||
| 13 | |||
| 14 | * nnir.el (nnir-method-default-engines): new variable. | ||
| 15 | (nnir-run-query): use it. | ||
| 16 | (nnir-group-mode-hook): remove key binding and move to gnus-group.el. | ||
| 17 | (gnus-summary-nnir-goto-thread): change group if needed. | ||
| 18 | |||
| 19 | * gnus-group.el (gnus-group-group-map): add key binding for | ||
| 20 | gnus-group-make-nnir-group. | ||
| 21 | |||
| 22 | 2010-10-24 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 23 | |||
| 24 | * shr.el (shr-tag-object): Added. | ||
| 25 | |||
| 26 | * gnus-sum.el (gnus-summary-select-article): Make sure we have the | ||
| 27 | original article buffer live. | ||
| 28 | (gnus-summary-select-article-buffer): Mention | ||
| 29 | gnus-widen-article-buffer. | ||
| 30 | |||
| 1 | 2010-10-23 Lars Magne Ingebrigtsen <larsi@gnus.org> | 31 | 2010-10-23 Lars Magne Ingebrigtsen <larsi@gnus.org> |
| 2 | 32 | ||
| 3 | * shr.el (shr-tag-strong): Added. | 33 | * shr.el (shr-tag-strong): Added. |
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 7fdd5b4ea76..3597037236b 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el | |||
| @@ -801,12 +801,13 @@ be a select method." | |||
| 801 | (setq group (or group gnus-newsgroup-name)) | 801 | (setq group (or group gnus-newsgroup-name)) |
| 802 | (unless group | 802 | (unless group |
| 803 | (error "No group on the current line")) | 803 | (error "No group on the current line")) |
| 804 | 804 | (if (not (gnus-agent-group-covered-p group)) | |
| 805 | (gnus-agent-while-plugged | 805 | (message "%s isn't covered by the agent" group) |
| 806 | (let ((gnus-command-method (gnus-find-method-for-group group))) | 806 | (gnus-agent-while-plugged |
| 807 | (gnus-agent-with-fetch | 807 | (let ((gnus-command-method (gnus-find-method-for-group group))) |
| 808 | (gnus-agent-fetch-group-1 group gnus-command-method) | 808 | (gnus-agent-with-fetch |
| 809 | (gnus-message 5 "Fetching %s...done" group))))) | 809 | (gnus-agent-fetch-group-1 group gnus-command-method) |
| 810 | (gnus-message 5 "Fetching %s...done" group)))))) | ||
| 810 | 811 | ||
| 811 | (defun gnus-agent-add-group (category arg) | 812 | (defun gnus-agent-add-group (category arg) |
| 812 | "Add the current group to an agent category." | 813 | "Add the current group to an agent category." |
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 667c4bafcd8..7e2ea37e1a4 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el | |||
| @@ -55,6 +55,8 @@ | |||
| 55 | (autoload 'gnus-agent-total-fetched-for "gnus-agent") | 55 | (autoload 'gnus-agent-total-fetched-for "gnus-agent") |
| 56 | (autoload 'gnus-cache-total-fetched-for "gnus-cache") | 56 | (autoload 'gnus-cache-total-fetched-for "gnus-cache") |
| 57 | 57 | ||
| 58 | (autoload 'gnus-group-make-nnir-group "nnir") | ||
| 59 | |||
| 58 | (defcustom gnus-no-groups-message "No Gnus is good news" | 60 | (defcustom gnus-no-groups-message "No Gnus is good news" |
| 59 | "*Message displayed by Gnus when no groups are available." | 61 | "*Message displayed by Gnus when no groups are available." |
| 60 | :group 'gnus-start | 62 | :group 'gnus-start |
| @@ -653,6 +655,7 @@ simple manner.") | |||
| 653 | "D" gnus-group-enter-directory | 655 | "D" gnus-group-enter-directory |
| 654 | "f" gnus-group-make-doc-group | 656 | "f" gnus-group-make-doc-group |
| 655 | "w" gnus-group-make-web-group | 657 | "w" gnus-group-make-web-group |
| 658 | "G" gnus-group-make-nnir-group | ||
| 656 | "M" gnus-group-read-ephemeral-group | 659 | "M" gnus-group-read-ephemeral-group |
| 657 | "r" gnus-group-rename-group | 660 | "r" gnus-group-rename-group |
| 658 | "R" gnus-group-make-rss-group | 661 | "R" gnus-group-make-rss-group |
| @@ -904,6 +907,7 @@ simple manner.") | |||
| 904 | ["Add the help group" gnus-group-make-help-group t] | 907 | ["Add the help group" gnus-group-make-help-group t] |
| 905 | ["Make a doc group..." gnus-group-make-doc-group t] | 908 | ["Make a doc group..." gnus-group-make-doc-group t] |
| 906 | ["Make a web group..." gnus-group-make-web-group t] | 909 | ["Make a web group..." gnus-group-make-web-group t] |
| 910 | ["Make a search group..." gnus-group-make-nnir-group t] | ||
| 907 | ["Make a virtual group..." gnus-group-make-empty-virtual t] | 911 | ["Make a virtual group..." gnus-group-make-empty-virtual t] |
| 908 | ["Add a group to a virtual..." gnus-group-add-to-virtual t] | 912 | ["Add a group to a virtual..." gnus-group-add-to-virtual t] |
| 909 | ["Make an ephemeral group..." gnus-group-read-ephemeral-group t] | 913 | ["Make an ephemeral group..." gnus-group-read-ephemeral-group t] |
diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el index 77f771dc850..8571fdbe911 100644 --- a/lisp/gnus/gnus-html.el +++ b/lisp/gnus/gnus-html.el | |||
| @@ -494,7 +494,8 @@ This only works if the article in question is HTML." | |||
| 494 | (gnus-blocked-images)))) | 494 | (gnus-blocked-images)))) |
| 495 | (save-match-data | 495 | (save-match-data |
| 496 | (while (re-search-forward "<img[^>]+src=[\"']\\(http[^\"']+\\)" nil t) | 496 | (while (re-search-forward "<img[^>]+src=[\"']\\(http[^\"']+\\)" nil t) |
| 497 | (let ((url (gnus-html-encode-url (match-string 1)))) | 497 | (let ((url (gnus-html-encode-url |
| 498 | (mm-url-decode-entities-string (match-string 1))))) | ||
| 498 | (unless (gnus-html-image-url-blocked-p url blocked-images) | 499 | (unless (gnus-html-image-url-blocked-p url blocked-images) |
| 499 | (when (gnus-html-cache-expired url gnus-html-image-cache-ttl) | 500 | (when (gnus-html-cache-expired url gnus-html-image-cache-ttl) |
| 500 | (gnus-html-schedule-image-fetching nil | 501 | (gnus-html-schedule-image-fetching nil |
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index e4e611126a9..7380ccce152 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el | |||
| @@ -6190,7 +6190,13 @@ The resulting hash table is returned, or nil if no Xrefs were found." | |||
| 6190 | (info (nth 2 entry)) | 6190 | (info (nth 2 entry)) |
| 6191 | (active (gnus-active group)) | 6191 | (active (gnus-active group)) |
| 6192 | range) | 6192 | range) |
| 6193 | (when entry | 6193 | (if (not entry) |
| 6194 | ;; Group that Gnus doesn't know exists, but still allow the | ||
| 6195 | ;; backend to set marks. | ||
| 6196 | (gnus-request-set-mark | ||
| 6197 | group (list (list (gnus-compress-sequence (sort articles #'<)) | ||
| 6198 | 'add '(read)))) | ||
| 6199 | ;; Normal, subscribed groups. | ||
| 6194 | (setq range (gnus-compute-read-articles group articles)) | 6200 | (setq range (gnus-compute-read-articles group articles)) |
| 6195 | (with-current-buffer gnus-group-buffer | 6201 | (with-current-buffer gnus-group-buffer |
| 6196 | (gnus-undo-register | 6202 | (gnus-undo-register |
| @@ -6942,7 +6948,9 @@ displayed, no centering will be performed." | |||
| 6942 | ;; Various summary commands | 6948 | ;; Various summary commands |
| 6943 | 6949 | ||
| 6944 | (defun gnus-summary-select-article-buffer () | 6950 | (defun gnus-summary-select-article-buffer () |
| 6945 | "Reconfigure windows to show the article buffer." | 6951 | "Reconfigure windows to show the article buffer. |
| 6952 | If `gnus-widen-article-buffer' is set, show only the article | ||
| 6953 | buffer." | ||
| 6946 | (interactive) | 6954 | (interactive) |
| 6947 | (if (not (gnus-buffer-live-p gnus-article-buffer)) | 6955 | (if (not (gnus-buffer-live-p gnus-article-buffer)) |
| 6948 | (error "There is no article buffer for this summary buffer") | 6956 | (error "There is no article buffer for this summary buffer") |
| @@ -7584,7 +7592,8 @@ be displayed." | |||
| 7584 | (null (get-buffer gnus-article-buffer)) | 7592 | (null (get-buffer gnus-article-buffer)) |
| 7585 | (not (eq article (cdr gnus-article-current))) | 7593 | (not (eq article (cdr gnus-article-current))) |
| 7586 | (not (equal (car gnus-article-current) | 7594 | (not (equal (car gnus-article-current) |
| 7587 | gnus-newsgroup-name)))) | 7595 | gnus-newsgroup-name)) |
| 7596 | (not (buffer-name gnus-original-article-buffer)))) | ||
| 7588 | (and (not gnus-single-article-buffer) | 7597 | (and (not gnus-single-article-buffer) |
| 7589 | (or (null gnus-current-article) | 7598 | (or (null gnus-current-article) |
| 7590 | (not (eq gnus-current-article article)))) | 7599 | (not (eq gnus-current-article article)))) |
diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index 2a264d1fa32..a32d748a60c 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el | |||
| @@ -378,6 +378,10 @@ should return a message's headers in NOV format. | |||
| 378 | If this variable is nil, or if the provided function returns nil for a search | 378 | If this variable is nil, or if the provided function returns nil for a search |
| 379 | result, `gnus-retrieve-headers' will be called instead.") | 379 | result, `gnus-retrieve-headers' will be called instead.") |
| 380 | 380 | ||
| 381 | (defvar nnir-method-default-engines | ||
| 382 | '((nnimap . imap) | ||
| 383 | (nntp . nil)) | ||
| 384 | "Alist of default search engines by server method") | ||
| 381 | 385 | ||
| 382 | ;;; Developer Extension Variable: | 386 | ;;; Developer Extension Variable: |
| 383 | 387 | ||
| @@ -401,8 +405,8 @@ result, `gnus-retrieve-headers' will be called instead.") | |||
| 401 | ()) | 405 | ()) |
| 402 | (hyrex nnir-run-hyrex | 406 | (hyrex nnir-run-hyrex |
| 403 | ((group . "Group spec: "))) | 407 | ((group . "Group spec: "))) |
| 404 | (find-grep nnir-run-find-grep | 408 | (find-grep nnir-run-find-grep |
| 405 | ((grep-options . "Grep options: ")))) | 409 | ((grep-options . "Grep options: ")))) |
| 406 | "Alist of supported search engines. | 410 | "Alist of supported search engines. |
| 407 | Each element in the alist is a three-element list (ENGINE FUNCTION ARGS). | 411 | Each element in the alist is a three-element list (ENGINE FUNCTION ARGS). |
| 408 | ENGINE is a symbol designating the searching engine. FUNCTION is also | 412 | ENGINE is a symbol designating the searching engine. FUNCTION is also |
| @@ -677,16 +681,6 @@ that it is for Namazu, not Wais." | |||
| 677 | gnus-current-window-configuration) | 681 | gnus-current-window-configuration) |
| 678 | nil))) | 682 | nil))) |
| 679 | 683 | ||
| 680 | (eval-when-compile | ||
| 681 | (when (featurep 'xemacs) | ||
| 682 | ;; The `kbd' macro requires that the `read-kbd-macro' macro is available. | ||
| 683 | (require 'edmacro))) | ||
| 684 | |||
| 685 | (defun nnir-group-mode-hook () | ||
| 686 | (define-key gnus-group-mode-map (kbd "G G") | ||
| 687 | 'gnus-group-make-nnir-group)) | ||
| 688 | (add-hook 'gnus-group-mode-hook 'nnir-group-mode-hook) | ||
| 689 | |||
| 690 | ;; Why is this needed? Is this for compatibility with old/new gnusae? Using | 684 | ;; Why is this needed? Is this for compatibility with old/new gnusae? Using |
| 691 | ;; gnus-group-server instead works for me. -- Justus Piater | 685 | ;; gnus-group-server instead works for me. -- Justus Piater |
| 692 | (defmacro nnir-group-server (group) | 686 | (defmacro nnir-group-server (group) |
| @@ -716,22 +710,22 @@ and show thread that contains this article." | |||
| 716 | (id (mail-header-id (gnus-summary-article-header))) | 710 | (id (mail-header-id (gnus-summary-article-header))) |
| 717 | (refs (split-string | 711 | (refs (split-string |
| 718 | (mail-header-references (gnus-summary-article-header))))) | 712 | (mail-header-references (gnus-summary-article-header))))) |
| 719 | (if (string= (car (gnus-group-method group)) "nnimap") | 713 | (if (eq (car (gnus-group-method group)) 'nnimap) |
| 720 | (with-current-buffer (nnimap-buffer) | 714 | (progn (nnimap-possibly-change-group (gnus-group-short-name group) nil) |
| 721 | (let* ((cmd (let ((value | 715 | (with-current-buffer (nnimap-buffer) |
| 722 | (format | 716 | (let* ((cmd (let ((value (format |
| 723 | "(OR HEADER REFERENCES %s HEADER Message-Id %s)" | 717 | "(OR HEADER REFERENCES %s HEADER Message-Id %s)" |
| 724 | id id))) | 718 | id id))) |
| 725 | (dolist (refid refs value) | 719 | (dolist (refid refs value) |
| 726 | (setq value (format | 720 | (setq value (format |
| 727 | "(OR (OR HEADER Message-Id %s HEADER REFERENCES %s) %s)" | 721 | "(OR (OR HEADER Message-Id %s HEADER REFERENCES %s) %s)" |
| 728 | refid refid value))))) | 722 | refid refid value))))) |
| 729 | (result (nnimap-command | 723 | (result (nnimap-command |
| 730 | "UID SEARCH %s" cmd))) | 724 | "UID SEARCH %s" cmd))) |
| 731 | (gnus-summary-read-group-1 group t t gnus-summary-buffer nil | 725 | (gnus-summary-read-group-1 group t t gnus-summary-buffer nil |
| 732 | (and (car result) | 726 | (and (car result) |
| 733 | (delete 0 (mapcar #'string-to-number | 727 | (delete 0 (mapcar #'string-to-number |
| 734 | (cdr (assoc "SEARCH" (cdr result))))))))) | 728 | (cdr (assoc "SEARCH" (cdr result)))))))))) |
| 735 | (gnus-summary-read-group-1 group t t gnus-summary-buffer | 729 | (gnus-summary-read-group-1 group t t gnus-summary-buffer |
| 736 | nil (list backend-number)) | 730 | nil (list backend-number)) |
| 737 | (gnus-summary-limit (list backend-number)) | 731 | (gnus-summary-limit (list backend-number)) |
| @@ -1602,24 +1596,37 @@ and concat the results." | |||
| 1602 | (if gnus-group-marked | 1596 | (if gnus-group-marked |
| 1603 | (apply 'vconcat | 1597 | (apply 'vconcat |
| 1604 | (mapcar (lambda (x) | 1598 | (mapcar (lambda (x) |
| 1605 | (let ((server (nnir-group-server x)) | 1599 | (let* ((server (nnir-group-server x)) |
| 1606 | search-func) | 1600 | (engine |
| 1601 | (or (nnir-read-server-parm 'nnir-search-engine | ||
| 1602 | server) | ||
| 1603 | (cdr | ||
| 1604 | (assoc (car (gnus-server-to-method server)) | ||
| 1605 | nnir-method-default-engines)))) | ||
| 1606 | search-func) | ||
| 1607 | (setq search-func (cadr | 1607 | (setq search-func (cadr |
| 1608 | (assoc | 1608 | (assoc |
| 1609 | (nnir-read-server-parm 'nnir-search-engine server) nnir-engines))) | 1609 | engine |
| 1610 | nnir-engines))) | ||
| 1610 | (if search-func | 1611 | (if search-func |
| 1611 | (funcall search-func q server x) | 1612 | (funcall search-func q server x) |
| 1612 | nil))) | 1613 | nil))) |
| 1613 | gnus-group-marked) | 1614 | gnus-group-marked)) |
| 1614 | ) | ||
| 1615 | (apply 'vconcat | 1615 | (apply 'vconcat |
| 1616 | (mapcar (lambda (x) | 1616 | (mapcar (lambda (x) |
| 1617 | (if (and (equal (cadr x) 'ok) (not (equal (cadar x) "-ephemeral"))) | 1617 | (if (and (equal (cadr x) 'ok) (not (equal (cadar x) "-ephemeral"))) |
| 1618 | (let ((server (format "%s:%s" (caar x) (cadar x))) | 1618 | (let* ((server (format "%s:%s" (caar x) (cadar x))) |
| 1619 | search-func) | 1619 | (engine |
| 1620 | (or (nnir-read-server-parm 'nnir-search-engine | ||
| 1621 | server) | ||
| 1622 | (cdr | ||
| 1623 | (assoc (car (gnus-server-to-method server)) | ||
| 1624 | nnir-method-default-engines)))) | ||
| 1625 | search-func) | ||
| 1620 | (setq search-func (cadr | 1626 | (setq search-func (cadr |
| 1621 | (assoc | 1627 | (assoc |
| 1622 | (nnir-read-server-parm 'nnir-search-engine server) nnir-engines))) | 1628 | engine |
| 1629 | nnir-engines))) | ||
| 1623 | (if search-func | 1630 | (if search-func |
| 1624 | (funcall search-func q server nil) | 1631 | (funcall search-func q server nil) |
| 1625 | nil)) | 1632 | nil)) |
diff --git a/lisp/gnus/shr.el b/lisp/gnus/shr.el index 1eb629e4874..36e93338cb1 100644 --- a/lisp/gnus/shr.el +++ b/lisp/gnus/shr.el | |||
| @@ -424,6 +424,18 @@ Return a string with image data." | |||
| 424 | (apply #'shr-fontize-cont cont types) | 424 | (apply #'shr-fontize-cont cont types) |
| 425 | (shr-ensure-paragraph)) | 425 | (shr-ensure-paragraph)) |
| 426 | 426 | ||
| 427 | (defun shr-urlify (start url) | ||
| 428 | (widget-convert-button | ||
| 429 | 'url-link start (point) | ||
| 430 | :help-echo url | ||
| 431 | :keymap shr-map | ||
| 432 | url) | ||
| 433 | (put-text-property start (point) 'shr-url url)) | ||
| 434 | |||
| 435 | (defun shr-encode-url (url) | ||
| 436 | "Encode URL." | ||
| 437 | (browse-url-url-encode-chars url "[)$ ]")) | ||
| 438 | |||
| 427 | ;;; Tag-specific rendering rules. | 439 | ;;; Tag-specific rendering rules. |
| 428 | 440 | ||
| 429 | (defun shr-tag-p (cont) | 441 | (defun shr-tag-p (cont) |
| @@ -478,16 +490,14 @@ Return a string with image data." | |||
| 478 | (start (point)) | 490 | (start (point)) |
| 479 | shr-start) | 491 | shr-start) |
| 480 | (shr-generic cont) | 492 | (shr-generic cont) |
| 481 | (widget-convert-button | 493 | (shr-urlify (or shr-start start) url))) |
| 482 | 'url-link (or shr-start start) (point) | 494 | |
| 483 | :help-echo url | 495 | (defun shr-tag-object (cont) |
| 484 | :keymap shr-map | 496 | (let ((url (cdr (assq :src (cdr (assq 'embed cont))))) |
| 485 | url) | 497 | (start (point))) |
| 486 | (put-text-property (or shr-start start) (point) 'shr-url url))) | 498 | (when url |
| 487 | 499 | (shr-insert " [multimedia] ") | |
| 488 | (defun shr-encode-url (url) | 500 | (shr-urlify start url)))) |
| 489 | "Encode URL." | ||
| 490 | (browse-url-url-encode-chars url "[)$ ]")) | ||
| 491 | 501 | ||
| 492 | (defun shr-tag-img (cont) | 502 | (defun shr-tag-img (cont) |
| 493 | (when (and cont | 503 | (when (and cont |