+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
(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))))))
`(,(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)
;;; 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)
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
(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)))))
(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)
(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
: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.
((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)
(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"
(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)
;;; 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)
;;; Code:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
(eval-when-compile
(require 'cl))
: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"
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."
;;;###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."
(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
;;; 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)
;;; 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)
(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))
;; 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
;;
;;; 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)
+++ /dev/null
-;;; 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))
-\f
-;;;### (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
;;; 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)
: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.
(?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)
["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]
"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))
(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))
(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)
(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
(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
(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")
;;; 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
(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)
["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
(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: ")
(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))))
;;; 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 '(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)
(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)
(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)
: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)
("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.
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
"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)))
;;; 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)
(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")))
(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))
(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))
;;; 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 'mml)
(require 'rfc822)
(require 'format-spec)
+(require 'dired)
(autoload 'mailclient-send-it "mailclient") ;; Emacs 22 or contrib/
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)
(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
"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) ":")))
(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)))
(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)
(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))
;;; 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)
;;; 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))
((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.
`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)
: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)
;;; 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)
;;; 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.
(require 'url-parse)
(require 'url-vars))
(error nil))
- ;; w3-4.0pre0.46 or earlier version.
- (require 'w3-vars)
(require 'url)))
;;;###autoload
;;; 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)
;;; 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)
(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)
(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.")
(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)
;;; 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)
;;; 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)
(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
(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))))
;;; 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)))
;;; 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)))
;; 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
;;; 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)
;;; 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)
;;; 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)
;;; 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
(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
;;; 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)
;;; 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
)
]
-;; 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)
;;; 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)
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
(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
(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)
(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)
(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)))
;;; 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)
;;; Commentary:
-;; Note: You need to have `w3' installed for some functions to work.
-
;;; Code:
(eval-when-compile (require 'cl))
(eval-and-compile
(ignore-errors
(require 'url)))
-(autoload 'w3-parse-buffer "w3-parse")
(nnoo-declare nnweb)
url))
;;;
-;;; General web/w3 interface utility functions
+;;; General web interface utility functions
;;;
(defun nnweb-insert-html (parse)
;;; 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)
;;; 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))
;;; 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")
;;{{{ 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