mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-01-24 19:03:29 +00:00
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.
This commit is contained in:
Gnus developers
Katsumi Yamaoka
parent
b029599f76
commit
4d2226bff0
@ -1,3 +1,139 @@
|
||||
2014-03-23 Katsumi Yamaoka <yamaoka@jpl.org>
|
||||
|
||||
* gnus-sum.el (gnus-summary-toggle-header): Display header attachment
|
||||
buttons when toggling the header off.
|
||||
|
||||
2014-03-23 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-23 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-23 Lars Ingebrigtsen <larsi@gnus.org>
|
||||
|
||||
* message.el (message-make-html-message-with-image-files): New command.
|
||||
|
||||
2014-03-23 Lars Ingebrigtsen <larsi@gnus.org>
|
||||
|
||||
* mml.el (mml-insert-mime-headers): Allow `recipient-filename'.
|
||||
|
||||
2014-03-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-03-23 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-03-23 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-03-23 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-03-23 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-03-23 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-03-23 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-03-23 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-03-23 Daniel Dehennin <daniel.dehennin@baby-gnu.org>
|
||||
|
||||
* gnus-mlspl.el (gnus-group-split-fancy): Use `gnus-parameters' in
|
||||
`gnus-group-split-fancy'.
|
||||
|
||||
2014-03-23 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-03-23 Dave Abrahams <dave@boostpro.com>
|
||||
|
||||
* gnus-sum.el (gnus-summary-open-group-with-article): New command.
|
||||
|
||||
2014-03-23 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-03-23 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.
|
||||
|
||||
2014-03-07 Lars Ingebrigtsen <larsi@gnus.org>
|
||||
|
||||
* nnimap.el (nnimap-request-accept-article): Make respooling to nnimap
|
||||
|
||||
@ -1524,10 +1524,10 @@ list, it matches the original pattern."
|
||||
(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))))))
|
||||
|
||||
|
||||
@ -441,6 +441,7 @@ rather than relying on `lexical-binding'.
|
||||
`(,(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)
|
||||
|
||||
|
||||
@ -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 @@ If ALL-HEADERS is non-nil, no headers are hidden."
|
||||
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 @@ Compressed files like .gz and .bz2 are decompressed."
|
||||
(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 @@ all parts."
|
||||
(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 @@ all parts."
|
||||
(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 @@ If displaying \"text/html\" is discouraged \(see
|
||||
: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 @@ If displaying \"text/html\" is discouraged \(see
|
||||
((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 @@ If displaying \"text/html\" is discouraged \(see
|
||||
(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 @@ Provided for backwards compatibility."
|
||||
(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)
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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 @@ PNG format."
|
||||
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 '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
|
||||
(if data
|
||||
(progn (message-goto-eoh)
|
||||
(insert type ": " data "\n"))
|
||||
(message
|
||||
"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)
|
||||
(let ((data (gnus-random-x-face)))
|
||||
(save-excursion
|
||||
(message-goto-eoh)
|
||||
(if data
|
||||
(insert "X-Face: " data)
|
||||
(message
|
||||
"No face returned by `gnus-random-x-face'. Does %s/*.pbm exist?"
|
||||
gnus-x-face-directory)))))
|
||||
(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 @@ different input formats."
|
||||
|
||||
;;;###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 @@ FILE should be a PNG file that's 48x48 and smaller than or equal to
|
||||
(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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -146,20 +146,27 @@ Calling (gnus-group-split-fancy nil nil \"mail.others\") returns:
|
||||
(any \"\\\\(foo@nowhere\\\\.gov\\\\|foo@localhost\\\\|foo-redist@home\\\\)\"
|
||||
- \"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))
|
||||
|
||||
@ -102,6 +102,9 @@ Return a notification id if any, or t on success."
|
||||
;; 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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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 <steve@miranova.com>
|
||||
;; 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 <jin@atype.com>
|
||||
;;; Patrick LoPresti <patl@lcs.mit.edu>
|
||||
|
||||
(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 <jwz@lucid.com>
|
||||
|
||||
(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
|
||||
@ -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)
|
||||
|
||||
|
||||
@ -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 @@ If nil, a faster, but more primitive, buffer is used instead."
|
||||
(?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 @@ If nil, a faster, but more primitive, buffer is used instead."
|
||||
["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 @@ If nil, a faster, but more primitive, buffer is used instead."
|
||||
|
||||
"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 @@ If nil, a faster, but more primitive, buffer is used instead."
|
||||
(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 @@ If nil, a faster, but more primitive, buffer is used instead."
|
||||
|
||||
(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 @@ The following commands are available:
|
||||
(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 @@ Requesting compaction of %s... (this may take a long time)"
|
||||
(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
|
||||
|
||||
@ -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")
|
||||
|
||||
@ -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 @@ increase the score of each group you read."
|
||||
(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 @@ increase the score of each group you read."
|
||||
["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 @@ non-numeric or nil fetch the number specified by the
|
||||
(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 @@ If ARG is a negative number, hide the unwanted header lines."
|
||||
(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))))
|
||||
|
||||
@ -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))
|
||||
|
||||
|
||||
@ -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 @@ be set in `.emacs' instead."
|
||||
|
||||
(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 @@ be set in `.emacs' instead."
|
||||
(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 @@ slower."
|
||||
: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 @@ slower."
|
||||
("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 @@ such as a mark that says whether an article is stored in the cache
|
||||
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
|
||||
|
||||
@ -138,9 +138,7 @@ You can provide a list of argument to pass to CB in CBARGS."
|
||||
"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)))
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -215,10 +215,6 @@ This is a compatibility function for different Emacsen."
|
||||
(viewer . vm-mode)
|
||||
(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")))
|
||||
@ -252,10 +248,6 @@ This is a compatibility function for different Emacsen."
|
||||
(test . (eq window-system 'x))
|
||||
("needsx11")))
|
||||
("text"
|
||||
("plain"
|
||||
(viewer . w3-mode)
|
||||
(test . (fboundp 'w3-mode))
|
||||
(type . "text/plain"))
|
||||
("plain"
|
||||
(viewer . view-mode)
|
||||
(test . (fboundp 'view-mode))
|
||||
@ -267,10 +259,6 @@ This is a compatibility function for different Emacsen."
|
||||
(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))
|
||||
|
||||
@ -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 @@ Done before generating the new subject of a forward."
|
||||
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 @@ Done before generating the new subject of a forward."
|
||||
(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 @@ With prefix-argument just set Follow-Up, don't cross-post."
|
||||
"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 @@ Optional DIGEST will use digest to forward."
|
||||
(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 @@ Optional DIGEST will use digest to forward."
|
||||
(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 @@ Used in `message-simplify-recipients'."
|
||||
(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))
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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 @@ The defined renderer types are:
|
||||
`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 @@ nil : use external viewer (default web browser)."
|
||||
: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)
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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 @@ This is taken from RFC 2396.")
|
||||
(require 'url-parse)
|
||||
(require 'url-vars))
|
||||
(error nil))
|
||||
;; w3-4.0pre0.46 or earlier version.
|
||||
(require 'w3-vars)
|
||||
(require 'url)))
|
||||
|
||||
;;;###autoload
|
||||
|
||||
@ -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)
|
||||
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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 @@ If MML is non-nil, return the buffer up till the correspondent mml tag."
|
||||
(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 @@ be \"related\" or \"alternate\"."
|
||||
(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))))
|
||||
|
||||
@ -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)))
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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 @@ textual parts.")
|
||||
(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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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 @@ otherwise return nil."
|
||||
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 @@ otherwise return nil."
|
||||
(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 @@ which RSS 2.0 allows."
|
||||
(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 @@ which RSS 2.0 allows."
|
||||
(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 @@ Careful with this on large documents!"
|
||||
|
||||
(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)))
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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 @@ Valid types include `google', `dejanews', and `gmane'.")
|
||||
url))
|
||||
|
||||
;;;
|
||||
;;; General web/w3 interface utility functions
|
||||
;;; General web interface utility functions
|
||||
;;;
|
||||
|
||||
(defun nnweb-insert-html (parse)
|
||||
|
||||
@ -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)
|
||||
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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")
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user