aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/gnus/ChangeLog30
-rw-r--r--lisp/gnus/gnus-agent.el13
-rw-r--r--lisp/gnus/gnus-group.el4
-rw-r--r--lisp/gnus/gnus-html.el3
-rw-r--r--lisp/gnus/gnus-sum.el15
-rw-r--r--lisp/gnus/nnir.el79
-rw-r--r--lisp/gnus/shr.el30
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 @@
12010-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
122010-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
222010-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
12010-10-23 Lars Magne Ingebrigtsen <larsi@gnus.org> 312010-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.
6952If `gnus-widen-article-buffer' is set, show only the article
6953buffer."
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.
378If this variable is nil, or if the provided function returns nil for a search 378If this variable is nil, or if the provided function returns nil for a search
379result, `gnus-retrieve-headers' will be called instead.") 379result, `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.
407Each element in the alist is a three-element list (ENGINE FUNCTION ARGS). 411Each element in the alist is a three-element list (ENGINE FUNCTION ARGS).
408ENGINE is a symbol designating the searching engine. FUNCTION is also 412ENGINE 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