[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] trunk r116864: Merge from Gnus git master
|
From: |
Katsumi Yamaoka |
|
Subject: |
[Emacs-diffs] trunk r116864: Merge from Gnus git master |
|
Date: |
Sun, 23 Mar 2014 23:13:46 +0000 |
|
User-agent: |
Bazaar (2.6b2) |
------------------------------------------------------------
revno: 116864
revision-id: address@hidden
parent: address@hidden
author: Gnus developers <address@hidden>
committer: Katsumi Yamaoka <address@hidden>
branch nick: trunk
timestamp: Sun 2014-03-23 23:13:36 +0000
message:
Merge from Gnus git master
2014-03-14 Katsumi Yamaoka <address@hidden>
* gnus-sum.el (gnus-summary-toggle-header): Display header attachment
buttons when toggling the header off.
2014-03-07 Daiki Ueno <address@hidden>
* 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 <address@hidden>
* 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 <address@hidden>
* message.el (message-make-html-message-with-image-files): New command.
2014-03-05 Lars Ingebrigtsen <address@hidden>
* mml.el (mml-insert-mime-headers): Allow `recipient-filename'.
2014-02-23 David Engster <address@hidden>
* 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 <address@hidden>
* 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 <address@hidden>
* 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 <address@hidden>
* 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 <address@hidden>
* 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 <address@hidden>
* 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 <address@hidden>
* 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 <address@hidden>
* 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 <address@hidden>
* gnus-mlspl.el (gnus-group-split-fancy): Use `gnus-parameters' in
`gnus-group-split-fancy'.
2014-02-01 Lars Ingebrigtsen <address@hidden>
* message.el (message-remove-header): Doc fix.
(message-forward-included-headers): New variable.
(message-remove-ignored-headers): Use it.
2014-01-31 Dave Abrahams <address@hidden>
* gnus-sum.el (gnus-summary-open-group-with-article): New command.
2013-09-04 Rasmus Pank Roulund <address@hidden>
* 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 <address@hidden>
* 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.
removed:
lisp/gnus/gnus-setup.el
gnussetup.el-20091113204419-o5vbwnq5f7feedwu-1132
modified:
lisp/gnus/ChangeLog changelog-20091113204419-o5vbwnq5f7feedwu-1433
lisp/gnus/auth-source.el
authsource.el-20091113204419-o5vbwnq5f7feedwu-8608
lisp/gnus/gmm-utils.el
gmmutils.el-20091113204419-o5vbwnq5f7feedwu-4409
lisp/gnus/gnus-art.el gnusart.el-20091113204419-o5vbwnq5f7feedwu-1108
lisp/gnus/gnus-cache.el
gnuscache.el-20091113204419-o5vbwnq5f7feedwu-1112
lisp/gnus/gnus-fun.el gnusfun.el-20091113204419-o5vbwnq5f7feedwu-3243
lisp/gnus/gnus-group.el
gnusgroup.el-20091113204419-o5vbwnq5f7feedwu-1120
lisp/gnus/gnus-html.el gnushtml.el-20100830061315-kvhf6jd956enbbtd-1
lisp/gnus/gnus-mlspl.el
gnusmlspl.el-20091113204419-o5vbwnq5f7feedwu-1963
lisp/gnus/gnus-notifications.el
gnusnotifications.el-20120829220324-f9etfvwergf24vaj-1
lisp/gnus/gnus-picon.el
gnuspicon.el-20091113204419-o5vbwnq5f7feedwu-3244
lisp/gnus/gnus-spec.el
gnusspec.el-20091113204419-o5vbwnq5f7feedwu-1134
lisp/gnus/gnus-srvr.el
gnussrvr.el-20091113204419-o5vbwnq5f7feedwu-1135
lisp/gnus/gnus-start.el
gnusstart.el-20091113204419-o5vbwnq5f7feedwu-1136
lisp/gnus/gnus-sum.el gnussum.el-20091113204419-o5vbwnq5f7feedwu-1137
lisp/gnus/gnus-util.el
gnusutil.el-20091113204419-o5vbwnq5f7feedwu-1140
lisp/gnus/gnus.el gnus.el-20091113204419-o5vbwnq5f7feedwu-1144
lisp/gnus/gravatar.el gravatar.el-20100924223300-9o5d8dejx649jxij-2
lisp/gnus/mail-source.el
mailsource.el-20091113204419-o5vbwnq5f7feedwu-1968
lisp/gnus/mailcap.el mailcap.el-20091113204419-o5vbwnq5f7feedwu-1969
lisp/gnus/message.el message.el-20091113204419-o5vbwnq5f7feedwu-1145
lisp/gnus/mm-bodies.el
mmbodies.el-20091113204419-o5vbwnq5f7feedwu-1970
lisp/gnus/mm-decode.el
mmdecode.el-20091113204419-o5vbwnq5f7feedwu-1971
lisp/gnus/mm-extern.el
mmextern.el-20091113204419-o5vbwnq5f7feedwu-3256
lisp/gnus/mm-url.el mmurl.el-20091113204419-o5vbwnq5f7feedwu-3257
lisp/gnus/mm-util.el mmutil.el-20091113204419-o5vbwnq5f7feedwu-1974
lisp/gnus/mm-view.el mmview.el-20091113204419-o5vbwnq5f7feedwu-1976
lisp/gnus/mml-smime.el
mmlsmime.el-20091113204419-o5vbwnq5f7feedwu-3259
lisp/gnus/mml.el mml.el-20091113204419-o5vbwnq5f7feedwu-1977
lisp/gnus/mml1991.el mml1991.el-20091113204419-o5vbwnq5f7feedwu-3260
lisp/gnus/mml2015.el mml2015.el-20091113204419-o5vbwnq5f7feedwu-3261
lisp/gnus/nndraft.el nndraft.el-20091113204419-o5vbwnq5f7feedwu-1150
lisp/gnus/nnfolder.el
nnfolder.el-20091113204419-o5vbwnq5f7feedwu-1152
lisp/gnus/nnheader.el
nnheader.el-20091113204419-o5vbwnq5f7feedwu-1154
lisp/gnus/nnimap.el nnimap.el-20091113204419-o5vbwnq5f7feedwu-1978
lisp/gnus/nnir.el nnir.el-20091113204419-o5vbwnq5f7feedwu-8675
lisp/gnus/nnmail.el nnmail.el-20091113204419-o5vbwnq5f7feedwu-1156
lisp/gnus/nnmaildir.el
nnmaildir.el-20091113204419-o5vbwnq5f7feedwu-3264
lisp/gnus/nnrss.el nnrss.el-20091113204419-o5vbwnq5f7feedwu-3266
lisp/gnus/nntp.el nntp.el-20091113204419-o5vbwnq5f7feedwu-1163
lisp/gnus/nnweb.el nnweb.el-20091113204419-o5vbwnq5f7feedwu-1165
lisp/gnus/rfc1843.el rfc1843.el-20091113204419-o5vbwnq5f7feedwu-1983
lisp/gnus/sieve-manage.el
sievemanage.el-20091113204419-o5vbwnq5f7feedwu-3281
lisp/gnus/smime.el smime.el-20091113204419-o5vbwnq5f7feedwu-3286
lisp/gnus/spam.el spam.el-20091113204419-o5vbwnq5f7feedwu-3289
=== modified file 'lisp/gnus/ChangeLog'
--- a/lisp/gnus/ChangeLog 2014-03-07 17:21:35 +0000
+++ b/lisp/gnus/ChangeLog 2014-03-23 23:13:36 +0000
@@ -1,3 +1,139 @@
+2014-03-23 Katsumi Yamaoka <address@hidden>
+
+ * gnus-sum.el (gnus-summary-toggle-header): Display header attachment
+ buttons when toggling the header off.
+
+2014-03-23 Daiki Ueno <address@hidden>
+
+ * mml2015.el (mml2015-use): Don't check the availability of GnuPG
+ commands here; instead, only check if epg-config.el is available.
+
+2014-03-23 Lars Ingebrigtsen <address@hidden>
+
+ * 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-23 Lars Ingebrigtsen <address@hidden>
+
+ * message.el (message-make-html-message-with-image-files): New command.
+
+2014-03-23 Lars Ingebrigtsen <address@hidden>
+
+ * mml.el (mml-insert-mime-headers): Allow `recipient-filename'.
+
+2014-03-23 David Engster <address@hidden>
+
+ * 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-03-23 Katsumi Yamaoka <address@hidden>
+
+ * 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-03-23 Katsumi Yamaoka <address@hidden>
+
+ * gnus-art.el (gnus-article-goto-part): Find a button in the body first.
+ (gnus-mime-buttonize-attachments-in-header): Number hidden buttons.
+
+2014-03-23 Katsumi Yamaoka <address@hidden>
+
+ * 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-03-23 Lars Ingebrigtsen <address@hidden>
+
+ * gnus-srvr.el (gnus-server-toggle-cloud-server): New command and
+ keystroke.
+ (gnus-server-toggle-cloud-server): Only allow clouding applicable
+ types.
+
+2014-03-23 Katsumi Yamaoka <address@hidden>
+
+ * 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-03-23 Lars Ingebrigtsen <address@hidden>
+
+ * nnimap.el (nnimap-request-articles): New command to download several
+ articles at once.
+
+ * gnus.el (gnus-variable-list): Save Cloud variables.
+
+2014-03-23 Lars Ingebrigtsen <address@hidden>
+
+ * 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-03-23 Daniel Dehennin <address@hidden>
+
+ * gnus-mlspl.el (gnus-group-split-fancy): Use `gnus-parameters' in
+ `gnus-group-split-fancy'.
+
+2014-03-23 Lars Ingebrigtsen <address@hidden>
+
+ * message.el (message-remove-header): Doc fix.
+ (message-forward-included-headers): New variable.
+ (message-remove-ignored-headers): Use it.
+
+2014-03-23 Dave Abrahams <address@hidden>
+
+ * gnus-sum.el (gnus-summary-open-group-with-article): New command.
+
+2014-03-23 Rasmus Pank Roulund <address@hidden>
+
+ * 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-03-23 Lars Ingebrigtsen <address@hidden>
+
+ * 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.
+
2014-03-07 Lars Ingebrigtsen <address@hidden>
* nnimap.el (nnimap-request-accept-article): Make respooling to nnimap
=== modified file 'lisp/gnus/auth-source.el'
--- a/lisp/gnus/auth-source.el 2014-02-23 02:46:12 +0000
+++ b/lisp/gnus/auth-source.el 2014-03-23 23:13:36 +0000
@@ -1524,10 +1524,10 @@
(heads (if (stringp value)
(list (list key value))
(mapcar (lambda (v) (list key v)) value))))
- (cl-loop
+ (loop
for h in heads
nconc
- (cl-loop
+ (loop
for tl in tails
collect (append h tl))))))
=== modified file 'lisp/gnus/gmm-utils.el'
--- a/lisp/gnus/gmm-utils.el 2014-01-08 19:16:10 +0000
+++ b/lisp/gnus/gmm-utils.el 2014-03-23 23:13:36 +0000
@@ -441,6 +441,7 @@
`(,(progn (require 'cl) (if (fboundp 'cl-labels) 'cl-labels 'labels))
,bindings ,@body))
(put 'gmm-labels 'lisp-indent-function 1)
+(put 'gmm-labels 'edebug-form-spec '((&rest (sexp sexp &rest form)) &rest
form))
(provide 'gmm-utils)
=== modified file 'lisp/gnus/gnus-art.el'
--- a/lisp/gnus/gnus-art.el 2014-01-31 01:56:00 +0000
+++ b/lisp/gnus/gnus-art.el 2014-03-23 23:13:36 +0000
@@ -24,9 +24,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
(eval-when-compile
(require 'cl))
(defvar tool-bar-map)
@@ -4728,7 +4725,10 @@
gnus-article-image-alist nil)
(gnus-run-hooks 'gnus-tmp-internal-hook)
(when gnus-display-mime-function
- (funcall gnus-display-mime-function))))
+ (funcall gnus-display-mime-function))
+ ;; Add attachment buttons to the header.
+ (when gnus-mime-display-attachment-buttons-in-header
+ (gnus-mime-buttonize-attachments-in-header))))
;;;
;;; Gnus Sticky Article Mode
@@ -5331,7 +5331,7 @@
(mm-read-coding-system "Charset: "))))
((mm-handle-undisplayer handle)
(mm-remove-part handle)))
- (forward-line 2)
+ (forward-line 1)
(mm-display-inline handle)
(goto-char b)))))
@@ -5656,33 +5656,32 @@
(if (mm-handle-displayed-p handle)
;; This will remove the part.
(mm-display-part handle)
- (save-restriction
- (narrow-to-region (point)
- (if (eobp) (point) (1+ (point))))
- (gnus-bind-safe-url-regexp (mm-display-part handle))
- ;; We narrow to the part itself and
- ;; then call the treatment functions.
- (goto-char (point-min))
- (forward-line 1)
- (narrow-to-region (point) (point-max))
- (gnus-treat-article
- nil id
- (gnus-article-mime-total-parts)
- (mm-handle-media-type handle)))))
+ (save-window-excursion
+ (save-restriction
+ (narrow-to-region (point)
+ (if (eobp) (point) (1+ (point))))
+ (gnus-bind-safe-url-regexp (mm-display-part handle))
+ ;; We narrow to the part itself and
+ ;; then call the treatment functions.
+ (goto-char (point-min))
+ (forward-line 1)
+ (narrow-to-region (point) (point-max))
+ (gnus-treat-article
+ nil id
+ (gnus-article-mime-total-parts)
+ (mm-handle-media-type handle))))))
(if (window-live-p window)
- (select-window window)))))
- (goto-char point)
- (gnus-delete-line)
- (gnus-insert-mime-button
- handle id (list (mm-handle-displayed-p handle)))
- (goto-char point))))
+ (select-window window))))))))
(defun gnus-article-goto-part (n)
"Go to MIME part N."
(when gnus-break-pages
(widen))
+ (article-goto-body)
(prog1
- (let ((start (text-property-any (point-min) (point-max) 'gnus-part n))
+ (let ((start (or (text-property-any (point) (point-max) 'gnus-part n)
+ ;; There may be header buttons.
+ (text-property-any (point-min) (point) 'gnus-part n)))
part handle end next handles)
(when start
(goto-char start)
@@ -5736,8 +5735,6 @@
(concat "; " gnus-tmp-name))))
(unless (equal gnus-tmp-description "")
(setq gnus-tmp-type-long (concat " --- " gnus-tmp-type-long)))
- (unless (bolp)
- (insert "\n"))
(setq b (point))
(gnus-eval-format
gnus-mime-button-line-format gnus-mime-button-line-format-alist
@@ -5862,6 +5859,16 @@
:group 'gnus-article-mime
:type 'boolean)
+(defcustom gnus-mime-display-attachment-buttons-in-header t
+ "Add attachment buttons in the end of the header of an article.
+Since MIME attachments tend to be put at the end of an article, we may
+overlook them if there is a huge body. This option offers you a copy
+of all non-inlinable MIME parts as buttons shown in front of an article.
+If nil, don't show those extra buttons."
+ :version "24.5"
+ :group 'gnus-article
+ :type 'boolean)
+
(defun gnus-mime-display-part (handle)
(cond
;; Maybe a broken MIME message.
@@ -5884,14 +5891,6 @@
((and (equal (car handle) "multipart/related")
(not (or gnus-mime-display-multipart-as-mixed
gnus-mime-display-multipart-related-as-mixed)))
- ;;;!!!We should find the start part, but we just default
- ;;;!!!to the first part.
- ;;(gnus-mime-display-part (cadr handle))
- ;;;!!! Most multipart/related is an HTML message plus images.
- ;;;!!! Unfortunately we are unable to let W3 display those
- ;;;!!! included images, so we just display it as a mixed multipart.
- ;;(gnus-mime-display-mixed (cdr handle))
- ;;;!!! No, w3 can display everything just fine.
(gnus-mime-display-part (cadr handle)))
((equal (car handle) "multipart/signed")
(gnus-add-wash-type 'signed)
@@ -6110,7 +6109,10 @@
(goto-char (point-max))
(setcdr begend (point-marker)))))
(when ibegend
- (goto-char point))))
+ (goto-char point)))
+ ;; Redraw attachment buttons in the header.
+ (when gnus-mime-display-attachment-buttons-in-header
+ (gnus-mime-buttonize-attachments-in-header)))
(defconst gnus-article-wash-status-strings
(let ((alist '((cite "c" "Possible hidden citation text"
@@ -6216,6 +6218,104 @@
(when image
(gnus-add-image 'shr image))))
+(defun gnus-mime-buttonize-attachments-in-header (&optional interactive)
+ "Show attachments as buttons in the end of the header of an article.
+This function toggles the display when called interactively. Note that
+buttons to be added to the header are only the ones that aren't inlined
+in the body. Use `gnus-header-face-alist' to highlight buttons."
+ (interactive (list t))
+ (gnus-with-article-buffer
+ (gmm-labels
+ ;; Function that returns a flattened version of
+ ;; `gnus-article-mime-handle-alist'.
+ ((flattened-alist
+ (&optional alist id all)
+ (if alist
+ (let ((i 1) newid flat)
+ (dolist (handle alist flat)
+ (setq newid (append id (list i))
+ i (1+ i))
+ (if (stringp (car handle))
+ (setq flat (nconc flat (flattened-alist (cdr handle)
+ newid all)))
+ (delq (rassq handle all) all)
+ (setq flat (nconc flat (list (cons newid handle)))))))
+ (let ((flat (list nil)))
+ ;; Assume that elements of `gnus-article-mime-handle-alist'
+ ;; are in the decreasing order, but unnumbered subsidiaries
+ ;; in each element are in the increasing order.
+ (dolist (handle (reverse gnus-article-mime-handle-alist))
+ (if (stringp (cadr handle))
+ (setq flat (nconc flat (flattened-alist (cddr handle)
+ (list (car handle))
+ flat)))
+ (delq (rassq (cdr handle) flat) flat)
+ (setq flat (nconc flat (list (cons (list (car handle))
+ (cdr handle)))))))
+ (setq flat (cdr flat))
+ (mapc (lambda (handle)
+ (if (cdar handle)
+ ;; This is a hidden (i.e. unnumbered) handle.
+ (progn
+ (setcar handle
+ (1+ (caar gnus-article-mime-handle-alist)))
+ (push handle gnus-article-mime-handle-alist))
+ (setcar handle (caar handle))))
+ flat)
+ flat))))
+ (let ((case-fold-search t) buttons st)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (article-narrow-to-head)
+ ;; Header buttons exist?
+ (while (and (not buttons)
+ (re-search-forward "^attachments?:[\n ]+" nil t))
+ (when (get-char-property (match-end 0)
+ 'gnus-button-attachment-extra)
+ (setq buttons (match-beginning 0))))
+ (widen)
+ (when buttons
+ ;; Delete header buttons.
+ (delete-region buttons (if (re-search-forward "^[^ ]" nil t)
+ (match-beginning 0)
+ (point-max))))
+ (unless (and interactive buttons)
+ ;; Find buttons.
+ (setq buttons nil)
+ (dolist (handle (flattened-alist))
+ (when (and (not (stringp (cadr handle)))
+ (or (equal (car (mm-handle-disposition
+ (cdr handle)))
+ "attachment")
+ (not (and (mm-inlinable-p (cdr handle))
+ (mm-inlined-p (cdr handle))))))
+ (push handle buttons)))
+ (when buttons
+ ;; Add header buttons.
+ (article-goto-body)
+ (forward-line -1)
+ (narrow-to-region (point) (point))
+ (insert "Attachment" (if (cdr buttons) "s" "") ":")
+ (dolist (button (nreverse buttons))
+ (setq st (point))
+ (insert " ")
+ (gnus-insert-mime-button (cdr button) (car button))
+ (skip-chars-backward "\t\n ")
+ (delete-region (point) (point-max))
+ (when (> (current-column) (window-width))
+ (goto-char st)
+ (insert "\n")
+ (end-of-line)))
+ (insert "\n")
+ (dolist (ovl (gnus-overlays-in (point-min) (point)))
+ (gnus-overlay-put ovl 'gnus-button-attachment-extra t)
+ (gnus-overlay-put ovl 'face nil))
+ (let ((gnus-treatment-function-alist
+ '((gnus-treat-highlight-headers
+ gnus-article-highlight-headers))))
+ (gnus-treat-article 'head))))))))))
+
;;; Article savers.
(defun gnus-output-to-file (file-name)
=== modified file 'lisp/gnus/gnus-cache.el'
--- a/lisp/gnus/gnus-cache.el 2014-01-01 07:43:34 +0000
+++ b/lisp/gnus/gnus-cache.el 2014-03-23 23:13:36 +0000
@@ -24,10 +24,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(eval-when-compile (require 'cl))
(require 'gnus)
=== modified file 'lisp/gnus/gnus-fun.el'
--- a/lisp/gnus/gnus-fun.el 2014-01-01 07:43:34 +0000
+++ b/lisp/gnus/gnus-fun.el 2014-03-23 23:13:36 +0000
@@ -24,10 +24,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(eval-when-compile
(require 'cl))
@@ -44,6 +40,24 @@
:group 'gnus-fun
:type 'directory)
+(defcustom gnus-x-face-omit-files nil
+ "Regexp to match faces in `gnus-x-face-directory' to be omitted."
+ :version "24.5"
+ :group 'gnus-fun
+ :type 'string)
+
+(defcustom gnus-face-directory (expand-file-name "faces" gnus-directory)
+ "*Directory where Face PNG files are stored."
+ :version "24.5"
+ :group 'gnus-fun
+ :type 'directory)
+
+(defcustom gnus-face-omit-files nil
+ "Regexp to match faces in `gnus-face-directory' to be omitted."
+ :version "24.5"
+ :group 'gnus-fun
+ :type 'string)
+
(defcustom gnus-convert-pbm-to-x-face-command "pbmtoxbm %s | compface"
"Command for converting a PBM to an X-Face."
:version "22.1"
@@ -86,35 +100,57 @@
nil shell-command-switch command)))
;;;###autoload
-(defun gnus-random-x-face ()
- "Return X-Face header data chosen randomly from `gnus-x-face-directory'."
- (interactive)
- (when (file-exists-p gnus-x-face-directory)
- (let* ((files (directory-files gnus-x-face-directory t "\\.pbm$"))
- (file (nth (random (length files)) files)))
+(defun gnus--random-face-with-type (dir ext omit fun)
+ "Return file from DIR with extension EXT, omitting matches of OMIT,
processed by FUN."
+ (when (file-exists-p dir)
+ (let* ((files
+ (remove nil (mapcar
+ (lambda (f) (unless (string-match (or omit "^$") f)
f))
+ (directory-files dir t ext))))
+ (file (nth (random (length files)) files)))
(when file
- (gnus-shell-command-to-string
- (format gnus-convert-pbm-to-x-face-command
- (shell-quote-argument file)))))))
+ (funcall fun file)))))
+;;;###autoload
(autoload 'message-goto-eoh "message" nil t)
-
-;;;###autoload
-(defun gnus-insert-random-x-face-header ()
- "Insert a random X-Face header from `gnus-x-face-directory'."
- (interactive)
- (let ((data (gnus-random-x-face)))
+(autoload 'message-insert-header "message" nil t)
+
+(defun gnus--insert-random-face-with-type (fun type)
+ "Get a random face using FUN and insert it as a header TYPE.
+
+For instance, to insert an X-Face use `gnus-random-x-face' as FUN
+ and \"X-Face\" as TYPE."
+ (let ((data (funcall fun)))
(save-excursion
- (message-goto-eoh)
(if data
- (insert "X-Face: " data)
+ (progn (message-goto-eoh)
+ (insert type ": " data "\n"))
(message
- "No face returned by `gnus-random-x-face'. Does %s/*.pbm exist?"
- gnus-x-face-directory)))))
+ "No face returned by the function %s." (symbol-name fun))))))
+
+
+
+;;;###autoload
+(defun gnus-random-x-face ()
+ "Return X-Face header data chosen randomly from `gnus-x-face-directory'.
+
+Files matching `gnus-x-face-omit-files' are not considered."
+ (interactive)
+ (gnus--random-face-with-type gnus-x-face-directory "\\.pbm$"
gnus-x-face-omit-files
+ (lambda (file)
+ (gnus-shell-command-to-string
+ (format gnus-convert-pbm-to-x-face-command
+ (shell-quote-argument file))))))
+
+;;;###autoload
+(defun gnus-insert-random-x-face-header ()
+ "Insert a random X-Face header from `gnus-x-face-directory'."
+ (interactive)
+ (gnus--insert-random-face-with-type 'gnus-random-x-face 'X-Face))
;;;###autoload
(defun gnus-x-face-from-file (file)
- "Insert an X-Face header based on an image file.
+ "Insert an X-Face header based on an image FILE.
Depending on `gnus-convert-image-to-x-face-command' it may accept
different input formats."
@@ -126,7 +162,7 @@
;;;###autoload
(defun gnus-face-from-file (file)
- "Return a Face header based on an image file.
+ "Return a Face header based on an image FILE.
Depending on `gnus-convert-image-to-face-command' it may accept
different input formats."
@@ -191,6 +227,21 @@
(buffer-size)))
(gnus-face-encode)))
+;;;###autoload
+(defun gnus-random-face ()
+ "Return randomly chosen Face from `gnus-face-directory'.
+
+Files matching `gnus-face-omit-files' are not considered."
+ (interactive)
+ (gnus--random-face-with-type gnus-face-directory "\\.png$"
+ gnus-face-omit-files
+ 'gnus-convert-png-to-face))
+
+;;;###autoload
+(defun gnus-insert-random-face-header ()
+ "Insert a randome Face header from `gnus-face-directory'."
+ (gnus--insert-random-face-with-type 'gnus-random-face 'Face))
+
(defface gnus-x-face '((t (:foreground "black" :background "white")))
"Face to show X-Face.
The colors from this face are used as the foreground and background
=== modified file 'lisp/gnus/gnus-group.el'
--- a/lisp/gnus/gnus-group.el 2014-03-05 22:54:48 +0000
+++ b/lisp/gnus/gnus-group.el 2014-03-23 23:13:36 +0000
@@ -24,10 +24,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(eval-when-compile
(require 'cl))
(defvar tool-bar-mode)
=== modified file 'lisp/gnus/gnus-html.el'
--- a/lisp/gnus/gnus-html.el 2014-01-01 07:43:34 +0000
+++ b/lisp/gnus/gnus-html.el 2014-03-23 23:13:36 +0000
@@ -28,10 +28,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(eval-when-compile (require 'cl))
(require 'gnus-art)
=== modified file 'lisp/gnus/gnus-mlspl.el'
--- a/lisp/gnus/gnus-mlspl.el 2014-01-01 07:43:34 +0000
+++ b/lisp/gnus/gnus-mlspl.el 2014-03-23 23:13:36 +0000
@@ -146,20 +146,27 @@
(any \"\\\\(address@hidden|address@hidden|address@hidden)\"
- \"bugs-foo\" - \"rambling-foo\" \"mail.foo\"))
\"mail.others\")"
- (let* ((newsrc (cdr gnus-newsrc-alist))
- split)
- (dolist (info newsrc)
- (let ((group (gnus-info-group info))
- (params (gnus-info-params info)))
- ;; For all GROUPs that match the specified GROUPS
- (when (or (not groups)
- (and (listp groups)
- (memq group groups))
- (and (stringp groups)
- (string-match groups group)))
- (let ((split-spec (assoc 'split-spec params)) group-clean)
- ;; Remove backend from group name
- (setq group-clean (string-match ":" group))
+ (let ((group-names (if (and (listp groups)
+ (not (null groups)))
+ groups
+ (delete-dups
+ (delq nil
+ (mapcar
+ (lambda (info)
+ (let ((group (gnus-info-group info)))
+ (if (or (not groups)
+ (and (stringp groups)
+ (string-match groups group)))
+ group)))
+ (append gnus-newsrc-alist gnus-parameters))))))
+ split)
+ (dolist (group group-names)
+ (let ((params (gnus-group-find-parameter group)))
+ ;; Skip groups without param (or nonexistent)
+ (when (not (null params))
+ (let ((split-spec (assoc 'split-spec params)) group-clean)
+ ;; Remove backend from group name
+ (setq group-clean (string-match ":" group))
(setq group-clean
(if group-clean
(substring group (1+ group-clean))
=== modified file 'lisp/gnus/gnus-notifications.el'
--- a/lisp/gnus/gnus-notifications.el 2014-01-01 07:43:34 +0000
+++ b/lisp/gnus/gnus-notifications.el 2014-03-23 23:13:36 +0000
@@ -102,6 +102,9 @@
;; Don't return an id
t))
+(declare-function gravatar-retrieve-synchronously "gravatar.el"
+ (mail-address))
+
(defun gnus-notifications-get-photo (mail-address)
"Get photo for mail address."
(let ((google-photo (when (and gnus-notifications-use-google-contacts
=== modified file 'lisp/gnus/gnus-picon.el'
--- a/lisp/gnus/gnus-picon.el 2014-01-01 07:43:34 +0000
+++ b/lisp/gnus/gnus-picon.el 2014-03-23 23:13:36 +0000
@@ -37,10 +37,6 @@
;;
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(eval-when-compile (require 'cl))
(require 'gnus)
=== removed file 'lisp/gnus/gnus-setup.el'
--- a/lisp/gnus/gnus-setup.el 2014-01-18 20:46:53 +0000
+++ b/lisp/gnus/gnus-setup.el 1970-01-01 00:00:00 +0000
@@ -1,191 +0,0 @@
-;;; gnus-setup.el --- Initialization & Setup for Gnus 5
-
-;; Copyright (C) 1995-1996, 2000-2014 Free Software Foundation, Inc.
-
-;; Author: Steven L. Baur <address@hidden>
-;; Keywords: news
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;; My head is starting to spin with all the different mail/news packages.
-;; Stop The Madness!
-
-;; Given that Emacs Lisp byte codes may be diverging, it is probably best
-;; not to byte compile this, and just arrange to have the .el loaded out
-;; of .emacs.
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(defvar gnus-use-installed-gnus t
- "*If non-nil use installed version of Gnus.")
-
-(defvar gnus-use-installed-mailcrypt (featurep 'xemacs)
- "*If non-nil use installed version of mailcrypt.")
-
-(defvar gnus-emacs-lisp-directory (if (featurep 'xemacs)
- "/usr/local/lib/xemacs/"
- "/usr/local/share/emacs/")
- "Directory where Emacs site lisp is located.")
-
-(defvar gnus-gnus-lisp-directory (concat gnus-emacs-lisp-directory
- "gnus/lisp/")
- "Directory where Gnus Emacs lisp is found.")
-
-(defvar gnus-mailcrypt-lisp-directory (concat gnus-emacs-lisp-directory
- "site-lisp/mailcrypt/")
- "Directory where Mailcrypt Emacs Lisp is found.")
-
-(defvar gnus-bbdb-lisp-directory (concat gnus-emacs-lisp-directory
- "site-lisp/bbdb/")
- "Directory where Big Brother Database is found.")
-
-(defvar gnus-use-mhe nil
- "Set this if you want to use MH-E for mail reading.")
-(defvar gnus-use-rmail nil
- "Set this if you want to use RMAIL for mail reading.")
-(defvar gnus-use-sendmail nil
- "Set this if you want to use SENDMAIL for mail reading.")
-(defvar gnus-use-vm nil
- "Set this if you want to use the VM package for mail reading.")
-(defvar gnus-use-sc nil
- "Set this if you want to use Supercite.")
-(defvar gnus-use-mailcrypt t
- "Set this if you want to use Mailcrypt for dealing with PGP messages.")
-(defvar gnus-use-bbdb nil
- "Set this if you want to use the Big Brother DataBase.")
-
-(when (and (not gnus-use-installed-gnus)
- (null (member gnus-gnus-lisp-directory load-path)))
- (push gnus-gnus-lisp-directory load-path))
-
-;;; We can't do this until we know where Gnus is.
-(require 'message)
-
-;;; Mailcrypt by
-;;; Jin Choi <address@hidden>
-;;; Patrick LoPresti <address@hidden>
-
-(when gnus-use-mailcrypt
- (when (and (not gnus-use-installed-mailcrypt)
- (null (member gnus-mailcrypt-lisp-directory load-path)))
- (setq load-path (cons gnus-mailcrypt-lisp-directory load-path)))
- (autoload 'mc-install-write-mode "mailcrypt" nil t)
- (autoload 'mc-install-read-mode "mailcrypt" nil t)
-;;; (add-hook 'message-mode-hook 'mc-install-write-mode)
-;;; (add-hook 'gnus-summary-mode-hook 'mc-install-read-mode)
- (when gnus-use-mhe
- (add-hook 'mh-folder-mode-hook 'mc-install-read-mode)
- (add-hook 'mh-letter-mode-hook 'mc-install-write-mode)))
-
-;;; BBDB by
-;;; Jamie Zawinski <address@hidden>
-
-(when gnus-use-bbdb
- ;; bbdb will never be installed with emacs.
- (when (null (member gnus-bbdb-lisp-directory load-path))
- (setq load-path (cons gnus-bbdb-lisp-directory load-path)))
- (autoload 'bbdb "bbdb-com"
- "Insidious Big Brother Database" t)
- (autoload 'bbdb-name "bbdb-com"
- "Insidious Big Brother Database" t)
- (autoload 'bbdb-company "bbdb-com"
- "Insidious Big Brother Database" t)
- (autoload 'bbdb-net "bbdb-com"
- "Insidious Big Brother Database" t)
- (autoload 'bbdb-notes "bbdb-com"
- "Insidious Big Brother Database" t)
-
- (when gnus-use-vm
- (autoload 'bbdb-insinuate-vm "bbdb-vm"
- "Hook BBDB into VM" t))
-
- (when gnus-use-rmail
- (autoload 'bbdb-insinuate-rmail "bbdb-rmail"
- "Hook BBDB into RMAIL" t)
- (add-hook 'rmail-mode-hook 'bbdb-insinuate-rmail))
-
- (when gnus-use-mhe
- (autoload 'bbdb-insinuate-mh "bbdb-mh"
- "Hook BBDB into MH-E" t)
- (add-hook 'mh-folder-mode-hook 'bbdb-insinuate-mh))
-
- (autoload 'bbdb-insinuate-gnus "bbdb-gnus"
- "Hook BBDB into Gnus" t)
- (add-hook 'gnus-startup-hook 'bbdb-insinuate-gnus)
-
- (when gnus-use-sendmail
- (autoload 'bbdb-insinuate-sendmail "bbdb"
- "Insidious Big Brother Database" t)
- (add-hook 'mail-setup-hook 'bbdb-insinuate-sendmail)
- (add-hook 'message-setup-hook 'bbdb-insinuate-sendmail)))
-
-(when gnus-use-sc
- (add-hook 'mail-citation-hook 'sc-cite-original)
- (setq message-cite-function 'sc-cite-original))
-
-;;;### (autoloads (gnus gnus-slave gnus-no-server) "gnus" "lisp/gnus.el"
(12473 2137))
-;;; Generated autoloads from lisp/gnus.el
-
-;; Don't redo this if autoloads already exist
-(unless (fboundp 'gnus)
- (autoload 'gnus-slave-no-server "gnus" "\
-Read network news as a slave without connecting to local server." t nil)
-
- (autoload 'gnus-no-server "gnus" "\
-Read network news.
-If ARG is a positive number, Gnus will use that as the
-startup level. If ARG is nil, Gnus will be started at level 2.
-If ARG is non-nil and not a positive number, Gnus will
-prompt the user for the name of an NNTP server to use.
-As opposed to `gnus', this command will not connect to the local server." t
nil)
-
- (autoload 'gnus-slave "gnus" "\
-Read news as a slave." t nil)
-
- (autoload 'gnus "gnus" "\
-Read network news.
-If ARG is non-nil and a positive number, Gnus will use that as the
-startup level. If ARG is non-nil and not a positive number, Gnus will
-prompt the user for the name of an NNTP server to use." t nil)
-
-;;;***
-
-;;; These have moved out of gnus.el into other files.
-;;; FIX FIX FIX: should other things be in gnus-setup? or these not in it?
- (autoload 'gnus-update-format "gnus-spec" "\
-Update the format specification near point." t nil)
-
- (autoload 'gnus-fetch-group "gnus-group" "\
-Start Gnus if necessary and enter GROUP.
-Returns whether the fetching was successful or not." t nil)
-
- (defalias 'gnus-batch-kill 'gnus-batch-score)
-
- (autoload 'gnus-batch-score "gnus-kill" "\
-Run batched scoring.
-Usage: emacs -batch -l gnus -f gnus-batch-score <newsgroups> ...
-Newsgroups is a list of strings in Bnews format. If you want to score
-the comp hierarchy, you'd say \"comp.all\". If you would not like to
-score the alt hierarchy, you'd say \"!alt.all\"." t nil))
-
-(provide 'gnus-setup)
-
-(run-hooks 'gnus-setup-load-hook)
-
-;;; gnus-setup.el ends here
=== modified file 'lisp/gnus/gnus-spec.el'
--- a/lisp/gnus/gnus-spec.el 2014-01-01 07:43:34 +0000
+++ b/lisp/gnus/gnus-spec.el 2014-03-23 23:13:36 +0000
@@ -24,9 +24,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
(eval-when-compile (require 'cl))
(defvar gnus-newsrc-file-version)
=== modified file 'lisp/gnus/gnus-srvr.el'
--- a/lisp/gnus/gnus-srvr.el 2014-01-01 07:43:34 +0000
+++ b/lisp/gnus/gnus-srvr.el 2014-03-23 23:13:36 +0000
@@ -45,7 +45,7 @@
:group 'gnus-server
:type 'hook)
-(defcustom gnus-server-line-format " {%(%h:%w%)} %s%a\n"
+(defcustom gnus-server-line-format " {%(%h:%w%)} %s%a%c\n"
"Format of server lines.
It works along the same lines as a normal formatting string,
with some simple extensions.
@@ -85,7 +85,8 @@
(?n gnus-tmp-name ?s)
(?w gnus-tmp-where ?s)
(?s gnus-tmp-status ?s)
- (?a gnus-tmp-agent ?s)))
+ (?a gnus-tmp-agent ?s)
+ (?c gnus-tmp-cloud ?s)))
(defvar gnus-server-mode-line-format-alist
`((?S gnus-tmp-news-server ?s)
@@ -127,6 +128,7 @@
["Close" gnus-server-close-server t]
["Offline" gnus-server-offline-server t]
["Deny" gnus-server-deny-server t]
+ ["Toggle Cloud" gnus-server-toggle-cloud-server t]
"---"
["Open All" gnus-server-open-all-servers t]
["Close All" gnus-server-close-all-servers t]
@@ -172,6 +174,8 @@
"z" gnus-server-compact-server
+ "i" gnus-server-toggle-cloud-server
+
"\C-c\C-i" gnus-info-find-node
"\C-c\C-b" gnus-bug))
@@ -185,6 +189,13 @@
(put 'gnus-server-agent-face 'face-alias 'gnus-server-agent)
(put 'gnus-server-agent-face 'obsolete-face "22.1")
+(defface gnus-server-cloud
+ '((((class color) (background light)) (:foreground "ForestGreen" :bold t))
+ (((class color) (background dark)) (:foreground "PaleGreen" :bold t))
+ (t (:bold t)))
+ "Face used for displaying AGENTIZED servers"
+ :group 'gnus-server-visual)
+
(defface gnus-server-opened
'((((class color) (background light)) (:foreground "Green3" :bold t))
(((class color) (background dark)) (:foreground "Green1" :bold t))
@@ -228,6 +239,7 @@
(defvar gnus-server-font-lock-keywords
'(("(\\(agent\\))" 1 'gnus-server-agent)
+ ("(\\(cloud\\))" 1 'gnus-server-cloud)
("(\\(opened\\))" 1 'gnus-server-opened)
("(\\(closed\\))" 1 'gnus-server-closed)
("(\\(offline\\))" 1 'gnus-server-offline)
@@ -282,6 +294,9 @@
(gnus-tmp-agent (if (and gnus-agent
(gnus-agent-method-p method))
" (agent)"
+ ""))
+ (gnus-tmp-cloud (if (gnus-cloud-server-p gnus-tmp-name)
+ " (cloud)"
"")))
(beginning-of-line)
(gnus-add-text-properties
@@ -1084,6 +1099,27 @@
(let ((original (get-buffer gnus-original-article-buffer)))
(and original (gnus-kill-buffer original))))))
+(defun gnus-server-toggle-cloud-server ()
+ "Make the server under point be replicated in the Emacs Cloud."
+ (interactive)
+ (let ((server (gnus-server-server-name)))
+ (unless server
+ (error "No server on the current line"))
+
+ (unless (gnus-method-option-p server 'cloud)
+ (error "The server under point doesn't support cloudiness"))
+
+ (if (gnus-cloud-server-p server)
+ (setq gnus-cloud-covered-servers
+ (delete server gnus-cloud-covered-servers))
+ (push server gnus-cloud-covered-servers))
+
+ (gnus-server-update-server server)
+ (gnus-message 1 (if (gnus-cloud-server-p server)
+ "Replication of %s in the cloud will start"
+ "Replication of %s in the cloud will stop")
+ server)))
+
(provide 'gnus-srvr)
;;; gnus-srvr.el ends here
=== modified file 'lisp/gnus/gnus-start.el'
--- a/lisp/gnus/gnus-start.el 2014-01-01 07:43:34 +0000
+++ b/lisp/gnus/gnus-start.el 2014-03-23 23:13:36 +0000
@@ -30,6 +30,7 @@
(require 'gnus-spec)
(require 'gnus-range)
(require 'gnus-util)
+(require 'gnus-cloud)
(autoload 'message-make-date "message")
(autoload 'gnus-agent-read-servers-validate "gnus-agent")
(autoload 'gnus-agent-save-local "gnus-agent")
=== modified file 'lisp/gnus/gnus-sum.el'
--- a/lisp/gnus/gnus-sum.el 2014-01-31 01:56:00 +0000
+++ b/lisp/gnus/gnus-sum.el 2014-03-23 23:13:36 +0000
@@ -24,9 +24,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
(eval-when-compile
(require 'cl))
(eval-when-compile
@@ -2188,6 +2185,7 @@
(gnus-define-keys (gnus-summary-wash-mime-map "M" gnus-summary-wash-map)
"w" gnus-article-decode-mime-words
"c" gnus-article-decode-charset
+ "h" gnus-mime-buttonize-attachments-in-header
"v" gnus-mime-view-all-parts
"b" gnus-article-view-part)
@@ -2394,6 +2392,8 @@
["QP" gnus-article-de-quoted-unreadable t]
["Base64" gnus-article-de-base64-unreadable t]
["View MIME buttons" gnus-summary-display-buttonized t]
+ ["View MIME buttons in header"
+ gnus-mime-buttonize-attachments-in-header t]
["View all" gnus-mime-view-all-parts t]
["Verify and Decrypt" gnus-summary-force-verify-and-decrypt t]
["Encrypt body" gnus-article-encrypt-body
@@ -9085,6 +9085,41 @@
(gnus-summary-limit-include-thread id)))
(gnus-summary-show-thread))
+(defun gnus-summary-open-group-with-article (message-id)
+ "Open a group containing the article with the given MESSAGE-ID."
+ (interactive "sMessage-ID: ")
+ (require 'nndoc)
+ (with-temp-buffer
+ ;; Prepare a dummy article
+ (erase-buffer)
+ (insert "From nobody Tue Sep 13 22:05:34 2011\n\n")
+
+ ;; Prepare pretty modelines for summary and article buffers
+ (let ((gnus-summary-mode-line-format "Found %G")
+ (gnus-article-mode-line-format
+ ;; Group names just get in the way here, especially the
+ ;; abbreviated ones
+ (if (string-match "%[gG]" gnus-article-mode-line-format)
+ (concat (substring gnus-article-mode-line-format
+ 0 (match-beginning 0))
+ (substring gnus-article-mode-line-format (match-end 0)))
+ gnus-article-mode-line-format)))
+
+ ;; Build an ephemeral group containing the dummy article (hidden)
+ (gnus-group-read-ephemeral-group
+ message-id
+ `(nndoc ,message-id
+ (nndoc-address ,(current-buffer))
+ (nndoc-article-type mbox))
+ :activate
+ (cons (current-buffer) gnus-current-window-configuration)
+ (not :request-only)
+ '(-1) ; :select-articles
+ (not :parameters)
+ 0)) ; :number
+ ;; Fetch the desired article
+ (gnus-summary-refer-article message-id)))
+
(defun gnus-summary-refer-article (message-id)
"Fetch an article specified by MESSAGE-ID."
(interactive "sMessage-ID: ")
@@ -9779,7 +9814,10 @@
(gnus-treat-hide-boring-headers nil))
(gnus-delete-wash-type 'headers)
(gnus-treat-article 'head))
- (gnus-treat-article 'head))
+ (gnus-treat-article 'head)
+ ;; Add attachment buttons to the header.
+ (when gnus-mime-display-attachment-buttons-in-header
+ (gnus-mime-buttonize-attachments-in-header)))
(widen)
(if window
(set-window-start window (goto-char (point-min))))
=== modified file 'lisp/gnus/gnus-util.el'
--- a/lisp/gnus/gnus-util.el 2014-01-08 19:16:10 +0000
+++ b/lisp/gnus/gnus-util.el 2014-03-23 23:13:36 +0000
@@ -32,9 +32,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
(eval-when-compile
(require 'cl))
=== modified file 'lisp/gnus/gnus.el'
--- a/lisp/gnus/gnus.el 2014-01-01 07:43:34 +0000
+++ b/lisp/gnus/gnus.el 2014-03-23 23:13:36 +0000
@@ -29,10 +29,6 @@
(eval '(run-hooks 'gnus-load-hook))
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(eval-when-compile (require 'cl))
(require 'wid-edit)
(require 'mm-util)
@@ -309,6 +305,7 @@
(unless (featurep 'gnus-xmas)
(defalias 'gnus-make-overlay 'make-overlay)
+ (defalias 'gnus-copy-overlay 'copy-overlay)
(defalias 'gnus-delete-overlay 'delete-overlay)
(defalias 'gnus-overlay-get 'overlay-get)
(defalias 'gnus-overlay-put 'overlay-put)
@@ -316,6 +313,7 @@
(defalias 'gnus-overlay-buffer 'overlay-buffer)
(defalias 'gnus-overlay-start 'overlay-start)
(defalias 'gnus-overlay-end 'overlay-end)
+ (defalias 'gnus-overlays-at 'overlays-at)
(defalias 'gnus-overlays-in 'overlays-in)
(defalias 'gnus-extent-detached-p 'ignore)
(defalias 'gnus-extent-start-open 'ignore)
@@ -1614,7 +1612,7 @@
:type 'string)
(defcustom gnus-valid-select-methods
- '(("nntp" post address prompt-address physical-address)
+ '(("nntp" post address prompt-address physical-address cloud)
("nnspool" post address)
("nnvirtual" post-mail virtual prompt-address)
("nnmbox" mail respool address)
@@ -1631,7 +1629,7 @@
("nnrss" none global)
("nnagent" post-mail)
("nnimap" post-mail address prompt-address physical-address respool
- server-marks)
+ server-marks cloud)
("nnmaildir" mail respool address server-marks)
("nnnil" none))
"*An alist of valid select methods.
@@ -2703,7 +2701,10 @@
gnus-newsrc-last-checked-date
gnus-newsrc-alist gnus-server-alist
gnus-killed-list gnus-zombie-list
- gnus-topic-topology gnus-topic-alist)
+ gnus-topic-topology gnus-topic-alist
+ gnus-cloud-sequence
+ gnus-cloud-covered-servers
+ gnus-cloud-file-timestamps)
"Gnus variables saved in the quick startup file.")
(defvar gnus-newsrc-alist nil
=== modified file 'lisp/gnus/gravatar.el'
--- a/lisp/gnus/gravatar.el 2014-01-01 07:43:34 +0000
+++ b/lisp/gnus/gravatar.el 2014-03-23 23:13:36 +0000
@@ -138,9 +138,7 @@
"Retrieve MAIL-ADDRESS gravatar and returns it."
(let ((url (gravatar-build-url mail-address)))
(if (gravatar-cache-expired url)
- (with-current-buffer (if (featurep 'xemacs)
- (url-retrieve url)
- (url-retrieve-synchronously url))
+ (with-current-buffer (url-retrieve-synchronously url)
(when gravatar-automatic-caching
(url-store-in-cache (current-buffer)))
(let ((data (gravatar-data->image)))
=== modified file 'lisp/gnus/mail-source.el'
--- a/lisp/gnus/mail-source.el 2014-01-01 07:43:34 +0000
+++ b/lisp/gnus/mail-source.el 2014-03-23 23:13:36 +0000
@@ -24,10 +24,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(require 'format-spec)
(eval-when-compile
(require 'cl)
=== modified file 'lisp/gnus/mailcap.el'
--- a/lisp/gnus/mailcap.el 2014-01-01 07:43:34 +0000
+++ b/lisp/gnus/mailcap.el 2014-03-23 23:13:36 +0000
@@ -216,10 +216,6 @@
(test . (fboundp 'vm-mode))
(type . "message/rfc822"))
("rfc-*822"
- (viewer . w3-mode)
- (test . (fboundp 'w3-mode))
- (type . "message/rfc822"))
- ("rfc-*822"
(viewer . view-mode)
(type . "message/rfc822")))
("image"
@@ -253,10 +249,6 @@
("needsx11")))
("text"
("plain"
- (viewer . w3-mode)
- (test . (fboundp 'w3-mode))
- (type . "text/plain"))
- ("plain"
(viewer . view-mode)
(test . (fboundp 'view-mode))
(type . "text/plain"))
@@ -267,10 +259,6 @@
(viewer . enriched-decode)
(test . (fboundp 'enriched-decode))
(type . "text/enriched"))
- ("html"
- (viewer . mm-w3-prepare-buffer)
- (test . (fboundp 'w3-prepare-buffer))
- (type . "text/html"))
("dns"
(viewer . dns-mode)
(test . (fboundp 'dns-mode))
=== modified file 'lisp/gnus/message.el'
--- a/lisp/gnus/message.el 2014-02-09 04:37:38 +0000
+++ b/lisp/gnus/message.el 2014-03-23 23:13:36 +0000
@@ -28,9 +28,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
(eval-when-compile
(require 'cl))
@@ -50,6 +47,7 @@
(require 'mml)
(require 'rfc822)
(require 'format-spec)
+(require 'dired)
(autoload 'mailclient-send-it "mailclient") ;; Emacs 22 or contrib/
@@ -606,7 +604,8 @@
regexp))
(defcustom message-forward-ignored-headers
"^Content-Transfer-Encoding:\\|^X-Gnus"
- "*All headers that match this regexp will be deleted when forwarding a
message."
+ "*All headers that match this regexp will be deleted when forwarding a
message.
+This may also be a list of regexps."
:version "21.1"
:group 'message-forwarding
:type '(repeat :value-to-internal (lambda (widget value)
@@ -616,6 +615,19 @@
(widget-editable-list-match widget value)))
regexp))
+(defcustom message-forward-included-headers nil
+ "If non-nil, delete non-matching headers when forwarding a message.
+Only headers that match this regexp will be included. This
+variable should be a regexp or a list of regexps."
+ :version "24.5"
+ :group 'message-forwarding
+ :type '(repeat :value-to-internal (lambda (widget value)
+ (custom-split-regexp-maybe value))
+ :match (lambda (widget value)
+ (or (stringp value)
+ (widget-editable-list-match widget value)))
+ regexp))
+
(defcustom message-ignored-cited-headers "."
"*Delete these headers from the messages you yank."
:group 'message-insertion
@@ -2451,6 +2463,7 @@
"Remove HEADER in the narrowed buffer.
If IS-REGEXP, HEADER is a regular expression.
If FIRST, only remove the first instance of the header.
+If REVERSE, remove headers that doesn't match HEADER.
Return the number of headers removed."
(goto-char (point-min))
(let ((regexp (if is-regexp header (concat "^" (regexp-quote header) ":")))
@@ -7374,17 +7387,25 @@
(message-remove-ignored-headers b e)))
(defun message-remove-ignored-headers (b e)
- (when message-forward-ignored-headers
+ (when (or message-forward-ignored-headers
+ message-forward-included-headers)
(save-restriction
(narrow-to-region b e)
(goto-char b)
(narrow-to-region (point)
(or (search-forward "\n\n" nil t) (point)))
- (let ((ignored (if (stringp message-forward-ignored-headers)
- (list message-forward-ignored-headers)
- message-forward-ignored-headers)))
- (dolist (elem ignored)
- (message-remove-header elem t))))))
+ (when message-forward-ignored-headers
+ (let ((ignored (if (stringp message-forward-ignored-headers)
+ (list message-forward-ignored-headers)
+ message-forward-ignored-headers)))
+ (dolist (elem ignored)
+ (message-remove-header elem t))))
+ (when message-forward-included-headers
+ (message-remove-header
+ (if (listp message-forward-included-headers)
+ (regexp-opt message-forward-included-headers)
+ message-forward-included-headers)
+ t nil t)))))
(defun message-forward-make-body-mime (forward-buffer &optional beg end)
(let ((b (point)))
@@ -7432,8 +7453,7 @@
(goto-char (point-max))))
(setq e (point))
(insert "<#/mml>\n")
- (when (and (not message-forward-decoded-p)
- message-forward-ignored-headers)
+ (when (not message-forward-decoded-p)
(message-remove-ignored-headers b e))))
(defun message-forward-make-body-digest-plain (forward-buffer)
@@ -8421,6 +8441,17 @@
(message-fetch-field hdr) t))
", "))))
+;;; multipart/related and HTML support.
+
+(defun message-make-html-message-with-image-files (files)
+ (interactive (list (dired-get-marked-files nil current-prefix-arg)))
+ (message-mail)
+ (message-goto-body)
+ (insert "<#part type=text/html>\n\n")
+ (dolist (file files)
+ (insert (format "<img src=%S>\n\n" file)))
+ (message-goto-to))
+
(when (featurep 'xemacs)
(require 'messagexmas)
(message-xmas-redefine))
=== modified file 'lisp/gnus/mm-bodies.el'
--- a/lisp/gnus/mm-bodies.el 2014-01-01 07:43:34 +0000
+++ b/lisp/gnus/mm-bodies.el 2014-03-23 23:13:36 +0000
@@ -23,10 +23,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(require 'mm-util)
(require 'rfc2047)
(require 'mm-encode)
=== modified file 'lisp/gnus/mm-decode.el'
--- a/lisp/gnus/mm-decode.el 2014-01-01 07:43:34 +0000
+++ b/lisp/gnus/mm-decode.el 2014-03-23 23:13:36 +0000
@@ -23,10 +23,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(require 'mail-parse)
(require 'mm-bodies)
(eval-when-compile (require 'cl))
@@ -124,7 +120,6 @@
((executable-find "w3m") 'gnus-w3m)
((executable-find "links") 'links)
((executable-find "lynx") 'lynx)
- ((locate-library "w3") 'w3)
((locate-library "html2text") 'html2text)
(t nil))
"Render of HTML contents.
@@ -136,13 +131,11 @@
`w3m-standalone': use plain w3m;
`links': use links;
`lynx': use lynx;
-`w3': use Emacs/W3;
`html2text': use html2text;
nil : use external viewer (default web browser)."
:version "24.1"
:type '(choice (const shr)
(const gnus-w3m)
- (const w3)
(const w3m :tag "emacs-w3m")
(const w3m-standalone :tag "standalone w3m" )
(const links)
@@ -153,9 +146,9 @@
:group 'mime-display)
(defcustom mm-inline-text-html-with-images nil
- "If non-nil, Gnus will allow retrieving images in HTML contents with
-the <img> tags. It has no effect on Emacs/w3. See also the
-documentation for the `mm-w3m-safe-url-regexp' variable."
+ "If non-nil, Gnus will allow retrieving images in HTML that has <img> tags.
+See also the documentation for the `mm-w3m-safe-url-regexp'
+variable."
:version "22.1"
:type 'boolean
:group 'mime-display)
=== modified file 'lisp/gnus/mm-extern.el'
--- a/lisp/gnus/mm-extern.el 2014-01-01 07:43:34 +0000
+++ b/lisp/gnus/mm-extern.el 2014-03-23 23:13:36 +0000
@@ -24,10 +24,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(eval-when-compile (require 'cl))
(require 'mm-util)
=== modified file 'lisp/gnus/mm-url.el'
--- a/lisp/gnus/mm-url.el 2014-01-01 07:43:34 +0000
+++ b/lisp/gnus/mm-url.el 2014-03-23 23:13:36 +0000
@@ -21,7 +21,7 @@
;;; Commentary:
-;; Some codes are stolen from w3 and url packages. Some are moved from
+;; Some code is stolen from w3 and url packages. Some are moved from
;; nnweb.
;; TODO: Support POST, cookie.
@@ -264,8 +264,6 @@
(require 'url-parse)
(require 'url-vars))
(error nil))
- ;; w3-4.0pre0.46 or earlier version.
- (require 'w3-vars)
(require 'url)))
;;;###autoload
=== modified file 'lisp/gnus/mm-util.el'
--- a/lisp/gnus/mm-util.el 2014-01-05 23:38:42 +0000
+++ b/lisp/gnus/mm-util.el 2014-03-23 23:13:36 +0000
@@ -23,10 +23,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(eval-when-compile (require 'cl))
(require 'mail-prsvr)
=== modified file 'lisp/gnus/mm-view.el'
--- a/lisp/gnus/mm-view.el 2014-01-01 07:43:34 +0000
+++ b/lisp/gnus/mm-view.el 2014-03-23 23:13:36 +0000
@@ -22,9 +22,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
(eval-when-compile (require 'cl))
(require 'mail-parse)
(require 'mailcap)
@@ -51,7 +48,6 @@
(defvar mm-text-html-renderer-alist
'((shr . mm-shr)
- (w3 . mm-inline-text-html-render-with-w3)
(w3m . mm-inline-text-html-render-with-w3m)
(w3m-standalone . mm-inline-text-html-render-with-w3m-standalone)
(gnus-w3m . gnus-article-html)
@@ -130,91 +126,6 @@
(defalias 'mm-inline-image 'mm-inline-image-xemacs)
(defalias 'mm-inline-image 'mm-inline-image-emacs)))
-;; External.
-(declare-function w3-do-setup "ext:w3" ())
-(declare-function w3-region "ext:w3-display" (st nd))
-(declare-function w3-prepare-buffer "ext:w3-display" (&rest args))
-
-(defvar mm-w3-setup nil)
-(defun mm-setup-w3 ()
- (unless mm-w3-setup
- (require 'w3)
- (w3-do-setup)
- (require 'url)
- (require 'w3-vars)
- (require 'url-vars)
- (setq mm-w3-setup t)))
-
-(defun mm-inline-text-html-render-with-w3 (handle)
- (mm-setup-w3)
- (let ((text (mm-get-part handle))
- (b (point))
- (url-standalone-mode t)
- (url-gateway-unplugged t)
- (w3-honor-stylesheets nil)
- (url-current-object
- (url-generic-parse-url (format "cid:%s" (mm-handle-id handle))))
- (width (window-width))
- (charset (mail-content-type-get
- (mm-handle-type handle) 'charset)))
- (save-excursion
- (insert (if charset (mm-decode-string text charset) text))
- (save-restriction
- (narrow-to-region b (point))
- (unless charset
- (goto-char (point-min))
- (when (or (and (boundp 'w3-meta-content-type-charset-regexp)
- (re-search-forward
- w3-meta-content-type-charset-regexp nil t))
- (and (boundp 'w3-meta-charset-content-type-regexp)
- (re-search-forward
- w3-meta-charset-content-type-regexp nil t)))
- (setq charset
- (let ((bsubstr (buffer-substring-no-properties
- (match-beginning 2)
- (match-end 2))))
- (if (fboundp 'w3-coding-system-for-mime-charset)
- (w3-coding-system-for-mime-charset bsubstr)
- (mm-charset-to-coding-system bsubstr nil t))))
- (delete-region (point-min) (point-max))
- (insert (mm-decode-string text charset))))
- (save-window-excursion
- (save-restriction
- (let ((w3-strict-width width)
- ;; Don't let w3 set the global version of
- ;; this variable.
- (fill-column fill-column))
- (if (or debug-on-error debug-on-quit)
- (w3-region (point-min) (point-max))
- (condition-case ()
- (w3-region (point-min) (point-max))
- (error
- (delete-region (point-min) (point-max))
- (let ((b (point))
- (charset (mail-content-type-get
- (mm-handle-type handle) 'charset)))
- (if (or (eq charset 'gnus-decoded)
- (eq mail-parse-charset 'gnus-decoded))
- (save-restriction
- (narrow-to-region (point) (point))
- (mm-insert-part handle)
- (goto-char (point-max)))
- (insert (mm-decode-string (mm-get-part handle)
- charset))))
- (message
- "Error while rendering html; showing as text/plain")))))))
- (mm-handle-set-undisplayer
- handle
- `(lambda ()
- (let ((inhibit-read-only t))
- ,@(if (functionp 'remove-specifier)
- '((dolist (prop '(background background-pixmap foreground))
- (remove-specifier
- (face-property 'default prop)
- (current-buffer)))))
- (delete-region ,(point-min-marker)
- ,(point-max-marker)))))))))
-
(defvar mm-w3m-setup nil
"Whether gnus-article-mode has been setup to use emacs-w3m.")
@@ -499,13 +410,6 @@
(defun mm-inline-audio (handle)
(message "Not implemented"))
-(defun mm-w3-prepare-buffer ()
- (require 'w3)
- (let ((url-standalone-mode t)
- (url-gateway-unplugged t)
- (w3-honor-stylesheets nil))
- (w3-prepare-buffer)))
-
(defun mm-view-message ()
(mm-enable-multibyte)
(let (handles)
=== modified file 'lisp/gnus/mml-smime.el'
--- a/lisp/gnus/mml-smime.el 2014-01-01 07:43:34 +0000
+++ b/lisp/gnus/mml-smime.el 2014-03-23 23:13:36 +0000
@@ -24,10 +24,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(eval-when-compile (require 'cl))
(require 'smime)
=== modified file 'lisp/gnus/mml.el'
--- a/lisp/gnus/mml.el 2014-01-01 07:43:34 +0000
+++ b/lisp/gnus/mml.el 2014-03-23 23:13:36 +0000
@@ -22,10 +22,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(require 'mm-util)
(require 'mm-bodies)
(require 'mm-encode)
@@ -463,6 +459,9 @@
(defvar mml-multipart-number 0)
(defvar mml-inhibit-compute-boundary nil)
+(declare-function libxml-parse-html-region "xml.c"
+ (start end &optional base-url))
+
(defun mml-generate-mime (&optional multipart-type)
"Generate a MIME message based on the current MML document.
MULTIPART-TYPE defaults to \"mixed\", but can also
@@ -472,19 +471,69 @@
(options message-options))
(if (not cont)
nil
+ (when (and (consp (car cont))
+ (= (length cont) 1)
+ (fboundp 'libxml-parse-html-region)
+ (equal (cdr (assq 'type (car cont))) "text/html"))
+ (setq cont (mml-expand-html-into-multipart-related (car cont))))
(prog1
(mm-with-multibyte-buffer
(setq message-options options)
- (if (and (consp (car cont))
- (= (length cont) 1))
- (mml-generate-mime-1 (car cont))
+ (cond
+ ((and (consp (car cont))
+ (= (length cont) 1))
+ (mml-generate-mime-1 (car cont)))
+ ((eq (car cont) 'multipart)
+ (mml-generate-mime-1 cont))
+ (t
(mml-generate-mime-1
(nconc (list 'multipart (cons 'type (or multipart-type "mixed")))
- cont)))
+ cont))))
(setq options message-options)
(buffer-string))
(setq message-options options)))))
+(defun mml-expand-html-into-multipart-related (cont)
+ (let ((new-parts nil)
+ (cid 1))
+ (mm-with-multibyte-buffer
+ (insert (cdr (assq 'contents cont)))
+ (goto-char (point-min))
+ (with-syntax-table mml-syntax-table
+ (while (re-search-forward "<img\\b" nil t)
+ (goto-char (match-beginning 0))
+ (let* ((start (point))
+ (img (nth 2
+ (nth 2
+ (libxml-parse-html-region
+ (point) (progn (forward-sexp) (point))))))
+ (end (point))
+ (parsed (url-generic-parse-url (cdr (assq 'src (cadr img))))))
+ (when (and (null (url-type parsed))
+ (url-filename parsed)
+ (file-exists-p (url-filename parsed)))
+ (goto-char start)
+ (when (search-forward (url-filename parsed) end t)
+ (let ((cid (format "fsf.%d" cid)))
+ (replace-match (concat "cid:" cid) t t)
+ (push (list cid (url-filename parsed)) new-parts))
+ (setq cid (1+ cid)))))))
+ ;; We have local images that we want to include.
+ (if (not new-parts)
+ (list cont)
+ (setcdr (assq 'contents cont) (buffer-string))
+ (setq cont
+ (nconc (list 'multipart (cons 'type "related"))
+ (list cont)))
+ (dolist (new-part (nreverse new-parts))
+ (setq cont
+ (nconc cont
+ (list `(part (type . "image/png")
+ (filename . ,(nth 1 new-part))
+ (id . ,(concat "<" (nth 0 new-part)
+ ">")))))))
+ cont))))
+
(defun mml-generate-mime-1 (cont)
(let ((mm-use-ultra-safe-encoding
(or mm-use-ultra-safe-encoding (assq 'sign cont))))
=== modified file 'lisp/gnus/mml1991.el'
--- a/lisp/gnus/mml1991.el 2014-01-01 07:43:34 +0000
+++ b/lisp/gnus/mml1991.el 2014-03-23 23:13:36 +0000
@@ -26,9 +26,6 @@
;;; Code:
(eval-and-compile
- ;; For Emacs <22.2 and XEmacs.
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))
-
(if (locate-library "password-cache")
(require 'password-cache)
(require 'password)))
=== modified file 'lisp/gnus/mml2015.el'
--- a/lisp/gnus/mml2015.el 2014-01-01 07:43:34 +0000
+++ b/lisp/gnus/mml2015.el 2014-03-23 23:13:36 +0000
@@ -28,9 +28,6 @@
;;; Code:
(eval-and-compile
- ;; For Emacs <22.2 and XEmacs.
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))
-
(if (locate-library "password-cache")
(require 'password-cache)
(require 'password)))
@@ -51,12 +48,10 @@
;; Then mml1991 would not need to require mml2015, and mml1991-use
;; could be removed.
(defvar mml2015-use (or
- (condition-case nil
- (progn
- (require 'epg-config)
- (epg-check-configuration (epg-configuration))
- 'epg)
- (error))
+ (progn
+ (ignore-errors (require 'epg-config))
+ (and (fboundp 'epg-check-configuration)
+ 'epg))
(progn
(let ((abs-file (locate-library "pgg")))
;; Don't load PGG if it is marked as obsolete
=== modified file 'lisp/gnus/nndraft.el'
--- a/lisp/gnus/nndraft.el 2014-01-01 07:43:34 +0000
+++ b/lisp/gnus/nndraft.el 2014-03-23 23:13:36 +0000
@@ -24,10 +24,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(require 'nnheader)
(require 'nnmail)
(require 'gnus-start)
=== modified file 'lisp/gnus/nnfolder.el'
--- a/lisp/gnus/nnfolder.el 2014-01-01 07:43:34 +0000
+++ b/lisp/gnus/nnfolder.el 2014-03-23 23:13:36 +0000
@@ -28,10 +28,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(require 'nnheader)
(require 'message)
(require 'nnmail)
=== modified file 'lisp/gnus/nnheader.el'
--- a/lisp/gnus/nnheader.el 2014-01-01 07:43:34 +0000
+++ b/lisp/gnus/nnheader.el 2014-03-23 23:13:36 +0000
@@ -26,9 +26,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
(eval-when-compile (require 'cl))
(defvar nnmail-extra-headers)
=== modified file 'lisp/gnus/nnimap.el'
--- a/lisp/gnus/nnimap.el 2014-03-07 17:21:35 +0000
+++ b/lisp/gnus/nnimap.el 2014-03-23 23:13:36 +0000
@@ -26,10 +26,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(eval-and-compile
(require 'nnheader)
;; In Emacs 24, `open-protocol-stream' is an autoloaded alias for
@@ -628,6 +624,26 @@
(nnheader-ms-strip-cr)
(cons group article)))))))
+(deffoo nnimap-request-articles (articles &optional group server)
+ (when group
+ (setq group (nnimap-decode-gnus-group group)))
+ (with-current-buffer nntp-server-buffer
+ (let ((result (nnimap-change-group group server)))
+ (when result
+ (erase-buffer)
+ (with-current-buffer (nnimap-buffer)
+ (erase-buffer)
+ (when (nnimap-command
+ (if (nnimap-ver4-p)
+ "UID FETCH %s BODY.PEEK[]"
+ "UID FETCH %s RFC822.PEEK")
+ (nnimap-article-ranges (gnus-compress-sequence articles)))
+ (let ((buffer (current-buffer)))
+ (with-current-buffer nntp-server-buffer
+ (nnheader-insert-buffer-substring buffer)
+ (nnheader-ms-strip-cr)))
+ t))))))
+
(defun nnimap-get-whole-article (article &optional command)
(let ((result
(nnimap-command
=== modified file 'lisp/gnus/nnir.el'
--- a/lisp/gnus/nnir.el 2014-03-07 16:58:25 +0000
+++ b/lisp/gnus/nnir.el 2014-03-23 23:13:36 +0000
@@ -171,10 +171,6 @@
;;; Setup:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(require 'nnoo)
(require 'gnus-group)
(require 'message)
=== modified file 'lisp/gnus/nnmail.el'
--- a/lisp/gnus/nnmail.el 2014-02-12 05:51:37 +0000
+++ b/lisp/gnus/nnmail.el 2014-03-23 23:13:36 +0000
@@ -24,10 +24,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(eval-when-compile (require 'cl))
(require 'gnus) ; for macro gnus-kill-buffer,
at least
=== modified file 'lisp/gnus/nnmaildir.el'
--- a/lisp/gnus/nnmaildir.el 2013-05-23 05:05:27 +0000
+++ b/lisp/gnus/nnmaildir.el 2014-03-23 23:13:36 +0000
@@ -59,10 +59,6 @@
)
]
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(require 'nnheader)
(require 'gnus)
(require 'gnus-util)
=== modified file 'lisp/gnus/nnrss.el'
--- a/lisp/gnus/nnrss.el 2014-01-01 07:43:34 +0000
+++ b/lisp/gnus/nnrss.el 2014-03-23 23:13:36 +0000
@@ -24,10 +24,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(eval-when-compile (require 'cl))
(require 'gnus)
@@ -398,8 +394,8 @@
nnrss-compatible-encoding-alist)))))
(mm-coding-system-p 'utf-8)))
-(declare-function w3-parse-buffer "ext:w3-parse" (&optional buff))
-
+(declare-function libxml-parse-html-region "xml.c"
+ (start end &optional base-url))
(defun nnrss-fetch (url &optional local)
"Fetch URL and put it in a the expected Lisp structure."
(mm-with-unibyte-buffer
@@ -426,22 +422,14 @@
(mm-enable-multibyte))))
(goto-char (point-min))
- ;; Because xml-parse-region can't deal with anything that isn't
- ;; xml and w3-parse-buffer can't deal with some xml, we have to
- ;; parse with xml-parse-region first and, if that fails, parse
- ;; with w3-parse-buffer. Yuck. Eventually, someone should find out
- ;; why w3-parse-buffer fails to parse some well-formed xml and
- ;; fix it.
-
(condition-case err1
(setq xmlform (xml-parse-region (point-min) (point-max)))
(error
(condition-case err2
- (setq htmlform (caddar (w3-parse-buffer
- (current-buffer))))
+ (setq htmlform (libxml-parse-html-region (point-min) (point-max)))
(error
(message "\
-nnrss: %s: Not valid XML %s and w3-parse doesn't work %s"
+nnrss: %s: Not valid XML %s and libxml-parse-html-region doesn't work %s"
url err1 err2)))))
(if htmlform
htmlform
@@ -599,7 +587,7 @@
(defun nnrss-no-cache (url)
"")
-(defun nnrss-insert-w3 (url)
+(defun nnrss-insert (url)
(mm-with-unibyte-current-buffer
(condition-case err
(mm-url-insert url)
@@ -614,8 +602,6 @@
(mm-url-decode-entities-nbsp)
(buffer-string))))
-(defalias 'nnrss-insert 'nnrss-insert-w3)
-
(defun nnrss-mime-encode-string (string)
(mm-with-multibyte-buffer
(insert string)
@@ -880,8 +866,7 @@
(defun nnrss-extract-hrefs (data)
"Recursively extract hrefs from a page's source.
-DATA should be the output of `xml-parse-region' or
-`w3-parse-buffer'."
+DATA should be the output of `xml-parse-region'."
(mapcar (lambda (ahref)
(cdr (assoc 'href (cadr ahref))))
(nnrss-find-el 'a data)))
=== modified file 'lisp/gnus/nntp.el'
--- a/lisp/gnus/nntp.el 2014-01-01 07:43:34 +0000
+++ b/lisp/gnus/nntp.el 2014-03-23 23:13:36 +0000
@@ -25,9 +25,7 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))
;; In Emacs 24, `open-protocol-stream' is an autoloaded alias for
;; `make-network-stream'.
(unless (fboundp 'open-protocol-stream)
=== modified file 'lisp/gnus/nnweb.el'
--- a/lisp/gnus/nnweb.el 2014-01-01 07:43:34 +0000
+++ b/lisp/gnus/nnweb.el 2014-03-23 23:13:36 +0000
@@ -22,8 +22,6 @@
;;; Commentary:
-;; Note: You need to have `w3' installed for some functions to work.
-
;;; Code:
(eval-when-compile (require 'cl))
@@ -38,7 +36,6 @@
(eval-and-compile
(ignore-errors
(require 'url)))
-(autoload 'w3-parse-buffer "w3-parse")
(nnoo-declare nnweb)
@@ -527,7 +524,7 @@
url))
;;;
-;;; General web/w3 interface utility functions
+;;; General web interface utility functions
;;;
(defun nnweb-insert-html (parse)
=== modified file 'lisp/gnus/rfc1843.el'
--- a/lisp/gnus/rfc1843.el 2014-01-01 07:43:34 +0000
+++ b/lisp/gnus/rfc1843.el 2014-03-23 23:13:36 +0000
@@ -31,10 +31,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(eval-when-compile (require 'cl))
(require 'mm-util)
=== modified file 'lisp/gnus/sieve-manage.el'
--- a/lisp/gnus/sieve-manage.el 2014-01-01 07:43:34 +0000
+++ b/lisp/gnus/sieve-manage.el 2014-03-23 23:13:36 +0000
@@ -71,10 +71,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(if (locate-library "password-cache")
(require 'password-cache)
(require 'password))
=== modified file 'lisp/gnus/smime.el'
--- a/lisp/gnus/smime.el 2014-01-01 07:43:34 +0000
+++ b/lisp/gnus/smime.el 2014-03-23 23:13:36 +0000
@@ -118,9 +118,6 @@
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
(require 'dig)
(if (locate-library "password-cache")
=== modified file 'lisp/gnus/spam.el'
--- a/lisp/gnus/spam.el 2014-01-31 01:56:00 +0000
+++ b/lisp/gnus/spam.el 2014-03-23 23:13:36 +0000
@@ -38,10 +38,6 @@
;;{{{ compilation directives and autoloads/requires
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(eval-when-compile (require 'cl))
(require 'message) ;for the message-fetch-field functions
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] trunk r116864: Merge from Gnus git master,
Katsumi Yamaoka <=