diff options
| author | Gnus developers | 2014-03-23 23:13:36 +0000 |
|---|---|---|
| committer | Katsumi Yamaoka | 2014-03-23 23:13:36 +0000 |
| commit | 4d2226bff09b794fe2f5db3b2ae3b5b48188d4a7 (patch) | |
| tree | 9e6574c3b77ea47230b998641f0501b7f7374648 | |
| parent | b029599f767406002ea892d0bd40420de0a954f6 (diff) | |
| download | emacs-4d2226bff09b794fe2f5db3b2ae3b5b48188d4a7.tar.gz emacs-4d2226bff09b794fe2f5db3b2ae3b5b48188d4a7.zip | |
Merge from Gnus git master
2014-03-14 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-sum.el (gnus-summary-toggle-header): Display header attachment
buttons when toggling the header off.
2014-03-07 Daiki Ueno <ueno@gnu.org>
* mml2015.el (mml2015-use): Don't check the availability of GnuPG
commands here; instead, only check if epg-config.el is available.
2014-03-06 Lars Ingebrigtsen <larsi@gnus.org>
* mml.el (mml-expand-html-into-multipart-related): Allow sending HTML
messages with embedded images.
(mml-generate-mime): Don't bug out if you don't have libxml.
2014-03-06 Lars Ingebrigtsen <larsi@gnus.org>
* message.el (message-make-html-message-with-image-files): New command.
2014-03-05 Lars Ingebrigtsen <larsi@gnus.org>
* mml.el (mml-insert-mime-headers): Allow `recipient-filename'.
2014-02-23 David Engster <deng@randomsample.de>
* auth-source.el (auth-source-netrc-saver): Do not depend on `cl-lib'
to stay compatible with older Emacsen, so replace `cl-loop' with
`loop'.
2014-02-17 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-art.el (gnus-article-prepare, gnus-article-prepare-display):
Display header attachment buttons by gnus-article-prepare-display
rather than gnus-article-prepare so as to view in mml-preview as well.
2014-02-10 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-art.el (gnus-article-goto-part): Find a button in the body first.
(gnus-mime-buttonize-attachments-in-header): Number hidden buttons.
2014-02-07 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-art.el (gnus-mime-buttonize-attachments-in-header): Display
buttons that are hidden in unselected alternative part as well.
(gnus-mime-display-alternative): Redraw attachment buttons in header.
* gmm-utils.el (gmm-labels): Add edebug spec.
2014-02-07 Lars Ingebrigtsen <larsi@gnus.org>
* gnus-srvr.el (gnus-server-toggle-cloud-server): New command and
keystroke.
(gnus-server-toggle-cloud-server): Only allow clouding applicable
types.
2014-02-05 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus.el (gnus-copy-overlay, gnus-overlays-at): New functions.
* gnus-art.el (gnus-mime-display-attachment-buttons-in-header):
New user option.
(gnus-mime-buttonize-attachments-in-header): New function.
(gnus-article-prepare): Use it.
(gnus-mime-inline-part): Suppress extra newline.
(gnus-mm-display-part): Save excursion;
remove useless deleting and adding of buttons.
(gnus-insert-mime-button): Allow insertion in the middle of a line.
* gnus-sum.el (gnus-summary-wash-mime-map, gnus-summary-article-menu):
Add gnus-mime-buttonize-attachments-in-header.
2014-02-05 Lars Ingebrigtsen <larsi@gnus.org>
* nnimap.el (nnimap-request-articles): New command to download several
articles at once.
* gnus.el (gnus-variable-list): Save Cloud variables.
2014-02-01 Lars Ingebrigtsen <larsi@gnus.org>
* gnus-cloud.el: New file to provide the Emacs Cloud.
* gravatar.el (gravatar-retrieve-synchronously): XEmacs also has
`url-retrieve-synchronously', apparently.
* gnus-notifications.el (gravatar-retrieve-synchronously): Declare for
XEmacs.
* nnrss.el (libxml-parse-html-region): Silence compilation error.
2014-02-01 Daniel Dehennin <daniel.dehennin@baby-gnu.org>
* gnus-mlspl.el (gnus-group-split-fancy): Use `gnus-parameters' in
`gnus-group-split-fancy'.
2014-02-01 Lars Ingebrigtsen <larsi@gnus.org>
* message.el (message-remove-header): Doc fix.
(message-forward-included-headers): New variable.
(message-remove-ignored-headers): Use it.
2014-01-31 Dave Abrahams <dave@boostpro.com>
* gnus-sum.el (gnus-summary-open-group-with-article): New command.
2013-09-04 Rasmus Pank Roulund <emacs@pank.eu>
* gnus-fun.el (gnus-x-face-omit-files): Regexp to omit matched results
from random face commands.
(gnus-face-directory): Like `gnus-x-face-directory` for png files and
Face.
(gnus-face-omit-files): Like `gnus-x-face-omit-files` for Face.
(gnus--random-face-with-type): Generic function returning a face-type
as a string.
(gnus--insert-random-face-with-type): Generic function inserting a face
in a message buffer header.
(gnus-random-x-face): Rewritten to use `gnus--random-face-with-type`.
(gnus-insert-random-x-face-header): Rewritten to use
`gnus--insert-random-face-with-type`.
(gnus-random-face): Return random (png) Face as string.
(nus-insert-random-face-header): Insert random (png) Face in a message
buffer.
2014-01-31 Lars Ingebrigtsen <larsi@gnus.org>
* mm-url.el: Remove all usage of w3.
* nnrss.el: Ditto.
* mm-decode.el: Ditto.
* mm-view.el: Ditto.
* gnus-setup.el: Remove outdated file.
46 files changed, 598 insertions, 546 deletions
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index cdf22ef256a..99b0ccd84d1 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog | |||
| @@ -1,3 +1,139 @@ | |||
| 1 | 2014-03-23 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 2 | |||
| 3 | * gnus-sum.el (gnus-summary-toggle-header): Display header attachment | ||
| 4 | buttons when toggling the header off. | ||
| 5 | |||
| 6 | 2014-03-23 Daiki Ueno <ueno@gnu.org> | ||
| 7 | |||
| 8 | * mml2015.el (mml2015-use): Don't check the availability of GnuPG | ||
| 9 | commands here; instead, only check if epg-config.el is available. | ||
| 10 | |||
| 11 | 2014-03-23 Lars Ingebrigtsen <larsi@gnus.org> | ||
| 12 | |||
| 13 | * mml.el (mml-expand-html-into-multipart-related): Allow sending HTML | ||
| 14 | messages with embedded images. | ||
| 15 | (mml-generate-mime): Don't bug out if you don't have libxml. | ||
| 16 | |||
| 17 | 2014-03-23 Lars Ingebrigtsen <larsi@gnus.org> | ||
| 18 | |||
| 19 | * message.el (message-make-html-message-with-image-files): New command. | ||
| 20 | |||
| 21 | 2014-03-23 Lars Ingebrigtsen <larsi@gnus.org> | ||
| 22 | |||
| 23 | * mml.el (mml-insert-mime-headers): Allow `recipient-filename'. | ||
| 24 | |||
| 25 | 2014-03-23 David Engster <deng@randomsample.de> | ||
| 26 | |||
| 27 | * auth-source.el (auth-source-netrc-saver): Do not depend on `cl-lib' | ||
| 28 | to stay compatible with older Emacsen, so replace `cl-loop' with | ||
| 29 | `loop'. | ||
| 30 | |||
| 31 | 2014-03-23 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 32 | |||
| 33 | * gnus-art.el (gnus-article-prepare, gnus-article-prepare-display): | ||
| 34 | Display header attachment buttons by gnus-article-prepare-display | ||
| 35 | rather than gnus-article-prepare so as to view in mml-preview as well. | ||
| 36 | |||
| 37 | 2014-03-23 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 38 | |||
| 39 | * gnus-art.el (gnus-article-goto-part): Find a button in the body first. | ||
| 40 | (gnus-mime-buttonize-attachments-in-header): Number hidden buttons. | ||
| 41 | |||
| 42 | 2014-03-23 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 43 | |||
| 44 | * gnus-art.el (gnus-mime-buttonize-attachments-in-header): Display | ||
| 45 | buttons that are hidden in unselected alternative part as well. | ||
| 46 | (gnus-mime-display-alternative): Redraw attachment buttons in header. | ||
| 47 | |||
| 48 | * gmm-utils.el (gmm-labels): Add edebug spec. | ||
| 49 | |||
| 50 | 2014-03-23 Lars Ingebrigtsen <larsi@gnus.org> | ||
| 51 | |||
| 52 | * gnus-srvr.el (gnus-server-toggle-cloud-server): New command and | ||
| 53 | keystroke. | ||
| 54 | (gnus-server-toggle-cloud-server): Only allow clouding applicable | ||
| 55 | types. | ||
| 56 | |||
| 57 | 2014-03-23 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 58 | |||
| 59 | * gnus.el (gnus-copy-overlay, gnus-overlays-at): New functions. | ||
| 60 | |||
| 61 | * gnus-art.el (gnus-mime-display-attachment-buttons-in-header): | ||
| 62 | New user option. | ||
| 63 | (gnus-mime-buttonize-attachments-in-header): New function. | ||
| 64 | (gnus-article-prepare): Use it. | ||
| 65 | (gnus-mime-inline-part): Suppress extra newline. | ||
| 66 | (gnus-mm-display-part): Save excursion; | ||
| 67 | remove useless deleting and adding of buttons. | ||
| 68 | (gnus-insert-mime-button): Allow insertion in the middle of a line. | ||
| 69 | |||
| 70 | * gnus-sum.el (gnus-summary-wash-mime-map, gnus-summary-article-menu): | ||
| 71 | Add gnus-mime-buttonize-attachments-in-header. | ||
| 72 | |||
| 73 | 2014-03-23 Lars Ingebrigtsen <larsi@gnus.org> | ||
| 74 | |||
| 75 | * nnimap.el (nnimap-request-articles): New command to download several | ||
| 76 | articles at once. | ||
| 77 | |||
| 78 | * gnus.el (gnus-variable-list): Save Cloud variables. | ||
| 79 | |||
| 80 | 2014-03-23 Lars Ingebrigtsen <larsi@gnus.org> | ||
| 81 | |||
| 82 | * gnus-cloud.el: New file to provide the Emacs Cloud. | ||
| 83 | |||
| 84 | * gravatar.el (gravatar-retrieve-synchronously): XEmacs also has | ||
| 85 | `url-retrieve-synchronously', apparently. | ||
| 86 | |||
| 87 | * gnus-notifications.el (gravatar-retrieve-synchronously): Declare for | ||
| 88 | XEmacs. | ||
| 89 | |||
| 90 | * nnrss.el (libxml-parse-html-region): Silence compilation error. | ||
| 91 | |||
| 92 | 2014-03-23 Daniel Dehennin <daniel.dehennin@baby-gnu.org> | ||
| 93 | |||
| 94 | * gnus-mlspl.el (gnus-group-split-fancy): Use `gnus-parameters' in | ||
| 95 | `gnus-group-split-fancy'. | ||
| 96 | |||
| 97 | 2014-03-23 Lars Ingebrigtsen <larsi@gnus.org> | ||
| 98 | |||
| 99 | * message.el (message-remove-header): Doc fix. | ||
| 100 | (message-forward-included-headers): New variable. | ||
| 101 | (message-remove-ignored-headers): Use it. | ||
| 102 | |||
| 103 | 2014-03-23 Dave Abrahams <dave@boostpro.com> | ||
| 104 | |||
| 105 | * gnus-sum.el (gnus-summary-open-group-with-article): New command. | ||
| 106 | |||
| 107 | 2014-03-23 Rasmus Pank Roulund <emacs@pank.eu> | ||
| 108 | |||
| 109 | * gnus-fun.el (gnus-x-face-omit-files): Regexp to omit matched results | ||
| 110 | from random face commands. | ||
| 111 | (gnus-face-directory): Like `gnus-x-face-directory` for png files and | ||
| 112 | Face. | ||
| 113 | (gnus-face-omit-files): Like `gnus-x-face-omit-files` for Face. | ||
| 114 | (gnus--random-face-with-type): Generic function returning a face-type | ||
| 115 | as a string. | ||
| 116 | (gnus--insert-random-face-with-type): Generic function inserting a face | ||
| 117 | in a message buffer header. | ||
| 118 | (gnus-random-x-face): Rewritten to use `gnus--random-face-with-type`. | ||
| 119 | (gnus-insert-random-x-face-header): Rewritten to use | ||
| 120 | `gnus--insert-random-face-with-type`. | ||
| 121 | (gnus-random-face): Return random (png) Face as string. | ||
| 122 | (nus-insert-random-face-header): Insert random (png) Face in a message | ||
| 123 | buffer. | ||
| 124 | |||
| 125 | 2014-03-23 Lars Ingebrigtsen <larsi@gnus.org> | ||
| 126 | |||
| 127 | * mm-url.el: Remove all usage of w3. | ||
| 128 | |||
| 129 | * nnrss.el: Ditto. | ||
| 130 | |||
| 131 | * mm-decode.el: Ditto. | ||
| 132 | |||
| 133 | * mm-view.el: Ditto. | ||
| 134 | |||
| 135 | * gnus-setup.el: Remove outdated file. | ||
| 136 | |||
| 1 | 2014-03-07 Lars Ingebrigtsen <larsi@gnus.org> | 137 | 2014-03-07 Lars Ingebrigtsen <larsi@gnus.org> |
| 2 | 138 | ||
| 3 | * nnimap.el (nnimap-request-accept-article): Make respooling to nnimap | 139 | * nnimap.el (nnimap-request-accept-article): Make respooling to nnimap |
diff --git a/lisp/gnus/auth-source.el b/lisp/gnus/auth-source.el index a50ad75063b..42db423ac8a 100644 --- a/lisp/gnus/auth-source.el +++ b/lisp/gnus/auth-source.el | |||
| @@ -1524,10 +1524,10 @@ list, it matches the original pattern." | |||
| 1524 | (heads (if (stringp value) | 1524 | (heads (if (stringp value) |
| 1525 | (list (list key value)) | 1525 | (list (list key value)) |
| 1526 | (mapcar (lambda (v) (list key v)) value)))) | 1526 | (mapcar (lambda (v) (list key v)) value)))) |
| 1527 | (cl-loop | 1527 | (loop |
| 1528 | for h in heads | 1528 | for h in heads |
| 1529 | nconc | 1529 | nconc |
| 1530 | (cl-loop | 1530 | (loop |
| 1531 | for tl in tails | 1531 | for tl in tails |
| 1532 | collect (append h tl)))))) | 1532 | collect (append h tl)))))) |
| 1533 | 1533 | ||
diff --git a/lisp/gnus/gmm-utils.el b/lisp/gnus/gmm-utils.el index 8ce29323088..63947e5f486 100644 --- a/lisp/gnus/gmm-utils.el +++ b/lisp/gnus/gmm-utils.el | |||
| @@ -441,6 +441,7 @@ rather than relying on `lexical-binding'. | |||
| 441 | `(,(progn (require 'cl) (if (fboundp 'cl-labels) 'cl-labels 'labels)) | 441 | `(,(progn (require 'cl) (if (fboundp 'cl-labels) 'cl-labels 'labels)) |
| 442 | ,bindings ,@body)) | 442 | ,bindings ,@body)) |
| 443 | (put 'gmm-labels 'lisp-indent-function 1) | 443 | (put 'gmm-labels 'lisp-indent-function 1) |
| 444 | (put 'gmm-labels 'edebug-form-spec '((&rest (sexp sexp &rest form)) &rest form)) | ||
| 444 | 445 | ||
| 445 | (provide 'gmm-utils) | 446 | (provide 'gmm-utils) |
| 446 | 447 | ||
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 29d70aa1a86..008fa266ea5 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el | |||
| @@ -24,9 +24,6 @@ | |||
| 24 | 24 | ||
| 25 | ;;; Code: | 25 | ;;; Code: |
| 26 | 26 | ||
| 27 | ;; For Emacs <22.2 and XEmacs. | ||
| 28 | (eval-and-compile | ||
| 29 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) | ||
| 30 | (eval-when-compile | 27 | (eval-when-compile |
| 31 | (require 'cl)) | 28 | (require 'cl)) |
| 32 | (defvar tool-bar-map) | 29 | (defvar tool-bar-map) |
| @@ -4728,7 +4725,10 @@ If ALL-HEADERS is non-nil, no headers are hidden." | |||
| 4728 | gnus-article-image-alist nil) | 4725 | gnus-article-image-alist nil) |
| 4729 | (gnus-run-hooks 'gnus-tmp-internal-hook) | 4726 | (gnus-run-hooks 'gnus-tmp-internal-hook) |
| 4730 | (when gnus-display-mime-function | 4727 | (when gnus-display-mime-function |
| 4731 | (funcall gnus-display-mime-function)))) | 4728 | (funcall gnus-display-mime-function)) |
| 4729 | ;; Add attachment buttons to the header. | ||
| 4730 | (when gnus-mime-display-attachment-buttons-in-header | ||
| 4731 | (gnus-mime-buttonize-attachments-in-header)))) | ||
| 4732 | 4732 | ||
| 4733 | ;;; | 4733 | ;;; |
| 4734 | ;;; Gnus Sticky Article Mode | 4734 | ;;; Gnus Sticky Article Mode |
| @@ -5331,7 +5331,7 @@ Compressed files like .gz and .bz2 are decompressed." | |||
| 5331 | (mm-read-coding-system "Charset: ")))) | 5331 | (mm-read-coding-system "Charset: ")))) |
| 5332 | ((mm-handle-undisplayer handle) | 5332 | ((mm-handle-undisplayer handle) |
| 5333 | (mm-remove-part handle))) | 5333 | (mm-remove-part handle))) |
| 5334 | (forward-line 2) | 5334 | (forward-line 1) |
| 5335 | (mm-display-inline handle) | 5335 | (mm-display-inline handle) |
| 5336 | (goto-char b))))) | 5336 | (goto-char b))))) |
| 5337 | 5337 | ||
| @@ -5656,33 +5656,32 @@ all parts." | |||
| 5656 | (if (mm-handle-displayed-p handle) | 5656 | (if (mm-handle-displayed-p handle) |
| 5657 | ;; This will remove the part. | 5657 | ;; This will remove the part. |
| 5658 | (mm-display-part handle) | 5658 | (mm-display-part handle) |
| 5659 | (save-restriction | 5659 | (save-window-excursion |
| 5660 | (narrow-to-region (point) | 5660 | (save-restriction |
| 5661 | (if (eobp) (point) (1+ (point)))) | 5661 | (narrow-to-region (point) |
| 5662 | (gnus-bind-safe-url-regexp (mm-display-part handle)) | 5662 | (if (eobp) (point) (1+ (point)))) |
| 5663 | ;; We narrow to the part itself and | 5663 | (gnus-bind-safe-url-regexp (mm-display-part handle)) |
| 5664 | ;; then call the treatment functions. | 5664 | ;; We narrow to the part itself and |
| 5665 | (goto-char (point-min)) | 5665 | ;; then call the treatment functions. |
| 5666 | (forward-line 1) | 5666 | (goto-char (point-min)) |
| 5667 | (narrow-to-region (point) (point-max)) | 5667 | (forward-line 1) |
| 5668 | (gnus-treat-article | 5668 | (narrow-to-region (point) (point-max)) |
| 5669 | nil id | 5669 | (gnus-treat-article |
| 5670 | (gnus-article-mime-total-parts) | 5670 | nil id |
| 5671 | (mm-handle-media-type handle))))) | 5671 | (gnus-article-mime-total-parts) |
| 5672 | (mm-handle-media-type handle)))))) | ||
| 5672 | (if (window-live-p window) | 5673 | (if (window-live-p window) |
| 5673 | (select-window window))))) | 5674 | (select-window window)))))))) |
| 5674 | (goto-char point) | ||
| 5675 | (gnus-delete-line) | ||
| 5676 | (gnus-insert-mime-button | ||
| 5677 | handle id (list (mm-handle-displayed-p handle))) | ||
| 5678 | (goto-char point)))) | ||
| 5679 | 5675 | ||
| 5680 | (defun gnus-article-goto-part (n) | 5676 | (defun gnus-article-goto-part (n) |
| 5681 | "Go to MIME part N." | 5677 | "Go to MIME part N." |
| 5682 | (when gnus-break-pages | 5678 | (when gnus-break-pages |
| 5683 | (widen)) | 5679 | (widen)) |
| 5680 | (article-goto-body) | ||
| 5684 | (prog1 | 5681 | (prog1 |
| 5685 | (let ((start (text-property-any (point-min) (point-max) 'gnus-part n)) | 5682 | (let ((start (or (text-property-any (point) (point-max) 'gnus-part n) |
| 5683 | ;; There may be header buttons. | ||
| 5684 | (text-property-any (point-min) (point) 'gnus-part n))) | ||
| 5686 | part handle end next handles) | 5685 | part handle end next handles) |
| 5687 | (when start | 5686 | (when start |
| 5688 | (goto-char start) | 5687 | (goto-char start) |
| @@ -5736,8 +5735,6 @@ all parts." | |||
| 5736 | (concat "; " gnus-tmp-name)))) | 5735 | (concat "; " gnus-tmp-name)))) |
| 5737 | (unless (equal gnus-tmp-description "") | 5736 | (unless (equal gnus-tmp-description "") |
| 5738 | (setq gnus-tmp-type-long (concat " --- " gnus-tmp-type-long))) | 5737 | (setq gnus-tmp-type-long (concat " --- " gnus-tmp-type-long))) |
| 5739 | (unless (bolp) | ||
| 5740 | (insert "\n")) | ||
| 5741 | (setq b (point)) | 5738 | (setq b (point)) |
| 5742 | (gnus-eval-format | 5739 | (gnus-eval-format |
| 5743 | gnus-mime-button-line-format gnus-mime-button-line-format-alist | 5740 | gnus-mime-button-line-format gnus-mime-button-line-format-alist |
| @@ -5862,6 +5859,16 @@ If displaying \"text/html\" is discouraged \(see | |||
| 5862 | :group 'gnus-article-mime | 5859 | :group 'gnus-article-mime |
| 5863 | :type 'boolean) | 5860 | :type 'boolean) |
| 5864 | 5861 | ||
| 5862 | (defcustom gnus-mime-display-attachment-buttons-in-header t | ||
| 5863 | "Add attachment buttons in the end of the header of an article. | ||
| 5864 | Since MIME attachments tend to be put at the end of an article, we may | ||
| 5865 | overlook them if there is a huge body. This option offers you a copy | ||
| 5866 | of all non-inlinable MIME parts as buttons shown in front of an article. | ||
| 5867 | If nil, don't show those extra buttons." | ||
| 5868 | :version "24.5" | ||
| 5869 | :group 'gnus-article | ||
| 5870 | :type 'boolean) | ||
| 5871 | |||
| 5865 | (defun gnus-mime-display-part (handle) | 5872 | (defun gnus-mime-display-part (handle) |
| 5866 | (cond | 5873 | (cond |
| 5867 | ;; Maybe a broken MIME message. | 5874 | ;; Maybe a broken MIME message. |
| @@ -5884,14 +5891,6 @@ If displaying \"text/html\" is discouraged \(see | |||
| 5884 | ((and (equal (car handle) "multipart/related") | 5891 | ((and (equal (car handle) "multipart/related") |
| 5885 | (not (or gnus-mime-display-multipart-as-mixed | 5892 | (not (or gnus-mime-display-multipart-as-mixed |
| 5886 | gnus-mime-display-multipart-related-as-mixed))) | 5893 | gnus-mime-display-multipart-related-as-mixed))) |
| 5887 | ;;;!!!We should find the start part, but we just default | ||
| 5888 | ;;;!!!to the first part. | ||
| 5889 | ;;(gnus-mime-display-part (cadr handle)) | ||
| 5890 | ;;;!!! Most multipart/related is an HTML message plus images. | ||
| 5891 | ;;;!!! Unfortunately we are unable to let W3 display those | ||
| 5892 | ;;;!!! included images, so we just display it as a mixed multipart. | ||
| 5893 | ;;(gnus-mime-display-mixed (cdr handle)) | ||
| 5894 | ;;;!!! No, w3 can display everything just fine. | ||
| 5895 | (gnus-mime-display-part (cadr handle))) | 5894 | (gnus-mime-display-part (cadr handle))) |
| 5896 | ((equal (car handle) "multipart/signed") | 5895 | ((equal (car handle) "multipart/signed") |
| 5897 | (gnus-add-wash-type 'signed) | 5896 | (gnus-add-wash-type 'signed) |
| @@ -6110,7 +6109,10 @@ If displaying \"text/html\" is discouraged \(see | |||
| 6110 | (goto-char (point-max)) | 6109 | (goto-char (point-max)) |
| 6111 | (setcdr begend (point-marker))))) | 6110 | (setcdr begend (point-marker))))) |
| 6112 | (when ibegend | 6111 | (when ibegend |
| 6113 | (goto-char point)))) | 6112 | (goto-char point))) |
| 6113 | ;; Redraw attachment buttons in the header. | ||
| 6114 | (when gnus-mime-display-attachment-buttons-in-header | ||
| 6115 | (gnus-mime-buttonize-attachments-in-header))) | ||
| 6114 | 6116 | ||
| 6115 | (defconst gnus-article-wash-status-strings | 6117 | (defconst gnus-article-wash-status-strings |
| 6116 | (let ((alist '((cite "c" "Possible hidden citation text" | 6118 | (let ((alist '((cite "c" "Possible hidden citation text" |
| @@ -6216,6 +6218,104 @@ Provided for backwards compatibility." | |||
| 6216 | (when image | 6218 | (when image |
| 6217 | (gnus-add-image 'shr image)))) | 6219 | (gnus-add-image 'shr image)))) |
| 6218 | 6220 | ||
| 6221 | (defun gnus-mime-buttonize-attachments-in-header (&optional interactive) | ||
| 6222 | "Show attachments as buttons in the end of the header of an article. | ||
| 6223 | This function toggles the display when called interactively. Note that | ||
| 6224 | buttons to be added to the header are only the ones that aren't inlined | ||
| 6225 | in the body. Use `gnus-header-face-alist' to highlight buttons." | ||
| 6226 | (interactive (list t)) | ||
| 6227 | (gnus-with-article-buffer | ||
| 6228 | (gmm-labels | ||
| 6229 | ;; Function that returns a flattened version of | ||
| 6230 | ;; `gnus-article-mime-handle-alist'. | ||
| 6231 | ((flattened-alist | ||
| 6232 | (&optional alist id all) | ||
| 6233 | (if alist | ||
| 6234 | (let ((i 1) newid flat) | ||
| 6235 | (dolist (handle alist flat) | ||
| 6236 | (setq newid (append id (list i)) | ||
| 6237 | i (1+ i)) | ||
| 6238 | (if (stringp (car handle)) | ||
| 6239 | (setq flat (nconc flat (flattened-alist (cdr handle) | ||
| 6240 | newid all))) | ||
| 6241 | (delq (rassq handle all) all) | ||
| 6242 | (setq flat (nconc flat (list (cons newid handle))))))) | ||
| 6243 | (let ((flat (list nil))) | ||
| 6244 | ;; Assume that elements of `gnus-article-mime-handle-alist' | ||
| 6245 | ;; are in the decreasing order, but unnumbered subsidiaries | ||
| 6246 | ;; in each element are in the increasing order. | ||
| 6247 | (dolist (handle (reverse gnus-article-mime-handle-alist)) | ||
| 6248 | (if (stringp (cadr handle)) | ||
| 6249 | (setq flat (nconc flat (flattened-alist (cddr handle) | ||
| 6250 | (list (car handle)) | ||
| 6251 | flat))) | ||
| 6252 | (delq (rassq (cdr handle) flat) flat) | ||
| 6253 | (setq flat (nconc flat (list (cons (list (car handle)) | ||
| 6254 | (cdr handle))))))) | ||
| 6255 | (setq flat (cdr flat)) | ||
| 6256 | (mapc (lambda (handle) | ||
| 6257 | (if (cdar handle) | ||
| 6258 | ;; This is a hidden (i.e. unnumbered) handle. | ||
| 6259 | (progn | ||
| 6260 | (setcar handle | ||
| 6261 | (1+ (caar gnus-article-mime-handle-alist))) | ||
| 6262 | (push handle gnus-article-mime-handle-alist)) | ||
| 6263 | (setcar handle (caar handle)))) | ||
| 6264 | flat) | ||
| 6265 | flat)))) | ||
| 6266 | (let ((case-fold-search t) buttons st) | ||
| 6267 | (save-excursion | ||
| 6268 | (save-restriction | ||
| 6269 | (widen) | ||
| 6270 | (article-narrow-to-head) | ||
| 6271 | ;; Header buttons exist? | ||
| 6272 | (while (and (not buttons) | ||
| 6273 | (re-search-forward "^attachments?:[\n ]+" nil t)) | ||
| 6274 | (when (get-char-property (match-end 0) | ||
| 6275 | 'gnus-button-attachment-extra) | ||
| 6276 | (setq buttons (match-beginning 0)))) | ||
| 6277 | (widen) | ||
| 6278 | (when buttons | ||
| 6279 | ;; Delete header buttons. | ||
| 6280 | (delete-region buttons (if (re-search-forward "^[^ ]" nil t) | ||
| 6281 | (match-beginning 0) | ||
| 6282 | (point-max)))) | ||
| 6283 | (unless (and interactive buttons) | ||
| 6284 | ;; Find buttons. | ||
| 6285 | (setq buttons nil) | ||
| 6286 | (dolist (handle (flattened-alist)) | ||
| 6287 | (when (and (not (stringp (cadr handle))) | ||
| 6288 | (or (equal (car (mm-handle-disposition | ||
| 6289 | (cdr handle))) | ||
| 6290 | "attachment") | ||
| 6291 | (not (and (mm-inlinable-p (cdr handle)) | ||
| 6292 | (mm-inlined-p (cdr handle)))))) | ||
| 6293 | (push handle buttons))) | ||
| 6294 | (when buttons | ||
| 6295 | ;; Add header buttons. | ||
| 6296 | (article-goto-body) | ||
| 6297 | (forward-line -1) | ||
| 6298 | (narrow-to-region (point) (point)) | ||
| 6299 | (insert "Attachment" (if (cdr buttons) "s" "") ":") | ||
| 6300 | (dolist (button (nreverse buttons)) | ||
| 6301 | (setq st (point)) | ||
| 6302 | (insert " ") | ||
| 6303 | (gnus-insert-mime-button (cdr button) (car button)) | ||
| 6304 | (skip-chars-backward "\t\n ") | ||
| 6305 | (delete-region (point) (point-max)) | ||
| 6306 | (when (> (current-column) (window-width)) | ||
| 6307 | (goto-char st) | ||
| 6308 | (insert "\n") | ||
| 6309 | (end-of-line))) | ||
| 6310 | (insert "\n") | ||
| 6311 | (dolist (ovl (gnus-overlays-in (point-min) (point))) | ||
| 6312 | (gnus-overlay-put ovl 'gnus-button-attachment-extra t) | ||
| 6313 | (gnus-overlay-put ovl 'face nil)) | ||
| 6314 | (let ((gnus-treatment-function-alist | ||
| 6315 | '((gnus-treat-highlight-headers | ||
| 6316 | gnus-article-highlight-headers)))) | ||
| 6317 | (gnus-treat-article 'head)))))))))) | ||
| 6318 | |||
| 6219 | ;;; Article savers. | 6319 | ;;; Article savers. |
| 6220 | 6320 | ||
| 6221 | (defun gnus-output-to-file (file-name) | 6321 | (defun gnus-output-to-file (file-name) |
diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el index d58acbd18ca..544d6672a8c 100644 --- a/lisp/gnus/gnus-cache.el +++ b/lisp/gnus/gnus-cache.el | |||
| @@ -24,10 +24,6 @@ | |||
| 24 | 24 | ||
| 25 | ;;; Code: | 25 | ;;; Code: |
| 26 | 26 | ||
| 27 | ;; For Emacs <22.2 and XEmacs. | ||
| 28 | (eval-and-compile | ||
| 29 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) | ||
| 30 | |||
| 31 | (eval-when-compile (require 'cl)) | 27 | (eval-when-compile (require 'cl)) |
| 32 | 28 | ||
| 33 | (require 'gnus) | 29 | (require 'gnus) |
diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el index 50076821a8d..d6b4fba6246 100644 --- a/lisp/gnus/gnus-fun.el +++ b/lisp/gnus/gnus-fun.el | |||
| @@ -24,10 +24,6 @@ | |||
| 24 | 24 | ||
| 25 | ;;; Code: | 25 | ;;; Code: |
| 26 | 26 | ||
| 27 | ;; For Emacs <22.2 and XEmacs. | ||
| 28 | (eval-and-compile | ||
| 29 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) | ||
| 30 | |||
| 31 | (eval-when-compile | 27 | (eval-when-compile |
| 32 | (require 'cl)) | 28 | (require 'cl)) |
| 33 | 29 | ||
| @@ -44,6 +40,24 @@ | |||
| 44 | :group 'gnus-fun | 40 | :group 'gnus-fun |
| 45 | :type 'directory) | 41 | :type 'directory) |
| 46 | 42 | ||
| 43 | (defcustom gnus-x-face-omit-files nil | ||
| 44 | "Regexp to match faces in `gnus-x-face-directory' to be omitted." | ||
| 45 | :version "24.5" | ||
| 46 | :group 'gnus-fun | ||
| 47 | :type 'string) | ||
| 48 | |||
| 49 | (defcustom gnus-face-directory (expand-file-name "faces" gnus-directory) | ||
| 50 | "*Directory where Face PNG files are stored." | ||
| 51 | :version "24.5" | ||
| 52 | :group 'gnus-fun | ||
| 53 | :type 'directory) | ||
| 54 | |||
| 55 | (defcustom gnus-face-omit-files nil | ||
| 56 | "Regexp to match faces in `gnus-face-directory' to be omitted." | ||
| 57 | :version "24.5" | ||
| 58 | :group 'gnus-fun | ||
| 59 | :type 'string) | ||
| 60 | |||
| 47 | (defcustom gnus-convert-pbm-to-x-face-command "pbmtoxbm %s | compface" | 61 | (defcustom gnus-convert-pbm-to-x-face-command "pbmtoxbm %s | compface" |
| 48 | "Command for converting a PBM to an X-Face." | 62 | "Command for converting a PBM to an X-Face." |
| 49 | :version "22.1" | 63 | :version "22.1" |
| @@ -86,35 +100,57 @@ PNG format." | |||
| 86 | nil shell-command-switch command))) | 100 | nil shell-command-switch command))) |
| 87 | 101 | ||
| 88 | ;;;###autoload | 102 | ;;;###autoload |
| 89 | (defun gnus-random-x-face () | 103 | (defun gnus--random-face-with-type (dir ext omit fun) |
| 90 | "Return X-Face header data chosen randomly from `gnus-x-face-directory'." | 104 | "Return file from DIR with extension EXT, omitting matches of OMIT, processed by FUN." |
| 91 | (interactive) | 105 | (when (file-exists-p dir) |
| 92 | (when (file-exists-p gnus-x-face-directory) | 106 | (let* ((files |
| 93 | (let* ((files (directory-files gnus-x-face-directory t "\\.pbm$")) | 107 | (remove nil (mapcar |
| 94 | (file (nth (random (length files)) files))) | 108 | (lambda (f) (unless (string-match (or omit "^$") f) f)) |
| 109 | (directory-files dir t ext)))) | ||
| 110 | (file (nth (random (length files)) files))) | ||
| 95 | (when file | 111 | (when file |
| 96 | (gnus-shell-command-to-string | 112 | (funcall fun file))))) |
| 97 | (format gnus-convert-pbm-to-x-face-command | ||
| 98 | (shell-quote-argument file))))))) | ||
| 99 | 113 | ||
| 114 | ;;;###autoload | ||
| 100 | (autoload 'message-goto-eoh "message" nil t) | 115 | (autoload 'message-goto-eoh "message" nil t) |
| 116 | (autoload 'message-insert-header "message" nil t) | ||
| 117 | |||
| 118 | (defun gnus--insert-random-face-with-type (fun type) | ||
| 119 | "Get a random face using FUN and insert it as a header TYPE. | ||
| 120 | |||
| 121 | For instance, to insert an X-Face use `gnus-random-x-face' as FUN | ||
| 122 | and \"X-Face\" as TYPE." | ||
| 123 | (let ((data (funcall fun))) | ||
| 124 | (save-excursion | ||
| 125 | (if data | ||
| 126 | (progn (message-goto-eoh) | ||
| 127 | (insert type ": " data "\n")) | ||
| 128 | (message | ||
| 129 | "No face returned by the function %s." (symbol-name fun)))))) | ||
| 130 | |||
| 131 | |||
| 132 | |||
| 133 | ;;;###autoload | ||
| 134 | (defun gnus-random-x-face () | ||
| 135 | "Return X-Face header data chosen randomly from `gnus-x-face-directory'. | ||
| 136 | |||
| 137 | Files matching `gnus-x-face-omit-files' are not considered." | ||
| 138 | (interactive) | ||
| 139 | (gnus--random-face-with-type gnus-x-face-directory "\\.pbm$" gnus-x-face-omit-files | ||
| 140 | (lambda (file) | ||
| 141 | (gnus-shell-command-to-string | ||
| 142 | (format gnus-convert-pbm-to-x-face-command | ||
| 143 | (shell-quote-argument file)))))) | ||
| 101 | 144 | ||
| 102 | ;;;###autoload | 145 | ;;;###autoload |
| 103 | (defun gnus-insert-random-x-face-header () | 146 | (defun gnus-insert-random-x-face-header () |
| 104 | "Insert a random X-Face header from `gnus-x-face-directory'." | 147 | "Insert a random X-Face header from `gnus-x-face-directory'." |
| 105 | (interactive) | 148 | (interactive) |
| 106 | (let ((data (gnus-random-x-face))) | 149 | (gnus--insert-random-face-with-type 'gnus-random-x-face 'X-Face)) |
| 107 | (save-excursion | ||
| 108 | (message-goto-eoh) | ||
| 109 | (if data | ||
| 110 | (insert "X-Face: " data) | ||
| 111 | (message | ||
| 112 | "No face returned by `gnus-random-x-face'. Does %s/*.pbm exist?" | ||
| 113 | gnus-x-face-directory))))) | ||
| 114 | 150 | ||
| 115 | ;;;###autoload | 151 | ;;;###autoload |
| 116 | (defun gnus-x-face-from-file (file) | 152 | (defun gnus-x-face-from-file (file) |
| 117 | "Insert an X-Face header based on an image file. | 153 | "Insert an X-Face header based on an image FILE. |
| 118 | 154 | ||
| 119 | Depending on `gnus-convert-image-to-x-face-command' it may accept | 155 | Depending on `gnus-convert-image-to-x-face-command' it may accept |
| 120 | different input formats." | 156 | different input formats." |
| @@ -126,7 +162,7 @@ different input formats." | |||
| 126 | 162 | ||
| 127 | ;;;###autoload | 163 | ;;;###autoload |
| 128 | (defun gnus-face-from-file (file) | 164 | (defun gnus-face-from-file (file) |
| 129 | "Return a Face header based on an image file. | 165 | "Return a Face header based on an image FILE. |
| 130 | 166 | ||
| 131 | Depending on `gnus-convert-image-to-face-command' it may accept | 167 | Depending on `gnus-convert-image-to-face-command' it may accept |
| 132 | different input formats." | 168 | different input formats." |
| @@ -191,6 +227,21 @@ FILE should be a PNG file that's 48x48 and smaller than or equal to | |||
| 191 | (buffer-size))) | 227 | (buffer-size))) |
| 192 | (gnus-face-encode))) | 228 | (gnus-face-encode))) |
| 193 | 229 | ||
| 230 | ;;;###autoload | ||
| 231 | (defun gnus-random-face () | ||
| 232 | "Return randomly chosen Face from `gnus-face-directory'. | ||
| 233 | |||
| 234 | Files matching `gnus-face-omit-files' are not considered." | ||
| 235 | (interactive) | ||
| 236 | (gnus--random-face-with-type gnus-face-directory "\\.png$" | ||
| 237 | gnus-face-omit-files | ||
| 238 | 'gnus-convert-png-to-face)) | ||
| 239 | |||
| 240 | ;;;###autoload | ||
| 241 | (defun gnus-insert-random-face-header () | ||
| 242 | "Insert a randome Face header from `gnus-face-directory'." | ||
| 243 | (gnus--insert-random-face-with-type 'gnus-random-face 'Face)) | ||
| 244 | |||
| 194 | (defface gnus-x-face '((t (:foreground "black" :background "white"))) | 245 | (defface gnus-x-face '((t (:foreground "black" :background "white"))) |
| 195 | "Face to show X-Face. | 246 | "Face to show X-Face. |
| 196 | The colors from this face are used as the foreground and background | 247 | The colors from this face are used as the foreground and background |
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index d8260b40434..31078be48aa 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el | |||
| @@ -24,10 +24,6 @@ | |||
| 24 | 24 | ||
| 25 | ;;; Code: | 25 | ;;; Code: |
| 26 | 26 | ||
| 27 | ;; For Emacs <22.2 and XEmacs. | ||
| 28 | (eval-and-compile | ||
| 29 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) | ||
| 30 | |||
| 31 | (eval-when-compile | 27 | (eval-when-compile |
| 32 | (require 'cl)) | 28 | (require 'cl)) |
| 33 | (defvar tool-bar-mode) | 29 | (defvar tool-bar-mode) |
diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el index 90947fe4d8c..540694f34fb 100644 --- a/lisp/gnus/gnus-html.el +++ b/lisp/gnus/gnus-html.el | |||
| @@ -28,10 +28,6 @@ | |||
| 28 | 28 | ||
| 29 | ;;; Code: | 29 | ;;; Code: |
| 30 | 30 | ||
| 31 | ;; For Emacs <22.2 and XEmacs. | ||
| 32 | (eval-and-compile | ||
| 33 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) | ||
| 34 | |||
| 35 | (eval-when-compile (require 'cl)) | 31 | (eval-when-compile (require 'cl)) |
| 36 | 32 | ||
| 37 | (require 'gnus-art) | 33 | (require 'gnus-art) |
diff --git a/lisp/gnus/gnus-mlspl.el b/lisp/gnus/gnus-mlspl.el index 8dec6f24217..2d86d0b81ad 100644 --- a/lisp/gnus/gnus-mlspl.el +++ b/lisp/gnus/gnus-mlspl.el | |||
| @@ -146,20 +146,27 @@ Calling (gnus-group-split-fancy nil nil \"mail.others\") returns: | |||
| 146 | (any \"\\\\(foo@nowhere\\\\.gov\\\\|foo@localhost\\\\|foo-redist@home\\\\)\" | 146 | (any \"\\\\(foo@nowhere\\\\.gov\\\\|foo@localhost\\\\|foo-redist@home\\\\)\" |
| 147 | - \"bugs-foo\" - \"rambling-foo\" \"mail.foo\")) | 147 | - \"bugs-foo\" - \"rambling-foo\" \"mail.foo\")) |
| 148 | \"mail.others\")" | 148 | \"mail.others\")" |
| 149 | (let* ((newsrc (cdr gnus-newsrc-alist)) | 149 | (let ((group-names (if (and (listp groups) |
| 150 | split) | 150 | (not (null groups))) |
| 151 | (dolist (info newsrc) | 151 | groups |
| 152 | (let ((group (gnus-info-group info)) | 152 | (delete-dups |
| 153 | (params (gnus-info-params info))) | 153 | (delq nil |
| 154 | ;; For all GROUPs that match the specified GROUPS | 154 | (mapcar |
| 155 | (when (or (not groups) | 155 | (lambda (info) |
| 156 | (and (listp groups) | 156 | (let ((group (gnus-info-group info))) |
| 157 | (memq group groups)) | 157 | (if (or (not groups) |
| 158 | (and (stringp groups) | 158 | (and (stringp groups) |
| 159 | (string-match groups group))) | 159 | (string-match groups group))) |
| 160 | (let ((split-spec (assoc 'split-spec params)) group-clean) | 160 | group))) |
| 161 | ;; Remove backend from group name | 161 | (append gnus-newsrc-alist gnus-parameters)))))) |
| 162 | (setq group-clean (string-match ":" group)) | 162 | split) |
| 163 | (dolist (group group-names) | ||
| 164 | (let ((params (gnus-group-find-parameter group))) | ||
| 165 | ;; Skip groups without param (or nonexistent) | ||
| 166 | (when (not (null params)) | ||
| 167 | (let ((split-spec (assoc 'split-spec params)) group-clean) | ||
| 168 | ;; Remove backend from group name | ||
| 169 | (setq group-clean (string-match ":" group)) | ||
| 163 | (setq group-clean | 170 | (setq group-clean |
| 164 | (if group-clean | 171 | (if group-clean |
| 165 | (substring group (1+ group-clean)) | 172 | (substring group (1+ group-clean)) |
diff --git a/lisp/gnus/gnus-notifications.el b/lisp/gnus/gnus-notifications.el index 0621c23c20c..ee1083d8005 100644 --- a/lisp/gnus/gnus-notifications.el +++ b/lisp/gnus/gnus-notifications.el | |||
| @@ -102,6 +102,9 @@ Return a notification id if any, or t on success." | |||
| 102 | ;; Don't return an id | 102 | ;; Don't return an id |
| 103 | t)) | 103 | t)) |
| 104 | 104 | ||
| 105 | (declare-function gravatar-retrieve-synchronously "gravatar.el" | ||
| 106 | (mail-address)) | ||
| 107 | |||
| 105 | (defun gnus-notifications-get-photo (mail-address) | 108 | (defun gnus-notifications-get-photo (mail-address) |
| 106 | "Get photo for mail address." | 109 | "Get photo for mail address." |
| 107 | (let ((google-photo (when (and gnus-notifications-use-google-contacts | 110 | (let ((google-photo (when (and gnus-notifications-use-google-contacts |
diff --git a/lisp/gnus/gnus-picon.el b/lisp/gnus/gnus-picon.el index 83629df1713..05301673a50 100644 --- a/lisp/gnus/gnus-picon.el +++ b/lisp/gnus/gnus-picon.el | |||
| @@ -37,10 +37,6 @@ | |||
| 37 | ;; | 37 | ;; |
| 38 | ;;; Code: | 38 | ;;; Code: |
| 39 | 39 | ||
| 40 | ;; For Emacs <22.2 and XEmacs. | ||
| 41 | (eval-and-compile | ||
| 42 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) | ||
| 43 | |||
| 44 | (eval-when-compile (require 'cl)) | 40 | (eval-when-compile (require 'cl)) |
| 45 | 41 | ||
| 46 | (require 'gnus) | 42 | (require 'gnus) |
diff --git a/lisp/gnus/gnus-setup.el b/lisp/gnus/gnus-setup.el deleted file mode 100644 index 7ef8dc52530..00000000000 --- a/lisp/gnus/gnus-setup.el +++ /dev/null | |||
| @@ -1,191 +0,0 @@ | |||
| 1 | ;;; gnus-setup.el --- Initialization & Setup for Gnus 5 | ||
| 2 | |||
| 3 | ;; Copyright (C) 1995-1996, 2000-2014 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Steven L. Baur <steve@miranova.com> | ||
| 6 | ;; Keywords: news | ||
| 7 | |||
| 8 | ;; This file is part of GNU Emacs. | ||
| 9 | |||
| 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 11 | ;; it under the terms of the GNU General Public License as published by | ||
| 12 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 13 | ;; (at your option) any later version. | ||
| 14 | |||
| 15 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 18 | ;; GNU General Public License for more details. | ||
| 19 | |||
| 20 | ;; You should have received a copy of the GNU General Public License | ||
| 21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | ||
| 22 | |||
| 23 | ;;; Commentary: | ||
| 24 | ;; My head is starting to spin with all the different mail/news packages. | ||
| 25 | ;; Stop The Madness! | ||
| 26 | |||
| 27 | ;; Given that Emacs Lisp byte codes may be diverging, it is probably best | ||
| 28 | ;; not to byte compile this, and just arrange to have the .el loaded out | ||
| 29 | ;; of .emacs. | ||
| 30 | |||
| 31 | ;;; Code: | ||
| 32 | |||
| 33 | (eval-when-compile (require 'cl)) | ||
| 34 | |||
| 35 | (defvar gnus-use-installed-gnus t | ||
| 36 | "*If non-nil use installed version of Gnus.") | ||
| 37 | |||
| 38 | (defvar gnus-use-installed-mailcrypt (featurep 'xemacs) | ||
| 39 | "*If non-nil use installed version of mailcrypt.") | ||
| 40 | |||
| 41 | (defvar gnus-emacs-lisp-directory (if (featurep 'xemacs) | ||
| 42 | "/usr/local/lib/xemacs/" | ||
| 43 | "/usr/local/share/emacs/") | ||
| 44 | "Directory where Emacs site lisp is located.") | ||
| 45 | |||
| 46 | (defvar gnus-gnus-lisp-directory (concat gnus-emacs-lisp-directory | ||
| 47 | "gnus/lisp/") | ||
| 48 | "Directory where Gnus Emacs lisp is found.") | ||
| 49 | |||
| 50 | (defvar gnus-mailcrypt-lisp-directory (concat gnus-emacs-lisp-directory | ||
| 51 | "site-lisp/mailcrypt/") | ||
| 52 | "Directory where Mailcrypt Emacs Lisp is found.") | ||
| 53 | |||
| 54 | (defvar gnus-bbdb-lisp-directory (concat gnus-emacs-lisp-directory | ||
| 55 | "site-lisp/bbdb/") | ||
| 56 | "Directory where Big Brother Database is found.") | ||
| 57 | |||
| 58 | (defvar gnus-use-mhe nil | ||
| 59 | "Set this if you want to use MH-E for mail reading.") | ||
| 60 | (defvar gnus-use-rmail nil | ||
| 61 | "Set this if you want to use RMAIL for mail reading.") | ||
| 62 | (defvar gnus-use-sendmail nil | ||
| 63 | "Set this if you want to use SENDMAIL for mail reading.") | ||
| 64 | (defvar gnus-use-vm nil | ||
| 65 | "Set this if you want to use the VM package for mail reading.") | ||
| 66 | (defvar gnus-use-sc nil | ||
| 67 | "Set this if you want to use Supercite.") | ||
| 68 | (defvar gnus-use-mailcrypt t | ||
| 69 | "Set this if you want to use Mailcrypt for dealing with PGP messages.") | ||
| 70 | (defvar gnus-use-bbdb nil | ||
| 71 | "Set this if you want to use the Big Brother DataBase.") | ||
| 72 | |||
| 73 | (when (and (not gnus-use-installed-gnus) | ||
| 74 | (null (member gnus-gnus-lisp-directory load-path))) | ||
| 75 | (push gnus-gnus-lisp-directory load-path)) | ||
| 76 | |||
| 77 | ;;; We can't do this until we know where Gnus is. | ||
| 78 | (require 'message) | ||
| 79 | |||
| 80 | ;;; Mailcrypt by | ||
| 81 | ;;; Jin Choi <jin@atype.com> | ||
| 82 | ;;; Patrick LoPresti <patl@lcs.mit.edu> | ||
| 83 | |||
| 84 | (when gnus-use-mailcrypt | ||
| 85 | (when (and (not gnus-use-installed-mailcrypt) | ||
| 86 | (null (member gnus-mailcrypt-lisp-directory load-path))) | ||
| 87 | (setq load-path (cons gnus-mailcrypt-lisp-directory load-path))) | ||
| 88 | (autoload 'mc-install-write-mode "mailcrypt" nil t) | ||
| 89 | (autoload 'mc-install-read-mode "mailcrypt" nil t) | ||
| 90 | ;;; (add-hook 'message-mode-hook 'mc-install-write-mode) | ||
| 91 | ;;; (add-hook 'gnus-summary-mode-hook 'mc-install-read-mode) | ||
| 92 | (when gnus-use-mhe | ||
| 93 | (add-hook 'mh-folder-mode-hook 'mc-install-read-mode) | ||
| 94 | (add-hook 'mh-letter-mode-hook 'mc-install-write-mode))) | ||
| 95 | |||
| 96 | ;;; BBDB by | ||
| 97 | ;;; Jamie Zawinski <jwz@lucid.com> | ||
| 98 | |||
| 99 | (when gnus-use-bbdb | ||
| 100 | ;; bbdb will never be installed with emacs. | ||
| 101 | (when (null (member gnus-bbdb-lisp-directory load-path)) | ||
| 102 | (setq load-path (cons gnus-bbdb-lisp-directory load-path))) | ||
| 103 | (autoload 'bbdb "bbdb-com" | ||
| 104 | "Insidious Big Brother Database" t) | ||
| 105 | (autoload 'bbdb-name "bbdb-com" | ||
| 106 | "Insidious Big Brother Database" t) | ||
| 107 | (autoload 'bbdb-company "bbdb-com" | ||
| 108 | "Insidious Big Brother Database" t) | ||
| 109 | (autoload 'bbdb-net "bbdb-com" | ||
| 110 | "Insidious Big Brother Database" t) | ||
| 111 | (autoload 'bbdb-notes "bbdb-com" | ||
| 112 | "Insidious Big Brother Database" t) | ||
| 113 | |||
| 114 | (when gnus-use-vm | ||
| 115 | (autoload 'bbdb-insinuate-vm "bbdb-vm" | ||
| 116 | "Hook BBDB into VM" t)) | ||
| 117 | |||
| 118 | (when gnus-use-rmail | ||
| 119 | (autoload 'bbdb-insinuate-rmail "bbdb-rmail" | ||
| 120 | "Hook BBDB into RMAIL" t) | ||
| 121 | (add-hook 'rmail-mode-hook 'bbdb-insinuate-rmail)) | ||
| 122 | |||
| 123 | (when gnus-use-mhe | ||
| 124 | (autoload 'bbdb-insinuate-mh "bbdb-mh" | ||
| 125 | "Hook BBDB into MH-E" t) | ||
| 126 | (add-hook 'mh-folder-mode-hook 'bbdb-insinuate-mh)) | ||
| 127 | |||
| 128 | (autoload 'bbdb-insinuate-gnus "bbdb-gnus" | ||
| 129 | "Hook BBDB into Gnus" t) | ||
| 130 | (add-hook 'gnus-startup-hook 'bbdb-insinuate-gnus) | ||
| 131 | |||
| 132 | (when gnus-use-sendmail | ||
| 133 | (autoload 'bbdb-insinuate-sendmail "bbdb" | ||
| 134 | "Insidious Big Brother Database" t) | ||
| 135 | (add-hook 'mail-setup-hook 'bbdb-insinuate-sendmail) | ||
| 136 | (add-hook 'message-setup-hook 'bbdb-insinuate-sendmail))) | ||
| 137 | |||
| 138 | (when gnus-use-sc | ||
| 139 | (add-hook 'mail-citation-hook 'sc-cite-original) | ||
| 140 | (setq message-cite-function 'sc-cite-original)) | ||
| 141 | |||
| 142 | ;;;### (autoloads (gnus gnus-slave gnus-no-server) "gnus" "lisp/gnus.el" (12473 2137)) | ||
| 143 | ;;; Generated autoloads from lisp/gnus.el | ||
| 144 | |||
| 145 | ;; Don't redo this if autoloads already exist | ||
| 146 | (unless (fboundp 'gnus) | ||
| 147 | (autoload 'gnus-slave-no-server "gnus" "\ | ||
| 148 | Read network news as a slave without connecting to local server." t nil) | ||
| 149 | |||
| 150 | (autoload 'gnus-no-server "gnus" "\ | ||
| 151 | Read network news. | ||
| 152 | If ARG is a positive number, Gnus will use that as the | ||
| 153 | startup level. If ARG is nil, Gnus will be started at level 2. | ||
| 154 | If ARG is non-nil and not a positive number, Gnus will | ||
| 155 | prompt the user for the name of an NNTP server to use. | ||
| 156 | As opposed to `gnus', this command will not connect to the local server." t nil) | ||
| 157 | |||
| 158 | (autoload 'gnus-slave "gnus" "\ | ||
| 159 | Read news as a slave." t nil) | ||
| 160 | |||
| 161 | (autoload 'gnus "gnus" "\ | ||
| 162 | Read network news. | ||
| 163 | If ARG is non-nil and a positive number, Gnus will use that as the | ||
| 164 | startup level. If ARG is non-nil and not a positive number, Gnus will | ||
| 165 | prompt the user for the name of an NNTP server to use." t nil) | ||
| 166 | |||
| 167 | ;;;*** | ||
| 168 | |||
| 169 | ;;; These have moved out of gnus.el into other files. | ||
| 170 | ;;; FIX FIX FIX: should other things be in gnus-setup? or these not in it? | ||
| 171 | (autoload 'gnus-update-format "gnus-spec" "\ | ||
| 172 | Update the format specification near point." t nil) | ||
| 173 | |||
| 174 | (autoload 'gnus-fetch-group "gnus-group" "\ | ||
| 175 | Start Gnus if necessary and enter GROUP. | ||
| 176 | Returns whether the fetching was successful or not." t nil) | ||
| 177 | |||
| 178 | (defalias 'gnus-batch-kill 'gnus-batch-score) | ||
| 179 | |||
| 180 | (autoload 'gnus-batch-score "gnus-kill" "\ | ||
| 181 | Run batched scoring. | ||
| 182 | Usage: emacs -batch -l gnus -f gnus-batch-score <newsgroups> ... | ||
| 183 | Newsgroups is a list of strings in Bnews format. If you want to score | ||
| 184 | the comp hierarchy, you'd say \"comp.all\". If you would not like to | ||
| 185 | score the alt hierarchy, you'd say \"!alt.all\"." t nil)) | ||
| 186 | |||
| 187 | (provide 'gnus-setup) | ||
| 188 | |||
| 189 | (run-hooks 'gnus-setup-load-hook) | ||
| 190 | |||
| 191 | ;;; gnus-setup.el ends here | ||
diff --git a/lisp/gnus/gnus-spec.el b/lisp/gnus/gnus-spec.el index 54714d503bc..e11ddc4c4f5 100644 --- a/lisp/gnus/gnus-spec.el +++ b/lisp/gnus/gnus-spec.el | |||
| @@ -24,9 +24,6 @@ | |||
| 24 | 24 | ||
| 25 | ;;; Code: | 25 | ;;; Code: |
| 26 | 26 | ||
| 27 | ;; For Emacs <22.2 and XEmacs. | ||
| 28 | (eval-and-compile | ||
| 29 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) | ||
| 30 | (eval-when-compile (require 'cl)) | 27 | (eval-when-compile (require 'cl)) |
| 31 | (defvar gnus-newsrc-file-version) | 28 | (defvar gnus-newsrc-file-version) |
| 32 | 29 | ||
diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el index 319f7a8cbce..a2176d0c72a 100644 --- a/lisp/gnus/gnus-srvr.el +++ b/lisp/gnus/gnus-srvr.el | |||
| @@ -45,7 +45,7 @@ | |||
| 45 | :group 'gnus-server | 45 | :group 'gnus-server |
| 46 | :type 'hook) | 46 | :type 'hook) |
| 47 | 47 | ||
| 48 | (defcustom gnus-server-line-format " {%(%h:%w%)} %s%a\n" | 48 | (defcustom gnus-server-line-format " {%(%h:%w%)} %s%a%c\n" |
| 49 | "Format of server lines. | 49 | "Format of server lines. |
| 50 | It works along the same lines as a normal formatting string, | 50 | It works along the same lines as a normal formatting string, |
| 51 | with some simple extensions. | 51 | with some simple extensions. |
| @@ -85,7 +85,8 @@ If nil, a faster, but more primitive, buffer is used instead." | |||
| 85 | (?n gnus-tmp-name ?s) | 85 | (?n gnus-tmp-name ?s) |
| 86 | (?w gnus-tmp-where ?s) | 86 | (?w gnus-tmp-where ?s) |
| 87 | (?s gnus-tmp-status ?s) | 87 | (?s gnus-tmp-status ?s) |
| 88 | (?a gnus-tmp-agent ?s))) | 88 | (?a gnus-tmp-agent ?s) |
| 89 | (?c gnus-tmp-cloud ?s))) | ||
| 89 | 90 | ||
| 90 | (defvar gnus-server-mode-line-format-alist | 91 | (defvar gnus-server-mode-line-format-alist |
| 91 | `((?S gnus-tmp-news-server ?s) | 92 | `((?S gnus-tmp-news-server ?s) |
| @@ -127,6 +128,7 @@ If nil, a faster, but more primitive, buffer is used instead." | |||
| 127 | ["Close" gnus-server-close-server t] | 128 | ["Close" gnus-server-close-server t] |
| 128 | ["Offline" gnus-server-offline-server t] | 129 | ["Offline" gnus-server-offline-server t] |
| 129 | ["Deny" gnus-server-deny-server t] | 130 | ["Deny" gnus-server-deny-server t] |
| 131 | ["Toggle Cloud" gnus-server-toggle-cloud-server t] | ||
| 130 | "---" | 132 | "---" |
| 131 | ["Open All" gnus-server-open-all-servers t] | 133 | ["Open All" gnus-server-open-all-servers t] |
| 132 | ["Close All" gnus-server-close-all-servers t] | 134 | ["Close All" gnus-server-close-all-servers t] |
| @@ -172,6 +174,8 @@ If nil, a faster, but more primitive, buffer is used instead." | |||
| 172 | 174 | ||
| 173 | "z" gnus-server-compact-server | 175 | "z" gnus-server-compact-server |
| 174 | 176 | ||
| 177 | "i" gnus-server-toggle-cloud-server | ||
| 178 | |||
| 175 | "\C-c\C-i" gnus-info-find-node | 179 | "\C-c\C-i" gnus-info-find-node |
| 176 | "\C-c\C-b" gnus-bug)) | 180 | "\C-c\C-b" gnus-bug)) |
| 177 | 181 | ||
| @@ -185,6 +189,13 @@ If nil, a faster, but more primitive, buffer is used instead." | |||
| 185 | (put 'gnus-server-agent-face 'face-alias 'gnus-server-agent) | 189 | (put 'gnus-server-agent-face 'face-alias 'gnus-server-agent) |
| 186 | (put 'gnus-server-agent-face 'obsolete-face "22.1") | 190 | (put 'gnus-server-agent-face 'obsolete-face "22.1") |
| 187 | 191 | ||
| 192 | (defface gnus-server-cloud | ||
| 193 | '((((class color) (background light)) (:foreground "ForestGreen" :bold t)) | ||
| 194 | (((class color) (background dark)) (:foreground "PaleGreen" :bold t)) | ||
| 195 | (t (:bold t))) | ||
| 196 | "Face used for displaying AGENTIZED servers" | ||
| 197 | :group 'gnus-server-visual) | ||
| 198 | |||
| 188 | (defface gnus-server-opened | 199 | (defface gnus-server-opened |
| 189 | '((((class color) (background light)) (:foreground "Green3" :bold t)) | 200 | '((((class color) (background light)) (:foreground "Green3" :bold t)) |
| 190 | (((class color) (background dark)) (:foreground "Green1" :bold t)) | 201 | (((class color) (background dark)) (:foreground "Green1" :bold t)) |
| @@ -228,6 +239,7 @@ If nil, a faster, but more primitive, buffer is used instead." | |||
| 228 | 239 | ||
| 229 | (defvar gnus-server-font-lock-keywords | 240 | (defvar gnus-server-font-lock-keywords |
| 230 | '(("(\\(agent\\))" 1 'gnus-server-agent) | 241 | '(("(\\(agent\\))" 1 'gnus-server-agent) |
| 242 | ("(\\(cloud\\))" 1 'gnus-server-cloud) | ||
| 231 | ("(\\(opened\\))" 1 'gnus-server-opened) | 243 | ("(\\(opened\\))" 1 'gnus-server-opened) |
| 232 | ("(\\(closed\\))" 1 'gnus-server-closed) | 244 | ("(\\(closed\\))" 1 'gnus-server-closed) |
| 233 | ("(\\(offline\\))" 1 'gnus-server-offline) | 245 | ("(\\(offline\\))" 1 'gnus-server-offline) |
| @@ -282,6 +294,9 @@ The following commands are available: | |||
| 282 | (gnus-tmp-agent (if (and gnus-agent | 294 | (gnus-tmp-agent (if (and gnus-agent |
| 283 | (gnus-agent-method-p method)) | 295 | (gnus-agent-method-p method)) |
| 284 | " (agent)" | 296 | " (agent)" |
| 297 | "")) | ||
| 298 | (gnus-tmp-cloud (if (gnus-cloud-server-p gnus-tmp-name) | ||
| 299 | " (cloud)" | ||
| 285 | ""))) | 300 | ""))) |
| 286 | (beginning-of-line) | 301 | (beginning-of-line) |
| 287 | (gnus-add-text-properties | 302 | (gnus-add-text-properties |
| @@ -1084,6 +1099,27 @@ Requesting compaction of %s... (this may take a long time)" | |||
| 1084 | (let ((original (get-buffer gnus-original-article-buffer))) | 1099 | (let ((original (get-buffer gnus-original-article-buffer))) |
| 1085 | (and original (gnus-kill-buffer original)))))) | 1100 | (and original (gnus-kill-buffer original)))))) |
| 1086 | 1101 | ||
| 1102 | (defun gnus-server-toggle-cloud-server () | ||
| 1103 | "Make the server under point be replicated in the Emacs Cloud." | ||
| 1104 | (interactive) | ||
| 1105 | (let ((server (gnus-server-server-name))) | ||
| 1106 | (unless server | ||
| 1107 | (error "No server on the current line")) | ||
| 1108 | |||
| 1109 | (unless (gnus-method-option-p server 'cloud) | ||
| 1110 | (error "The server under point doesn't support cloudiness")) | ||
| 1111 | |||
| 1112 | (if (gnus-cloud-server-p server) | ||
| 1113 | (setq gnus-cloud-covered-servers | ||
| 1114 | (delete server gnus-cloud-covered-servers)) | ||
| 1115 | (push server gnus-cloud-covered-servers)) | ||
| 1116 | |||
| 1117 | (gnus-server-update-server server) | ||
| 1118 | (gnus-message 1 (if (gnus-cloud-server-p server) | ||
| 1119 | "Replication of %s in the cloud will start" | ||
| 1120 | "Replication of %s in the cloud will stop") | ||
| 1121 | server))) | ||
| 1122 | |||
| 1087 | (provide 'gnus-srvr) | 1123 | (provide 'gnus-srvr) |
| 1088 | 1124 | ||
| 1089 | ;;; gnus-srvr.el ends here | 1125 | ;;; gnus-srvr.el ends here |
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index b9b259e0d18..b79b96e4fc1 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el | |||
| @@ -30,6 +30,7 @@ | |||
| 30 | (require 'gnus-spec) | 30 | (require 'gnus-spec) |
| 31 | (require 'gnus-range) | 31 | (require 'gnus-range) |
| 32 | (require 'gnus-util) | 32 | (require 'gnus-util) |
| 33 | (require 'gnus-cloud) | ||
| 33 | (autoload 'message-make-date "message") | 34 | (autoload 'message-make-date "message") |
| 34 | (autoload 'gnus-agent-read-servers-validate "gnus-agent") | 35 | (autoload 'gnus-agent-read-servers-validate "gnus-agent") |
| 35 | (autoload 'gnus-agent-save-local "gnus-agent") | 36 | (autoload 'gnus-agent-save-local "gnus-agent") |
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index d6c801fdd39..dca2a2c1499 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el | |||
| @@ -24,9 +24,6 @@ | |||
| 24 | 24 | ||
| 25 | ;;; Code: | 25 | ;;; Code: |
| 26 | 26 | ||
| 27 | ;; For Emacs <22.2 and XEmacs. | ||
| 28 | (eval-and-compile | ||
| 29 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) | ||
| 30 | (eval-when-compile | 27 | (eval-when-compile |
| 31 | (require 'cl)) | 28 | (require 'cl)) |
| 32 | (eval-when-compile | 29 | (eval-when-compile |
| @@ -2188,6 +2185,7 @@ increase the score of each group you read." | |||
| 2188 | (gnus-define-keys (gnus-summary-wash-mime-map "M" gnus-summary-wash-map) | 2185 | (gnus-define-keys (gnus-summary-wash-mime-map "M" gnus-summary-wash-map) |
| 2189 | "w" gnus-article-decode-mime-words | 2186 | "w" gnus-article-decode-mime-words |
| 2190 | "c" gnus-article-decode-charset | 2187 | "c" gnus-article-decode-charset |
| 2188 | "h" gnus-mime-buttonize-attachments-in-header | ||
| 2191 | "v" gnus-mime-view-all-parts | 2189 | "v" gnus-mime-view-all-parts |
| 2192 | "b" gnus-article-view-part) | 2190 | "b" gnus-article-view-part) |
| 2193 | 2191 | ||
| @@ -2394,6 +2392,8 @@ increase the score of each group you read." | |||
| 2394 | ["QP" gnus-article-de-quoted-unreadable t] | 2392 | ["QP" gnus-article-de-quoted-unreadable t] |
| 2395 | ["Base64" gnus-article-de-base64-unreadable t] | 2393 | ["Base64" gnus-article-de-base64-unreadable t] |
| 2396 | ["View MIME buttons" gnus-summary-display-buttonized t] | 2394 | ["View MIME buttons" gnus-summary-display-buttonized t] |
| 2395 | ["View MIME buttons in header" | ||
| 2396 | gnus-mime-buttonize-attachments-in-header t] | ||
| 2397 | ["View all" gnus-mime-view-all-parts t] | 2397 | ["View all" gnus-mime-view-all-parts t] |
| 2398 | ["Verify and Decrypt" gnus-summary-force-verify-and-decrypt t] | 2398 | ["Verify and Decrypt" gnus-summary-force-verify-and-decrypt t] |
| 2399 | ["Encrypt body" gnus-article-encrypt-body | 2399 | ["Encrypt body" gnus-article-encrypt-body |
| @@ -9085,6 +9085,41 @@ non-numeric or nil fetch the number specified by the | |||
| 9085 | (gnus-summary-limit-include-thread id))) | 9085 | (gnus-summary-limit-include-thread id))) |
| 9086 | (gnus-summary-show-thread)) | 9086 | (gnus-summary-show-thread)) |
| 9087 | 9087 | ||
| 9088 | (defun gnus-summary-open-group-with-article (message-id) | ||
| 9089 | "Open a group containing the article with the given MESSAGE-ID." | ||
| 9090 | (interactive "sMessage-ID: ") | ||
| 9091 | (require 'nndoc) | ||
| 9092 | (with-temp-buffer | ||
| 9093 | ;; Prepare a dummy article | ||
| 9094 | (erase-buffer) | ||
| 9095 | (insert "From nobody Tue Sep 13 22:05:34 2011\n\n") | ||
| 9096 | |||
| 9097 | ;; Prepare pretty modelines for summary and article buffers | ||
| 9098 | (let ((gnus-summary-mode-line-format "Found %G") | ||
| 9099 | (gnus-article-mode-line-format | ||
| 9100 | ;; Group names just get in the way here, especially the | ||
| 9101 | ;; abbreviated ones | ||
| 9102 | (if (string-match "%[gG]" gnus-article-mode-line-format) | ||
| 9103 | (concat (substring gnus-article-mode-line-format | ||
| 9104 | 0 (match-beginning 0)) | ||
| 9105 | (substring gnus-article-mode-line-format (match-end 0))) | ||
| 9106 | gnus-article-mode-line-format))) | ||
| 9107 | |||
| 9108 | ;; Build an ephemeral group containing the dummy article (hidden) | ||
| 9109 | (gnus-group-read-ephemeral-group | ||
| 9110 | message-id | ||
| 9111 | `(nndoc ,message-id | ||
| 9112 | (nndoc-address ,(current-buffer)) | ||
| 9113 | (nndoc-article-type mbox)) | ||
| 9114 | :activate | ||
| 9115 | (cons (current-buffer) gnus-current-window-configuration) | ||
| 9116 | (not :request-only) | ||
| 9117 | '(-1) ; :select-articles | ||
| 9118 | (not :parameters) | ||
| 9119 | 0)) ; :number | ||
| 9120 | ;; Fetch the desired article | ||
| 9121 | (gnus-summary-refer-article message-id))) | ||
| 9122 | |||
| 9088 | (defun gnus-summary-refer-article (message-id) | 9123 | (defun gnus-summary-refer-article (message-id) |
| 9089 | "Fetch an article specified by MESSAGE-ID." | 9124 | "Fetch an article specified by MESSAGE-ID." |
| 9090 | (interactive "sMessage-ID: ") | 9125 | (interactive "sMessage-ID: ") |
| @@ -9779,7 +9814,10 @@ If ARG is a negative number, hide the unwanted header lines." | |||
| 9779 | (gnus-treat-hide-boring-headers nil)) | 9814 | (gnus-treat-hide-boring-headers nil)) |
| 9780 | (gnus-delete-wash-type 'headers) | 9815 | (gnus-delete-wash-type 'headers) |
| 9781 | (gnus-treat-article 'head)) | 9816 | (gnus-treat-article 'head)) |
| 9782 | (gnus-treat-article 'head)) | 9817 | (gnus-treat-article 'head) |
| 9818 | ;; Add attachment buttons to the header. | ||
| 9819 | (when gnus-mime-display-attachment-buttons-in-header | ||
| 9820 | (gnus-mime-buttonize-attachments-in-header))) | ||
| 9783 | (widen) | 9821 | (widen) |
| 9784 | (if window | 9822 | (if window |
| 9785 | (set-window-start window (goto-char (point-min)))) | 9823 | (set-window-start window (goto-char (point-min)))) |
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index a3038a1bfe5..62977576a00 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el | |||
| @@ -32,9 +32,6 @@ | |||
| 32 | 32 | ||
| 33 | ;;; Code: | 33 | ;;; Code: |
| 34 | 34 | ||
| 35 | ;; For Emacs <22.2 and XEmacs. | ||
| 36 | (eval-and-compile | ||
| 37 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) | ||
| 38 | (eval-when-compile | 35 | (eval-when-compile |
| 39 | (require 'cl)) | 36 | (require 'cl)) |
| 40 | 37 | ||
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index b1d60de93d9..206f5a502fc 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el | |||
| @@ -29,10 +29,6 @@ | |||
| 29 | 29 | ||
| 30 | (eval '(run-hooks 'gnus-load-hook)) | 30 | (eval '(run-hooks 'gnus-load-hook)) |
| 31 | 31 | ||
| 32 | ;; For Emacs <22.2 and XEmacs. | ||
| 33 | (eval-and-compile | ||
| 34 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) | ||
| 35 | |||
| 36 | (eval-when-compile (require 'cl)) | 32 | (eval-when-compile (require 'cl)) |
| 37 | (require 'wid-edit) | 33 | (require 'wid-edit) |
| 38 | (require 'mm-util) | 34 | (require 'mm-util) |
| @@ -309,6 +305,7 @@ be set in `.emacs' instead." | |||
| 309 | 305 | ||
| 310 | (unless (featurep 'gnus-xmas) | 306 | (unless (featurep 'gnus-xmas) |
| 311 | (defalias 'gnus-make-overlay 'make-overlay) | 307 | (defalias 'gnus-make-overlay 'make-overlay) |
| 308 | (defalias 'gnus-copy-overlay 'copy-overlay) | ||
| 312 | (defalias 'gnus-delete-overlay 'delete-overlay) | 309 | (defalias 'gnus-delete-overlay 'delete-overlay) |
| 313 | (defalias 'gnus-overlay-get 'overlay-get) | 310 | (defalias 'gnus-overlay-get 'overlay-get) |
| 314 | (defalias 'gnus-overlay-put 'overlay-put) | 311 | (defalias 'gnus-overlay-put 'overlay-put) |
| @@ -316,6 +313,7 @@ be set in `.emacs' instead." | |||
| 316 | (defalias 'gnus-overlay-buffer 'overlay-buffer) | 313 | (defalias 'gnus-overlay-buffer 'overlay-buffer) |
| 317 | (defalias 'gnus-overlay-start 'overlay-start) | 314 | (defalias 'gnus-overlay-start 'overlay-start) |
| 318 | (defalias 'gnus-overlay-end 'overlay-end) | 315 | (defalias 'gnus-overlay-end 'overlay-end) |
| 316 | (defalias 'gnus-overlays-at 'overlays-at) | ||
| 319 | (defalias 'gnus-overlays-in 'overlays-in) | 317 | (defalias 'gnus-overlays-in 'overlays-in) |
| 320 | (defalias 'gnus-extent-detached-p 'ignore) | 318 | (defalias 'gnus-extent-detached-p 'ignore) |
| 321 | (defalias 'gnus-extent-start-open 'ignore) | 319 | (defalias 'gnus-extent-start-open 'ignore) |
| @@ -1614,7 +1612,7 @@ slower." | |||
| 1614 | :type 'string) | 1612 | :type 'string) |
| 1615 | 1613 | ||
| 1616 | (defcustom gnus-valid-select-methods | 1614 | (defcustom gnus-valid-select-methods |
| 1617 | '(("nntp" post address prompt-address physical-address) | 1615 | '(("nntp" post address prompt-address physical-address cloud) |
| 1618 | ("nnspool" post address) | 1616 | ("nnspool" post address) |
| 1619 | ("nnvirtual" post-mail virtual prompt-address) | 1617 | ("nnvirtual" post-mail virtual prompt-address) |
| 1620 | ("nnmbox" mail respool address) | 1618 | ("nnmbox" mail respool address) |
| @@ -1631,7 +1629,7 @@ slower." | |||
| 1631 | ("nnrss" none global) | 1629 | ("nnrss" none global) |
| 1632 | ("nnagent" post-mail) | 1630 | ("nnagent" post-mail) |
| 1633 | ("nnimap" post-mail address prompt-address physical-address respool | 1631 | ("nnimap" post-mail address prompt-address physical-address respool |
| 1634 | server-marks) | 1632 | server-marks cloud) |
| 1635 | ("nnmaildir" mail respool address server-marks) | 1633 | ("nnmaildir" mail respool address server-marks) |
| 1636 | ("nnnil" none)) | 1634 | ("nnnil" none)) |
| 1637 | "*An alist of valid select methods. | 1635 | "*An alist of valid select methods. |
| @@ -2703,7 +2701,10 @@ such as a mark that says whether an article is stored in the cache | |||
| 2703 | gnus-newsrc-last-checked-date | 2701 | gnus-newsrc-last-checked-date |
| 2704 | gnus-newsrc-alist gnus-server-alist | 2702 | gnus-newsrc-alist gnus-server-alist |
| 2705 | gnus-killed-list gnus-zombie-list | 2703 | gnus-killed-list gnus-zombie-list |
| 2706 | gnus-topic-topology gnus-topic-alist) | 2704 | gnus-topic-topology gnus-topic-alist |
| 2705 | gnus-cloud-sequence | ||
| 2706 | gnus-cloud-covered-servers | ||
| 2707 | gnus-cloud-file-timestamps) | ||
| 2707 | "Gnus variables saved in the quick startup file.") | 2708 | "Gnus variables saved in the quick startup file.") |
| 2708 | 2709 | ||
| 2709 | (defvar gnus-newsrc-alist nil | 2710 | (defvar gnus-newsrc-alist nil |
diff --git a/lisp/gnus/gravatar.el b/lisp/gnus/gravatar.el index 650564e2802..ffbc37ae158 100644 --- a/lisp/gnus/gravatar.el +++ b/lisp/gnus/gravatar.el | |||
| @@ -138,9 +138,7 @@ You can provide a list of argument to pass to CB in CBARGS." | |||
| 138 | "Retrieve MAIL-ADDRESS gravatar and returns it." | 138 | "Retrieve MAIL-ADDRESS gravatar and returns it." |
| 139 | (let ((url (gravatar-build-url mail-address))) | 139 | (let ((url (gravatar-build-url mail-address))) |
| 140 | (if (gravatar-cache-expired url) | 140 | (if (gravatar-cache-expired url) |
| 141 | (with-current-buffer (if (featurep 'xemacs) | 141 | (with-current-buffer (url-retrieve-synchronously url) |
| 142 | (url-retrieve url) | ||
| 143 | (url-retrieve-synchronously url)) | ||
| 144 | (when gravatar-automatic-caching | 142 | (when gravatar-automatic-caching |
| 145 | (url-store-in-cache (current-buffer))) | 143 | (url-store-in-cache (current-buffer))) |
| 146 | (let ((data (gravatar-data->image))) | 144 | (let ((data (gravatar-data->image))) |
diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el index d54377fae19..51b9c911545 100644 --- a/lisp/gnus/mail-source.el +++ b/lisp/gnus/mail-source.el | |||
| @@ -24,10 +24,6 @@ | |||
| 24 | 24 | ||
| 25 | ;;; Code: | 25 | ;;; Code: |
| 26 | 26 | ||
| 27 | ;; For Emacs <22.2 and XEmacs. | ||
| 28 | (eval-and-compile | ||
| 29 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) | ||
| 30 | |||
| 31 | (require 'format-spec) | 27 | (require 'format-spec) |
| 32 | (eval-when-compile | 28 | (eval-when-compile |
| 33 | (require 'cl) | 29 | (require 'cl) |
diff --git a/lisp/gnus/mailcap.el b/lisp/gnus/mailcap.el index 5515a348b4c..4f1bdf4b1df 100644 --- a/lisp/gnus/mailcap.el +++ b/lisp/gnus/mailcap.el | |||
| @@ -216,10 +216,6 @@ This is a compatibility function for different Emacsen." | |||
| 216 | (test . (fboundp 'vm-mode)) | 216 | (test . (fboundp 'vm-mode)) |
| 217 | (type . "message/rfc822")) | 217 | (type . "message/rfc822")) |
| 218 | ("rfc-*822" | 218 | ("rfc-*822" |
| 219 | (viewer . w3-mode) | ||
| 220 | (test . (fboundp 'w3-mode)) | ||
| 221 | (type . "message/rfc822")) | ||
| 222 | ("rfc-*822" | ||
| 223 | (viewer . view-mode) | 219 | (viewer . view-mode) |
| 224 | (type . "message/rfc822"))) | 220 | (type . "message/rfc822"))) |
| 225 | ("image" | 221 | ("image" |
| @@ -253,10 +249,6 @@ This is a compatibility function for different Emacsen." | |||
| 253 | ("needsx11"))) | 249 | ("needsx11"))) |
| 254 | ("text" | 250 | ("text" |
| 255 | ("plain" | 251 | ("plain" |
| 256 | (viewer . w3-mode) | ||
| 257 | (test . (fboundp 'w3-mode)) | ||
| 258 | (type . "text/plain")) | ||
| 259 | ("plain" | ||
| 260 | (viewer . view-mode) | 252 | (viewer . view-mode) |
| 261 | (test . (fboundp 'view-mode)) | 253 | (test . (fboundp 'view-mode)) |
| 262 | (type . "text/plain")) | 254 | (type . "text/plain")) |
| @@ -267,10 +259,6 @@ This is a compatibility function for different Emacsen." | |||
| 267 | (viewer . enriched-decode) | 259 | (viewer . enriched-decode) |
| 268 | (test . (fboundp 'enriched-decode)) | 260 | (test . (fboundp 'enriched-decode)) |
| 269 | (type . "text/enriched")) | 261 | (type . "text/enriched")) |
| 270 | ("html" | ||
| 271 | (viewer . mm-w3-prepare-buffer) | ||
| 272 | (test . (fboundp 'w3-prepare-buffer)) | ||
| 273 | (type . "text/html")) | ||
| 274 | ("dns" | 262 | ("dns" |
| 275 | (viewer . dns-mode) | 263 | (viewer . dns-mode) |
| 276 | (test . (fboundp 'dns-mode)) | 264 | (test . (fboundp 'dns-mode)) |
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 5300de5eabb..1f42ccb61f4 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el | |||
| @@ -28,9 +28,6 @@ | |||
| 28 | 28 | ||
| 29 | ;;; Code: | 29 | ;;; Code: |
| 30 | 30 | ||
| 31 | ;; For Emacs <22.2 and XEmacs. | ||
| 32 | (eval-and-compile | ||
| 33 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) | ||
| 34 | (eval-when-compile | 31 | (eval-when-compile |
| 35 | (require 'cl)) | 32 | (require 'cl)) |
| 36 | 33 | ||
| @@ -50,6 +47,7 @@ | |||
| 50 | (require 'mml) | 47 | (require 'mml) |
| 51 | (require 'rfc822) | 48 | (require 'rfc822) |
| 52 | (require 'format-spec) | 49 | (require 'format-spec) |
| 50 | (require 'dired) | ||
| 53 | 51 | ||
| 54 | (autoload 'mailclient-send-it "mailclient") ;; Emacs 22 or contrib/ | 52 | (autoload 'mailclient-send-it "mailclient") ;; Emacs 22 or contrib/ |
| 55 | 53 | ||
| @@ -606,7 +604,8 @@ Done before generating the new subject of a forward." | |||
| 606 | regexp)) | 604 | regexp)) |
| 607 | 605 | ||
| 608 | (defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus" | 606 | (defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus" |
| 609 | "*All headers that match this regexp will be deleted when forwarding a message." | 607 | "*All headers that match this regexp will be deleted when forwarding a message. |
| 608 | This may also be a list of regexps." | ||
| 610 | :version "21.1" | 609 | :version "21.1" |
| 611 | :group 'message-forwarding | 610 | :group 'message-forwarding |
| 612 | :type '(repeat :value-to-internal (lambda (widget value) | 611 | :type '(repeat :value-to-internal (lambda (widget value) |
| @@ -616,6 +615,19 @@ Done before generating the new subject of a forward." | |||
| 616 | (widget-editable-list-match widget value))) | 615 | (widget-editable-list-match widget value))) |
| 617 | regexp)) | 616 | regexp)) |
| 618 | 617 | ||
| 618 | (defcustom message-forward-included-headers nil | ||
| 619 | "If non-nil, delete non-matching headers when forwarding a message. | ||
| 620 | Only headers that match this regexp will be included. This | ||
| 621 | variable should be a regexp or a list of regexps." | ||
| 622 | :version "24.5" | ||
| 623 | :group 'message-forwarding | ||
| 624 | :type '(repeat :value-to-internal (lambda (widget value) | ||
| 625 | (custom-split-regexp-maybe value)) | ||
| 626 | :match (lambda (widget value) | ||
| 627 | (or (stringp value) | ||
| 628 | (widget-editable-list-match widget value))) | ||
| 629 | regexp)) | ||
| 630 | |||
| 619 | (defcustom message-ignored-cited-headers "." | 631 | (defcustom message-ignored-cited-headers "." |
| 620 | "*Delete these headers from the messages you yank." | 632 | "*Delete these headers from the messages you yank." |
| 621 | :group 'message-insertion | 633 | :group 'message-insertion |
| @@ -2451,6 +2463,7 @@ With prefix-argument just set Follow-Up, don't cross-post." | |||
| 2451 | "Remove HEADER in the narrowed buffer. | 2463 | "Remove HEADER in the narrowed buffer. |
| 2452 | If IS-REGEXP, HEADER is a regular expression. | 2464 | If IS-REGEXP, HEADER is a regular expression. |
| 2453 | If FIRST, only remove the first instance of the header. | 2465 | If FIRST, only remove the first instance of the header. |
| 2466 | If REVERSE, remove headers that doesn't match HEADER. | ||
| 2454 | Return the number of headers removed." | 2467 | Return the number of headers removed." |
| 2455 | (goto-char (point-min)) | 2468 | (goto-char (point-min)) |
| 2456 | (let ((regexp (if is-regexp header (concat "^" (regexp-quote header) ":"))) | 2469 | (let ((regexp (if is-regexp header (concat "^" (regexp-quote header) ":"))) |
| @@ -7374,17 +7387,25 @@ Optional DIGEST will use digest to forward." | |||
| 7374 | (message-remove-ignored-headers b e))) | 7387 | (message-remove-ignored-headers b e))) |
| 7375 | 7388 | ||
| 7376 | (defun message-remove-ignored-headers (b e) | 7389 | (defun message-remove-ignored-headers (b e) |
| 7377 | (when message-forward-ignored-headers | 7390 | (when (or message-forward-ignored-headers |
| 7391 | message-forward-included-headers) | ||
| 7378 | (save-restriction | 7392 | (save-restriction |
| 7379 | (narrow-to-region b e) | 7393 | (narrow-to-region b e) |
| 7380 | (goto-char b) | 7394 | (goto-char b) |
| 7381 | (narrow-to-region (point) | 7395 | (narrow-to-region (point) |
| 7382 | (or (search-forward "\n\n" nil t) (point))) | 7396 | (or (search-forward "\n\n" nil t) (point))) |
| 7383 | (let ((ignored (if (stringp message-forward-ignored-headers) | 7397 | (when message-forward-ignored-headers |
| 7384 | (list message-forward-ignored-headers) | 7398 | (let ((ignored (if (stringp message-forward-ignored-headers) |
| 7385 | message-forward-ignored-headers))) | 7399 | (list message-forward-ignored-headers) |
| 7386 | (dolist (elem ignored) | 7400 | message-forward-ignored-headers))) |
| 7387 | (message-remove-header elem t)))))) | 7401 | (dolist (elem ignored) |
| 7402 | (message-remove-header elem t)))) | ||
| 7403 | (when message-forward-included-headers | ||
| 7404 | (message-remove-header | ||
| 7405 | (if (listp message-forward-included-headers) | ||
| 7406 | (regexp-opt message-forward-included-headers) | ||
| 7407 | message-forward-included-headers) | ||
| 7408 | t nil t))))) | ||
| 7388 | 7409 | ||
| 7389 | (defun message-forward-make-body-mime (forward-buffer &optional beg end) | 7410 | (defun message-forward-make-body-mime (forward-buffer &optional beg end) |
| 7390 | (let ((b (point))) | 7411 | (let ((b (point))) |
| @@ -7432,8 +7453,7 @@ Optional DIGEST will use digest to forward." | |||
| 7432 | (goto-char (point-max)))) | 7453 | (goto-char (point-max)))) |
| 7433 | (setq e (point)) | 7454 | (setq e (point)) |
| 7434 | (insert "<#/mml>\n") | 7455 | (insert "<#/mml>\n") |
| 7435 | (when (and (not message-forward-decoded-p) | 7456 | (when (not message-forward-decoded-p) |
| 7436 | message-forward-ignored-headers) | ||
| 7437 | (message-remove-ignored-headers b e)))) | 7457 | (message-remove-ignored-headers b e)))) |
| 7438 | 7458 | ||
| 7439 | (defun message-forward-make-body-digest-plain (forward-buffer) | 7459 | (defun message-forward-make-body-digest-plain (forward-buffer) |
| @@ -8421,6 +8441,17 @@ Used in `message-simplify-recipients'." | |||
| 8421 | (message-fetch-field hdr) t)) | 8441 | (message-fetch-field hdr) t)) |
| 8422 | ", ")))) | 8442 | ", ")))) |
| 8423 | 8443 | ||
| 8444 | ;;; multipart/related and HTML support. | ||
| 8445 | |||
| 8446 | (defun message-make-html-message-with-image-files (files) | ||
| 8447 | (interactive (list (dired-get-marked-files nil current-prefix-arg))) | ||
| 8448 | (message-mail) | ||
| 8449 | (message-goto-body) | ||
| 8450 | (insert "<#part type=text/html>\n\n") | ||
| 8451 | (dolist (file files) | ||
| 8452 | (insert (format "<img src=%S>\n\n" file))) | ||
| 8453 | (message-goto-to)) | ||
| 8454 | |||
| 8424 | (when (featurep 'xemacs) | 8455 | (when (featurep 'xemacs) |
| 8425 | (require 'messagexmas) | 8456 | (require 'messagexmas) |
| 8426 | (message-xmas-redefine)) | 8457 | (message-xmas-redefine)) |
diff --git a/lisp/gnus/mm-bodies.el b/lisp/gnus/mm-bodies.el index 49724597382..c2f6df9c62a 100644 --- a/lisp/gnus/mm-bodies.el +++ b/lisp/gnus/mm-bodies.el | |||
| @@ -23,10 +23,6 @@ | |||
| 23 | 23 | ||
| 24 | ;;; Code: | 24 | ;;; Code: |
| 25 | 25 | ||
| 26 | ;; For Emacs <22.2 and XEmacs. | ||
| 27 | (eval-and-compile | ||
| 28 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) | ||
| 29 | |||
| 30 | (require 'mm-util) | 26 | (require 'mm-util) |
| 31 | (require 'rfc2047) | 27 | (require 'rfc2047) |
| 32 | (require 'mm-encode) | 28 | (require 'mm-encode) |
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index 17c8fb1b8db..a99e7a43caa 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el | |||
| @@ -23,10 +23,6 @@ | |||
| 23 | 23 | ||
| 24 | ;;; Code: | 24 | ;;; Code: |
| 25 | 25 | ||
| 26 | ;; For Emacs <22.2 and XEmacs. | ||
| 27 | (eval-and-compile | ||
| 28 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) | ||
| 29 | |||
| 30 | (require 'mail-parse) | 26 | (require 'mail-parse) |
| 31 | (require 'mm-bodies) | 27 | (require 'mm-bodies) |
| 32 | (eval-when-compile (require 'cl)) | 28 | (eval-when-compile (require 'cl)) |
| @@ -124,7 +120,6 @@ | |||
| 124 | ((executable-find "w3m") 'gnus-w3m) | 120 | ((executable-find "w3m") 'gnus-w3m) |
| 125 | ((executable-find "links") 'links) | 121 | ((executable-find "links") 'links) |
| 126 | ((executable-find "lynx") 'lynx) | 122 | ((executable-find "lynx") 'lynx) |
| 127 | ((locate-library "w3") 'w3) | ||
| 128 | ((locate-library "html2text") 'html2text) | 123 | ((locate-library "html2text") 'html2text) |
| 129 | (t nil)) | 124 | (t nil)) |
| 130 | "Render of HTML contents. | 125 | "Render of HTML contents. |
| @@ -136,13 +131,11 @@ The defined renderer types are: | |||
| 136 | `w3m-standalone': use plain w3m; | 131 | `w3m-standalone': use plain w3m; |
| 137 | `links': use links; | 132 | `links': use links; |
| 138 | `lynx': use lynx; | 133 | `lynx': use lynx; |
| 139 | `w3': use Emacs/W3; | ||
| 140 | `html2text': use html2text; | 134 | `html2text': use html2text; |
| 141 | nil : use external viewer (default web browser)." | 135 | nil : use external viewer (default web browser)." |
| 142 | :version "24.1" | 136 | :version "24.1" |
| 143 | :type '(choice (const shr) | 137 | :type '(choice (const shr) |
| 144 | (const gnus-w3m) | 138 | (const gnus-w3m) |
| 145 | (const w3) | ||
| 146 | (const w3m :tag "emacs-w3m") | 139 | (const w3m :tag "emacs-w3m") |
| 147 | (const w3m-standalone :tag "standalone w3m" ) | 140 | (const w3m-standalone :tag "standalone w3m" ) |
| 148 | (const links) | 141 | (const links) |
| @@ -153,9 +146,9 @@ nil : use external viewer (default web browser)." | |||
| 153 | :group 'mime-display) | 146 | :group 'mime-display) |
| 154 | 147 | ||
| 155 | (defcustom mm-inline-text-html-with-images nil | 148 | (defcustom mm-inline-text-html-with-images nil |
| 156 | "If non-nil, Gnus will allow retrieving images in HTML contents with | 149 | "If non-nil, Gnus will allow retrieving images in HTML that has <img> tags. |
| 157 | the <img> tags. It has no effect on Emacs/w3. See also the | 150 | See also the documentation for the `mm-w3m-safe-url-regexp' |
| 158 | documentation for the `mm-w3m-safe-url-regexp' variable." | 151 | variable." |
| 159 | :version "22.1" | 152 | :version "22.1" |
| 160 | :type 'boolean | 153 | :type 'boolean |
| 161 | :group 'mime-display) | 154 | :group 'mime-display) |
diff --git a/lisp/gnus/mm-extern.el b/lisp/gnus/mm-extern.el index 882c8545e59..d574b9d51df 100644 --- a/lisp/gnus/mm-extern.el +++ b/lisp/gnus/mm-extern.el | |||
| @@ -24,10 +24,6 @@ | |||
| 24 | 24 | ||
| 25 | ;;; Code: | 25 | ;;; Code: |
| 26 | 26 | ||
| 27 | ;; For Emacs <22.2 and XEmacs. | ||
| 28 | (eval-and-compile | ||
| 29 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) | ||
| 30 | |||
| 31 | (eval-when-compile (require 'cl)) | 27 | (eval-when-compile (require 'cl)) |
| 32 | 28 | ||
| 33 | (require 'mm-util) | 29 | (require 'mm-util) |
diff --git a/lisp/gnus/mm-url.el b/lisp/gnus/mm-url.el index 4b46ab74f52..bb342d6b8b1 100644 --- a/lisp/gnus/mm-url.el +++ b/lisp/gnus/mm-url.el | |||
| @@ -21,7 +21,7 @@ | |||
| 21 | 21 | ||
| 22 | ;;; Commentary: | 22 | ;;; Commentary: |
| 23 | 23 | ||
| 24 | ;; Some codes are stolen from w3 and url packages. Some are moved from | 24 | ;; Some code is stolen from w3 and url packages. Some are moved from |
| 25 | ;; nnweb. | 25 | ;; nnweb. |
| 26 | 26 | ||
| 27 | ;; TODO: Support POST, cookie. | 27 | ;; TODO: Support POST, cookie. |
| @@ -264,8 +264,6 @@ This is taken from RFC 2396.") | |||
| 264 | (require 'url-parse) | 264 | (require 'url-parse) |
| 265 | (require 'url-vars)) | 265 | (require 'url-vars)) |
| 266 | (error nil)) | 266 | (error nil)) |
| 267 | ;; w3-4.0pre0.46 or earlier version. | ||
| 268 | (require 'w3-vars) | ||
| 269 | (require 'url))) | 267 | (require 'url))) |
| 270 | 268 | ||
| 271 | ;;;###autoload | 269 | ;;;###autoload |
diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el index 38ee8a563e5..0d02e1db758 100644 --- a/lisp/gnus/mm-util.el +++ b/lisp/gnus/mm-util.el | |||
| @@ -23,10 +23,6 @@ | |||
| 23 | 23 | ||
| 24 | ;;; Code: | 24 | ;;; Code: |
| 25 | 25 | ||
| 26 | ;; For Emacs <22.2 and XEmacs. | ||
| 27 | (eval-and-compile | ||
| 28 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) | ||
| 29 | |||
| 30 | (eval-when-compile (require 'cl)) | 26 | (eval-when-compile (require 'cl)) |
| 31 | (require 'mail-prsvr) | 27 | (require 'mail-prsvr) |
| 32 | 28 | ||
diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index a764fa51c5d..27f772cffa1 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el | |||
| @@ -22,9 +22,6 @@ | |||
| 22 | 22 | ||
| 23 | ;;; Code: | 23 | ;;; Code: |
| 24 | 24 | ||
| 25 | ;; For Emacs <22.2 and XEmacs. | ||
| 26 | (eval-and-compile | ||
| 27 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) | ||
| 28 | (eval-when-compile (require 'cl)) | 25 | (eval-when-compile (require 'cl)) |
| 29 | (require 'mail-parse) | 26 | (require 'mail-parse) |
| 30 | (require 'mailcap) | 27 | (require 'mailcap) |
| @@ -51,7 +48,6 @@ | |||
| 51 | 48 | ||
| 52 | (defvar mm-text-html-renderer-alist | 49 | (defvar mm-text-html-renderer-alist |
| 53 | '((shr . mm-shr) | 50 | '((shr . mm-shr) |
| 54 | (w3 . mm-inline-text-html-render-with-w3) | ||
| 55 | (w3m . mm-inline-text-html-render-with-w3m) | 51 | (w3m . mm-inline-text-html-render-with-w3m) |
| 56 | (w3m-standalone . mm-inline-text-html-render-with-w3m-standalone) | 52 | (w3m-standalone . mm-inline-text-html-render-with-w3m-standalone) |
| 57 | (gnus-w3m . gnus-article-html) | 53 | (gnus-w3m . gnus-article-html) |
| @@ -130,91 +126,6 @@ | |||
| 130 | (defalias 'mm-inline-image 'mm-inline-image-xemacs) | 126 | (defalias 'mm-inline-image 'mm-inline-image-xemacs) |
| 131 | (defalias 'mm-inline-image 'mm-inline-image-emacs))) | 127 | (defalias 'mm-inline-image 'mm-inline-image-emacs))) |
| 132 | 128 | ||
| 133 | ;; External. | ||
| 134 | (declare-function w3-do-setup "ext:w3" ()) | ||
| 135 | (declare-function w3-region "ext:w3-display" (st nd)) | ||
| 136 | (declare-function w3-prepare-buffer "ext:w3-display" (&rest args)) | ||
| 137 | |||
| 138 | (defvar mm-w3-setup nil) | ||
| 139 | (defun mm-setup-w3 () | ||
| 140 | (unless mm-w3-setup | ||
| 141 | (require 'w3) | ||
| 142 | (w3-do-setup) | ||
| 143 | (require 'url) | ||
| 144 | (require 'w3-vars) | ||
| 145 | (require 'url-vars) | ||
| 146 | (setq mm-w3-setup t))) | ||
| 147 | |||
| 148 | (defun mm-inline-text-html-render-with-w3 (handle) | ||
| 149 | (mm-setup-w3) | ||
| 150 | (let ((text (mm-get-part handle)) | ||
| 151 | (b (point)) | ||
| 152 | (url-standalone-mode t) | ||
| 153 | (url-gateway-unplugged t) | ||
| 154 | (w3-honor-stylesheets nil) | ||
| 155 | (url-current-object | ||
| 156 | (url-generic-parse-url (format "cid:%s" (mm-handle-id handle)))) | ||
| 157 | (width (window-width)) | ||
| 158 | (charset (mail-content-type-get | ||
| 159 | (mm-handle-type handle) 'charset))) | ||
| 160 | (save-excursion | ||
| 161 | (insert (if charset (mm-decode-string text charset) text)) | ||
| 162 | (save-restriction | ||
| 163 | (narrow-to-region b (point)) | ||
| 164 | (unless charset | ||
| 165 | (goto-char (point-min)) | ||
| 166 | (when (or (and (boundp 'w3-meta-content-type-charset-regexp) | ||
| 167 | (re-search-forward | ||
| 168 | w3-meta-content-type-charset-regexp nil t)) | ||
| 169 | (and (boundp 'w3-meta-charset-content-type-regexp) | ||
| 170 | (re-search-forward | ||
| 171 | w3-meta-charset-content-type-regexp nil t))) | ||
| 172 | (setq charset | ||
| 173 | (let ((bsubstr (buffer-substring-no-properties | ||
| 174 | (match-beginning 2) | ||
| 175 | (match-end 2)))) | ||
| 176 | (if (fboundp 'w3-coding-system-for-mime-charset) | ||
| 177 | (w3-coding-system-for-mime-charset bsubstr) | ||
| 178 | (mm-charset-to-coding-system bsubstr nil t)))) | ||
| 179 | (delete-region (point-min) (point-max)) | ||
| 180 | (insert (mm-decode-string text charset)))) | ||
| 181 | (save-window-excursion | ||
| 182 | (save-restriction | ||
| 183 | (let ((w3-strict-width width) | ||
| 184 | ;; Don't let w3 set the global version of | ||
| 185 | ;; this variable. | ||
| 186 | (fill-column fill-column)) | ||
| 187 | (if (or debug-on-error debug-on-quit) | ||
| 188 | (w3-region (point-min) (point-max)) | ||
| 189 | (condition-case () | ||
| 190 | (w3-region (point-min) (point-max)) | ||
| 191 | (error | ||
| 192 | (delete-region (point-min) (point-max)) | ||
| 193 | (let ((b (point)) | ||
| 194 | (charset (mail-content-type-get | ||
| 195 | (mm-handle-type handle) 'charset))) | ||
| 196 | (if (or (eq charset 'gnus-decoded) | ||
| 197 | (eq mail-parse-charset 'gnus-decoded)) | ||
| 198 | (save-restriction | ||
| 199 | (narrow-to-region (point) (point)) | ||
| 200 | (mm-insert-part handle) | ||
| 201 | (goto-char (point-max))) | ||
| 202 | (insert (mm-decode-string (mm-get-part handle) | ||
| 203 | charset)))) | ||
| 204 | (message | ||
| 205 | "Error while rendering html; showing as text/plain"))))))) | ||
| 206 | (mm-handle-set-undisplayer | ||
| 207 | handle | ||
| 208 | `(lambda () | ||
| 209 | (let ((inhibit-read-only t)) | ||
| 210 | ,@(if (functionp 'remove-specifier) | ||
| 211 | '((dolist (prop '(background background-pixmap foreground)) | ||
| 212 | (remove-specifier | ||
| 213 | (face-property 'default prop) | ||
| 214 | (current-buffer))))) | ||
| 215 | (delete-region ,(point-min-marker) | ||
| 216 | ,(point-max-marker))))))))) | ||
| 217 | |||
| 218 | (defvar mm-w3m-setup nil | 129 | (defvar mm-w3m-setup nil |
| 219 | "Whether gnus-article-mode has been setup to use emacs-w3m.") | 130 | "Whether gnus-article-mode has been setup to use emacs-w3m.") |
| 220 | 131 | ||
| @@ -499,13 +410,6 @@ | |||
| 499 | (defun mm-inline-audio (handle) | 410 | (defun mm-inline-audio (handle) |
| 500 | (message "Not implemented")) | 411 | (message "Not implemented")) |
| 501 | 412 | ||
| 502 | (defun mm-w3-prepare-buffer () | ||
| 503 | (require 'w3) | ||
| 504 | (let ((url-standalone-mode t) | ||
| 505 | (url-gateway-unplugged t) | ||
| 506 | (w3-honor-stylesheets nil)) | ||
| 507 | (w3-prepare-buffer))) | ||
| 508 | |||
| 509 | (defun mm-view-message () | 413 | (defun mm-view-message () |
| 510 | (mm-enable-multibyte) | 414 | (mm-enable-multibyte) |
| 511 | (let (handles) | 415 | (let (handles) |
diff --git a/lisp/gnus/mml-smime.el b/lisp/gnus/mml-smime.el index bd7a50f7184..caa1380a497 100644 --- a/lisp/gnus/mml-smime.el +++ b/lisp/gnus/mml-smime.el | |||
| @@ -24,10 +24,6 @@ | |||
| 24 | 24 | ||
| 25 | ;;; Code: | 25 | ;;; Code: |
| 26 | 26 | ||
| 27 | ;; For Emacs <22.2 and XEmacs. | ||
| 28 | (eval-and-compile | ||
| 29 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) | ||
| 30 | |||
| 31 | (eval-when-compile (require 'cl)) | 27 | (eval-when-compile (require 'cl)) |
| 32 | 28 | ||
| 33 | (require 'smime) | 29 | (require 'smime) |
diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index 439d7c5dc13..168fe4908c6 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el | |||
| @@ -22,10 +22,6 @@ | |||
| 22 | 22 | ||
| 23 | ;;; Code: | 23 | ;;; Code: |
| 24 | 24 | ||
| 25 | ;; For Emacs <22.2 and XEmacs. | ||
| 26 | (eval-and-compile | ||
| 27 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) | ||
| 28 | |||
| 29 | (require 'mm-util) | 25 | (require 'mm-util) |
| 30 | (require 'mm-bodies) | 26 | (require 'mm-bodies) |
| 31 | (require 'mm-encode) | 27 | (require 'mm-encode) |
| @@ -463,6 +459,9 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." | |||
| 463 | (defvar mml-multipart-number 0) | 459 | (defvar mml-multipart-number 0) |
| 464 | (defvar mml-inhibit-compute-boundary nil) | 460 | (defvar mml-inhibit-compute-boundary nil) |
| 465 | 461 | ||
| 462 | (declare-function libxml-parse-html-region "xml.c" | ||
| 463 | (start end &optional base-url)) | ||
| 464 | |||
| 466 | (defun mml-generate-mime (&optional multipart-type) | 465 | (defun mml-generate-mime (&optional multipart-type) |
| 467 | "Generate a MIME message based on the current MML document. | 466 | "Generate a MIME message based on the current MML document. |
| 468 | MULTIPART-TYPE defaults to \"mixed\", but can also | 467 | MULTIPART-TYPE defaults to \"mixed\", but can also |
| @@ -472,19 +471,69 @@ be \"related\" or \"alternate\"." | |||
| 472 | (options message-options)) | 471 | (options message-options)) |
| 473 | (if (not cont) | 472 | (if (not cont) |
| 474 | nil | 473 | nil |
| 474 | (when (and (consp (car cont)) | ||
| 475 | (= (length cont) 1) | ||
| 476 | (fboundp 'libxml-parse-html-region) | ||
| 477 | (equal (cdr (assq 'type (car cont))) "text/html")) | ||
| 478 | (setq cont (mml-expand-html-into-multipart-related (car cont)))) | ||
| 475 | (prog1 | 479 | (prog1 |
| 476 | (mm-with-multibyte-buffer | 480 | (mm-with-multibyte-buffer |
| 477 | (setq message-options options) | 481 | (setq message-options options) |
| 478 | (if (and (consp (car cont)) | 482 | (cond |
| 479 | (= (length cont) 1)) | 483 | ((and (consp (car cont)) |
| 480 | (mml-generate-mime-1 (car cont)) | 484 | (= (length cont) 1)) |
| 485 | (mml-generate-mime-1 (car cont))) | ||
| 486 | ((eq (car cont) 'multipart) | ||
| 487 | (mml-generate-mime-1 cont)) | ||
| 488 | (t | ||
| 481 | (mml-generate-mime-1 | 489 | (mml-generate-mime-1 |
| 482 | (nconc (list 'multipart (cons 'type (or multipart-type "mixed"))) | 490 | (nconc (list 'multipart (cons 'type (or multipart-type "mixed"))) |
| 483 | cont))) | 491 | cont)))) |
| 484 | (setq options message-options) | 492 | (setq options message-options) |
| 485 | (buffer-string)) | 493 | (buffer-string)) |
| 486 | (setq message-options options))))) | 494 | (setq message-options options))))) |
| 487 | 495 | ||
| 496 | (defun mml-expand-html-into-multipart-related (cont) | ||
| 497 | (let ((new-parts nil) | ||
| 498 | (cid 1)) | ||
| 499 | (mm-with-multibyte-buffer | ||
| 500 | (insert (cdr (assq 'contents cont))) | ||
| 501 | (goto-char (point-min)) | ||
| 502 | (with-syntax-table mml-syntax-table | ||
| 503 | (while (re-search-forward "<img\\b" nil t) | ||
| 504 | (goto-char (match-beginning 0)) | ||
| 505 | (let* ((start (point)) | ||
| 506 | (img (nth 2 | ||
| 507 | (nth 2 | ||
| 508 | (libxml-parse-html-region | ||
| 509 | (point) (progn (forward-sexp) (point)))))) | ||
| 510 | (end (point)) | ||
| 511 | (parsed (url-generic-parse-url (cdr (assq 'src (cadr img)))))) | ||
| 512 | (when (and (null (url-type parsed)) | ||
| 513 | (url-filename parsed) | ||
| 514 | (file-exists-p (url-filename parsed))) | ||
| 515 | (goto-char start) | ||
| 516 | (when (search-forward (url-filename parsed) end t) | ||
| 517 | (let ((cid (format "fsf.%d" cid))) | ||
| 518 | (replace-match (concat "cid:" cid) t t) | ||
| 519 | (push (list cid (url-filename parsed)) new-parts)) | ||
| 520 | (setq cid (1+ cid))))))) | ||
| 521 | ;; We have local images that we want to include. | ||
| 522 | (if (not new-parts) | ||
| 523 | (list cont) | ||
| 524 | (setcdr (assq 'contents cont) (buffer-string)) | ||
| 525 | (setq cont | ||
| 526 | (nconc (list 'multipart (cons 'type "related")) | ||
| 527 | (list cont))) | ||
| 528 | (dolist (new-part (nreverse new-parts)) | ||
| 529 | (setq cont | ||
| 530 | (nconc cont | ||
| 531 | (list `(part (type . "image/png") | ||
| 532 | (filename . ,(nth 1 new-part)) | ||
| 533 | (id . ,(concat "<" (nth 0 new-part) | ||
| 534 | ">"))))))) | ||
| 535 | cont)))) | ||
| 536 | |||
| 488 | (defun mml-generate-mime-1 (cont) | 537 | (defun mml-generate-mime-1 (cont) |
| 489 | (let ((mm-use-ultra-safe-encoding | 538 | (let ((mm-use-ultra-safe-encoding |
| 490 | (or mm-use-ultra-safe-encoding (assq 'sign cont)))) | 539 | (or mm-use-ultra-safe-encoding (assq 'sign cont)))) |
diff --git a/lisp/gnus/mml1991.el b/lisp/gnus/mml1991.el index 8c698edb06a..2663107133d 100644 --- a/lisp/gnus/mml1991.el +++ b/lisp/gnus/mml1991.el | |||
| @@ -26,9 +26,6 @@ | |||
| 26 | ;;; Code: | 26 | ;;; Code: |
| 27 | 27 | ||
| 28 | (eval-and-compile | 28 | (eval-and-compile |
| 29 | ;; For Emacs <22.2 and XEmacs. | ||
| 30 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))) | ||
| 31 | |||
| 32 | (if (locate-library "password-cache") | 29 | (if (locate-library "password-cache") |
| 33 | (require 'password-cache) | 30 | (require 'password-cache) |
| 34 | (require 'password))) | 31 | (require 'password))) |
diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el index 9fc8f6e8c0c..a533829ce5c 100644 --- a/lisp/gnus/mml2015.el +++ b/lisp/gnus/mml2015.el | |||
| @@ -28,9 +28,6 @@ | |||
| 28 | ;;; Code: | 28 | ;;; Code: |
| 29 | 29 | ||
| 30 | (eval-and-compile | 30 | (eval-and-compile |
| 31 | ;; For Emacs <22.2 and XEmacs. | ||
| 32 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))) | ||
| 33 | |||
| 34 | (if (locate-library "password-cache") | 31 | (if (locate-library "password-cache") |
| 35 | (require 'password-cache) | 32 | (require 'password-cache) |
| 36 | (require 'password))) | 33 | (require 'password))) |
| @@ -51,12 +48,10 @@ | |||
| 51 | ;; Then mml1991 would not need to require mml2015, and mml1991-use | 48 | ;; Then mml1991 would not need to require mml2015, and mml1991-use |
| 52 | ;; could be removed. | 49 | ;; could be removed. |
| 53 | (defvar mml2015-use (or | 50 | (defvar mml2015-use (or |
| 54 | (condition-case nil | 51 | (progn |
| 55 | (progn | 52 | (ignore-errors (require 'epg-config)) |
| 56 | (require 'epg-config) | 53 | (and (fboundp 'epg-check-configuration) |
| 57 | (epg-check-configuration (epg-configuration)) | 54 | 'epg)) |
| 58 | 'epg) | ||
| 59 | (error)) | ||
| 60 | (progn | 55 | (progn |
| 61 | (let ((abs-file (locate-library "pgg"))) | 56 | (let ((abs-file (locate-library "pgg"))) |
| 62 | ;; Don't load PGG if it is marked as obsolete | 57 | ;; Don't load PGG if it is marked as obsolete |
diff --git a/lisp/gnus/nndraft.el b/lisp/gnus/nndraft.el index 3e917b41b19..764314de0af 100644 --- a/lisp/gnus/nndraft.el +++ b/lisp/gnus/nndraft.el | |||
| @@ -24,10 +24,6 @@ | |||
| 24 | 24 | ||
| 25 | ;;; Code: | 25 | ;;; Code: |
| 26 | 26 | ||
| 27 | ;; For Emacs <22.2 and XEmacs. | ||
| 28 | (eval-and-compile | ||
| 29 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) | ||
| 30 | |||
| 31 | (require 'nnheader) | 27 | (require 'nnheader) |
| 32 | (require 'nnmail) | 28 | (require 'nnmail) |
| 33 | (require 'gnus-start) | 29 | (require 'gnus-start) |
diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el index 1a799d3c573..a403f3965c0 100644 --- a/lisp/gnus/nnfolder.el +++ b/lisp/gnus/nnfolder.el | |||
| @@ -28,10 +28,6 @@ | |||
| 28 | 28 | ||
| 29 | ;;; Code: | 29 | ;;; Code: |
| 30 | 30 | ||
| 31 | ;; For Emacs <22.2 and XEmacs. | ||
| 32 | (eval-and-compile | ||
| 33 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) | ||
| 34 | |||
| 35 | (require 'nnheader) | 31 | (require 'nnheader) |
| 36 | (require 'message) | 32 | (require 'message) |
| 37 | (require 'nnmail) | 33 | (require 'nnmail) |
diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el index 3ce3dfa1e75..994c2d022c8 100644 --- a/lisp/gnus/nnheader.el +++ b/lisp/gnus/nnheader.el | |||
| @@ -26,9 +26,6 @@ | |||
| 26 | 26 | ||
| 27 | ;;; Code: | 27 | ;;; Code: |
| 28 | 28 | ||
| 29 | ;; For Emacs <22.2 and XEmacs. | ||
| 30 | (eval-and-compile | ||
| 31 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) | ||
| 32 | (eval-when-compile (require 'cl)) | 29 | (eval-when-compile (require 'cl)) |
| 33 | 30 | ||
| 34 | (defvar nnmail-extra-headers) | 31 | (defvar nnmail-extra-headers) |
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 2fc2dd6af79..1730bd4252c 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el | |||
| @@ -26,10 +26,6 @@ | |||
| 26 | 26 | ||
| 27 | ;;; Code: | 27 | ;;; Code: |
| 28 | 28 | ||
| 29 | ;; For Emacs <22.2 and XEmacs. | ||
| 30 | (eval-and-compile | ||
| 31 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) | ||
| 32 | |||
| 33 | (eval-and-compile | 29 | (eval-and-compile |
| 34 | (require 'nnheader) | 30 | (require 'nnheader) |
| 35 | ;; In Emacs 24, `open-protocol-stream' is an autoloaded alias for | 31 | ;; In Emacs 24, `open-protocol-stream' is an autoloaded alias for |
| @@ -628,6 +624,26 @@ textual parts.") | |||
| 628 | (nnheader-ms-strip-cr) | 624 | (nnheader-ms-strip-cr) |
| 629 | (cons group article))))))) | 625 | (cons group article))))))) |
| 630 | 626 | ||
| 627 | (deffoo nnimap-request-articles (articles &optional group server) | ||
| 628 | (when group | ||
| 629 | (setq group (nnimap-decode-gnus-group group))) | ||
| 630 | (with-current-buffer nntp-server-buffer | ||
| 631 | (let ((result (nnimap-change-group group server))) | ||
| 632 | (when result | ||
| 633 | (erase-buffer) | ||
| 634 | (with-current-buffer (nnimap-buffer) | ||
| 635 | (erase-buffer) | ||
| 636 | (when (nnimap-command | ||
| 637 | (if (nnimap-ver4-p) | ||
| 638 | "UID FETCH %s BODY.PEEK[]" | ||
| 639 | "UID FETCH %s RFC822.PEEK") | ||
| 640 | (nnimap-article-ranges (gnus-compress-sequence articles))) | ||
| 641 | (let ((buffer (current-buffer))) | ||
| 642 | (with-current-buffer nntp-server-buffer | ||
| 643 | (nnheader-insert-buffer-substring buffer) | ||
| 644 | (nnheader-ms-strip-cr))) | ||
| 645 | t)))))) | ||
| 646 | |||
| 631 | (defun nnimap-get-whole-article (article &optional command) | 647 | (defun nnimap-get-whole-article (article &optional command) |
| 632 | (let ((result | 648 | (let ((result |
| 633 | (nnimap-command | 649 | (nnimap-command |
diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index 5910cde1c3d..e2051dfd315 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el | |||
| @@ -171,10 +171,6 @@ | |||
| 171 | 171 | ||
| 172 | ;;; Setup: | 172 | ;;; Setup: |
| 173 | 173 | ||
| 174 | ;; For Emacs <22.2 and XEmacs. | ||
| 175 | (eval-and-compile | ||
| 176 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) | ||
| 177 | |||
| 178 | (require 'nnoo) | 174 | (require 'nnoo) |
| 179 | (require 'gnus-group) | 175 | (require 'gnus-group) |
| 180 | (require 'message) | 176 | (require 'message) |
diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el index ac4b638fda0..d1a0455a1b0 100644 --- a/lisp/gnus/nnmail.el +++ b/lisp/gnus/nnmail.el | |||
| @@ -24,10 +24,6 @@ | |||
| 24 | 24 | ||
| 25 | ;;; Code: | 25 | ;;; Code: |
| 26 | 26 | ||
| 27 | ;; For Emacs <22.2 and XEmacs. | ||
| 28 | (eval-and-compile | ||
| 29 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) | ||
| 30 | |||
| 31 | (eval-when-compile (require 'cl)) | 27 | (eval-when-compile (require 'cl)) |
| 32 | 28 | ||
| 33 | (require 'gnus) ; for macro gnus-kill-buffer, at least | 29 | (require 'gnus) ; for macro gnus-kill-buffer, at least |
diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el index 7d33e511baa..21fa5b37aa4 100644 --- a/lisp/gnus/nnmaildir.el +++ b/lisp/gnus/nnmaildir.el | |||
| @@ -59,10 +59,6 @@ | |||
| 59 | ) | 59 | ) |
| 60 | ] | 60 | ] |
| 61 | 61 | ||
| 62 | ;; For Emacs <22.2 and XEmacs. | ||
| 63 | (eval-and-compile | ||
| 64 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) | ||
| 65 | |||
| 66 | (require 'nnheader) | 62 | (require 'nnheader) |
| 67 | (require 'gnus) | 63 | (require 'gnus) |
| 68 | (require 'gnus-util) | 64 | (require 'gnus-util) |
diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el index 5ef91d0be7b..02a9513d07c 100644 --- a/lisp/gnus/nnrss.el +++ b/lisp/gnus/nnrss.el | |||
| @@ -24,10 +24,6 @@ | |||
| 24 | 24 | ||
| 25 | ;;; Code: | 25 | ;;; Code: |
| 26 | 26 | ||
| 27 | ;; For Emacs <22.2 and XEmacs. | ||
| 28 | (eval-and-compile | ||
| 29 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) | ||
| 30 | |||
| 31 | (eval-when-compile (require 'cl)) | 27 | (eval-when-compile (require 'cl)) |
| 32 | 28 | ||
| 33 | (require 'gnus) | 29 | (require 'gnus) |
| @@ -398,8 +394,8 @@ otherwise return nil." | |||
| 398 | nnrss-compatible-encoding-alist))))) | 394 | nnrss-compatible-encoding-alist))))) |
| 399 | (mm-coding-system-p 'utf-8))) | 395 | (mm-coding-system-p 'utf-8))) |
| 400 | 396 | ||
| 401 | (declare-function w3-parse-buffer "ext:w3-parse" (&optional buff)) | 397 | (declare-function libxml-parse-html-region "xml.c" |
| 402 | 398 | (start end &optional base-url)) | |
| 403 | (defun nnrss-fetch (url &optional local) | 399 | (defun nnrss-fetch (url &optional local) |
| 404 | "Fetch URL and put it in a the expected Lisp structure." | 400 | "Fetch URL and put it in a the expected Lisp structure." |
| 405 | (mm-with-unibyte-buffer | 401 | (mm-with-unibyte-buffer |
| @@ -426,22 +422,14 @@ otherwise return nil." | |||
| 426 | (mm-enable-multibyte)))) | 422 | (mm-enable-multibyte)))) |
| 427 | (goto-char (point-min)) | 423 | (goto-char (point-min)) |
| 428 | 424 | ||
| 429 | ;; Because xml-parse-region can't deal with anything that isn't | ||
| 430 | ;; xml and w3-parse-buffer can't deal with some xml, we have to | ||
| 431 | ;; parse with xml-parse-region first and, if that fails, parse | ||
| 432 | ;; with w3-parse-buffer. Yuck. Eventually, someone should find out | ||
| 433 | ;; why w3-parse-buffer fails to parse some well-formed xml and | ||
| 434 | ;; fix it. | ||
| 435 | |||
| 436 | (condition-case err1 | 425 | (condition-case err1 |
| 437 | (setq xmlform (xml-parse-region (point-min) (point-max))) | 426 | (setq xmlform (xml-parse-region (point-min) (point-max))) |
| 438 | (error | 427 | (error |
| 439 | (condition-case err2 | 428 | (condition-case err2 |
| 440 | (setq htmlform (caddar (w3-parse-buffer | 429 | (setq htmlform (libxml-parse-html-region (point-min) (point-max))) |
| 441 | (current-buffer)))) | ||
| 442 | (error | 430 | (error |
| 443 | (message "\ | 431 | (message "\ |
| 444 | nnrss: %s: Not valid XML %s and w3-parse doesn't work %s" | 432 | nnrss: %s: Not valid XML %s and libxml-parse-html-region doesn't work %s" |
| 445 | url err1 err2))))) | 433 | url err1 err2))))) |
| 446 | (if htmlform | 434 | (if htmlform |
| 447 | htmlform | 435 | htmlform |
| @@ -599,7 +587,7 @@ which RSS 2.0 allows." | |||
| 599 | (defun nnrss-no-cache (url) | 587 | (defun nnrss-no-cache (url) |
| 600 | "") | 588 | "") |
| 601 | 589 | ||
| 602 | (defun nnrss-insert-w3 (url) | 590 | (defun nnrss-insert (url) |
| 603 | (mm-with-unibyte-current-buffer | 591 | (mm-with-unibyte-current-buffer |
| 604 | (condition-case err | 592 | (condition-case err |
| 605 | (mm-url-insert url) | 593 | (mm-url-insert url) |
| @@ -614,8 +602,6 @@ which RSS 2.0 allows." | |||
| 614 | (mm-url-decode-entities-nbsp) | 602 | (mm-url-decode-entities-nbsp) |
| 615 | (buffer-string)))) | 603 | (buffer-string)))) |
| 616 | 604 | ||
| 617 | (defalias 'nnrss-insert 'nnrss-insert-w3) | ||
| 618 | |||
| 619 | (defun nnrss-mime-encode-string (string) | 605 | (defun nnrss-mime-encode-string (string) |
| 620 | (mm-with-multibyte-buffer | 606 | (mm-with-multibyte-buffer |
| 621 | (insert string) | 607 | (insert string) |
| @@ -880,8 +866,7 @@ Careful with this on large documents!" | |||
| 880 | 866 | ||
| 881 | (defun nnrss-extract-hrefs (data) | 867 | (defun nnrss-extract-hrefs (data) |
| 882 | "Recursively extract hrefs from a page's source. | 868 | "Recursively extract hrefs from a page's source. |
| 883 | DATA should be the output of `xml-parse-region' or | 869 | DATA should be the output of `xml-parse-region'." |
| 884 | `w3-parse-buffer'." | ||
| 885 | (mapcar (lambda (ahref) | 870 | (mapcar (lambda (ahref) |
| 886 | (cdr (assoc 'href (cadr ahref)))) | 871 | (cdr (assoc 'href (cadr ahref)))) |
| 887 | (nnrss-find-el 'a data))) | 872 | (nnrss-find-el 'a data))) |
diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el index 5ef13984abc..6035162d294 100644 --- a/lisp/gnus/nntp.el +++ b/lisp/gnus/nntp.el | |||
| @@ -25,9 +25,7 @@ | |||
| 25 | 25 | ||
| 26 | ;;; Code: | 26 | ;;; Code: |
| 27 | 27 | ||
| 28 | ;; For Emacs <22.2 and XEmacs. | ||
| 29 | (eval-and-compile | 28 | (eval-and-compile |
| 30 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))) | ||
| 31 | ;; In Emacs 24, `open-protocol-stream' is an autoloaded alias for | 29 | ;; In Emacs 24, `open-protocol-stream' is an autoloaded alias for |
| 32 | ;; `make-network-stream'. | 30 | ;; `make-network-stream'. |
| 33 | (unless (fboundp 'open-protocol-stream) | 31 | (unless (fboundp 'open-protocol-stream) |
diff --git a/lisp/gnus/nnweb.el b/lisp/gnus/nnweb.el index 3fb35b2278d..e909372e8a7 100644 --- a/lisp/gnus/nnweb.el +++ b/lisp/gnus/nnweb.el | |||
| @@ -22,8 +22,6 @@ | |||
| 22 | 22 | ||
| 23 | ;;; Commentary: | 23 | ;;; Commentary: |
| 24 | 24 | ||
| 25 | ;; Note: You need to have `w3' installed for some functions to work. | ||
| 26 | |||
| 27 | ;;; Code: | 25 | ;;; Code: |
| 28 | 26 | ||
| 29 | (eval-when-compile (require 'cl)) | 27 | (eval-when-compile (require 'cl)) |
| @@ -38,7 +36,6 @@ | |||
| 38 | (eval-and-compile | 36 | (eval-and-compile |
| 39 | (ignore-errors | 37 | (ignore-errors |
| 40 | (require 'url))) | 38 | (require 'url))) |
| 41 | (autoload 'w3-parse-buffer "w3-parse") | ||
| 42 | 39 | ||
| 43 | (nnoo-declare nnweb) | 40 | (nnoo-declare nnweb) |
| 44 | 41 | ||
| @@ -527,7 +524,7 @@ Valid types include `google', `dejanews', and `gmane'.") | |||
| 527 | url)) | 524 | url)) |
| 528 | 525 | ||
| 529 | ;;; | 526 | ;;; |
| 530 | ;;; General web/w3 interface utility functions | 527 | ;;; General web interface utility functions |
| 531 | ;;; | 528 | ;;; |
| 532 | 529 | ||
| 533 | (defun nnweb-insert-html (parse) | 530 | (defun nnweb-insert-html (parse) |
diff --git a/lisp/gnus/rfc1843.el b/lisp/gnus/rfc1843.el index 09c2b723eb7..74e8f12fc30 100644 --- a/lisp/gnus/rfc1843.el +++ b/lisp/gnus/rfc1843.el | |||
| @@ -31,10 +31,6 @@ | |||
| 31 | 31 | ||
| 32 | ;;; Code: | 32 | ;;; Code: |
| 33 | 33 | ||
| 34 | ;; For Emacs <22.2 and XEmacs. | ||
| 35 | (eval-and-compile | ||
| 36 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) | ||
| 37 | |||
| 38 | (eval-when-compile (require 'cl)) | 34 | (eval-when-compile (require 'cl)) |
| 39 | (require 'mm-util) | 35 | (require 'mm-util) |
| 40 | 36 | ||
diff --git a/lisp/gnus/sieve-manage.el b/lisp/gnus/sieve-manage.el index fd97c7d595b..62d185e2857 100644 --- a/lisp/gnus/sieve-manage.el +++ b/lisp/gnus/sieve-manage.el | |||
| @@ -71,10 +71,6 @@ | |||
| 71 | 71 | ||
| 72 | ;;; Code: | 72 | ;;; Code: |
| 73 | 73 | ||
| 74 | ;; For Emacs <22.2 and XEmacs. | ||
| 75 | (eval-and-compile | ||
| 76 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) | ||
| 77 | |||
| 78 | (if (locate-library "password-cache") | 74 | (if (locate-library "password-cache") |
| 79 | (require 'password-cache) | 75 | (require 'password-cache) |
| 80 | (require 'password)) | 76 | (require 'password)) |
diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el index 4a763caba8e..bcebe3ddc38 100644 --- a/lisp/gnus/smime.el +++ b/lisp/gnus/smime.el | |||
| @@ -118,9 +118,6 @@ | |||
| 118 | 118 | ||
| 119 | ;;; Code: | 119 | ;;; Code: |
| 120 | 120 | ||
| 121 | ;; For Emacs <22.2 and XEmacs. | ||
| 122 | (eval-and-compile | ||
| 123 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) | ||
| 124 | (require 'dig) | 121 | (require 'dig) |
| 125 | 122 | ||
| 126 | (if (locate-library "password-cache") | 123 | (if (locate-library "password-cache") |
diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el index 82f98c4294f..664ac53a76f 100644 --- a/lisp/gnus/spam.el +++ b/lisp/gnus/spam.el | |||
| @@ -38,10 +38,6 @@ | |||
| 38 | 38 | ||
| 39 | ;;{{{ compilation directives and autoloads/requires | 39 | ;;{{{ compilation directives and autoloads/requires |
| 40 | 40 | ||
| 41 | ;; For Emacs <22.2 and XEmacs. | ||
| 42 | (eval-and-compile | ||
| 43 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) | ||
| 44 | |||
| 45 | (eval-when-compile (require 'cl)) | 41 | (eval-when-compile (require 'cl)) |
| 46 | 42 | ||
| 47 | (require 'message) ;for the message-fetch-field functions | 43 | (require 'message) ;for the message-fetch-field functions |