diff options
| author | Gnus developers <[email protected]> | 2014-03-23 23:13:36 +0000 |
|---|---|---|
| committer | Katsumi Yamaoka <[email protected]> | 2014-03-23 23:13:36 +0000 |
| commit | 4d2226bff09b794fe2f5db3b2ae3b5b48188d4a7 (patch) | |
| tree | 9e6574c3b77ea47230b998641f0501b7f7374648 | |
| parent | b029599f767406002ea892d0bd40420de0a954f6 (diff) | |
Merge from Gnus git master
2014-03-14 Katsumi Yamaoka <[email protected]>
* gnus-sum.el (gnus-summary-toggle-header): Display header attachment
buttons when toggling the header off.
2014-03-07 Daiki Ueno <[email protected]>
* 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 <[email protected]>
* 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 <[email protected]>
* message.el (message-make-html-message-with-image-files): New command.
2014-03-05 Lars Ingebrigtsen <[email protected]>
* mml.el (mml-insert-mime-headers): Allow `recipient-filename'.
2014-02-23 David Engster <[email protected]>
* 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 <[email protected]>
* 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 <[email protected]>
* 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 <[email protected]>
* 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 <[email protected]>
* 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 <[email protected]>
* 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 <[email protected]>
* 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 <[email protected]>
* 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 <[email protected]>
* gnus-mlspl.el (gnus-group-split-fancy): Use `gnus-parameters' in
`gnus-group-split-fancy'.
2014-02-01 Lars Ingebrigtsen <[email protected]>
* message.el (message-remove-header): Doc fix.
(message-forward-included-headers): New variable.
(message-remove-ignored-headers): Use it.
2014-01-31 Dave Abrahams <[email protected]>
* gnus-sum.el (gnus-summary-open-group-with-article): New command.
2013-09-04 Rasmus Pank Roulund <[email protected]>
* 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 <[email protected]>
* mm-url.el: Remove all usage of w3.
* nnrss.el: Ditto.
* mm-decode.el: Ditto.
* mm-view.el: Ditto.
* gnus-setup.el: Remove outdated file.
46 files changed, 598 insertions, 546 deletions
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index cdf22ef256..99b0ccd84d 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,139 @@ +2014-03-23 Katsumi Yamaoka <[email protected]> + + * gnus-sum.el (gnus-summary-toggle-header): Display header attachment + buttons when toggling the header off. + +2014-03-23 Daiki Ueno <[email protected]> + + * 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 <[email protected]> + + * 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 <[email protected]> + + * message.el (message-make-html-message-with-image-files): New command. + +2014-03-23 Lars Ingebrigtsen <[email protected]> + + * mml.el (mml-insert-mime-headers): Allow `recipient-filename'. + +2014-03-23 David Engster <[email protected]> + + * 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 <[email protected]> + + * 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 <[email protected]> + + * 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 <[email protected]> + + * 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 <[email protected]> + + * 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 <[email protected]> + + * 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 <[email protected]> + + * 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 <[email protected]> + + * 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 <[email protected]> + + * gnus-mlspl.el (gnus-group-split-fancy): Use `gnus-parameters' in + `gnus-group-split-fancy'. + +2014-03-23 Lars Ingebrigtsen <[email protected]> + + * message.el (message-remove-header): Doc fix. + (message-forward-included-headers): New variable. + (message-remove-ignored-headers): Use it. + +2014-03-23 Dave Abrahams <[email protected]> + + * gnus-sum.el (gnus-summary-open-group-with-article): New command. + +2014-03-23 Rasmus Pank Roulund <[email protected]> + + * 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 <[email protected]> + + * 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 <[email protected]> * nnimap.el (nnimap-request-accept-article): Make respooling to nnimap diff --git a/lisp/gnus/auth-source.el b/lisp/gnus/auth-source.el index a50ad75063..42db423ac8 100644 --- a/lisp/gnus/auth-source.el +++ b/lisp/gnus/auth-source.el @@ -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)))))) diff --git a/lisp/gnus/gmm-utils.el b/lisp/gnus/gmm-utils.el index 8ce2932308..63947e5f48 100644 --- a/lisp/gnus/gmm-utils.el +++ b/lisp/gnus/gmm-utils.el @@ -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) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 29d70aa1a8..008fa266ea 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -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) diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el index d58acbd18c..544d6672a8 100644 --- a/lisp/gnus/gnus-cache.el +++ b/lisp/gnus/gnus-cache.el @@ -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) diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el index 50076821a8..d6b4fba624 100644 --- a/lisp/gnus/gnus-fun.el +++ b/lisp/gnus/gnus-fun.el @@ -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 diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index d8260b4043..31078be48a 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -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) diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el index 90947fe4d8..540694f34f 100644 --- a/lisp/gnus/gnus-html.el +++ b/lisp/gnus/gnus-html.el @@ -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) diff --git a/lisp/gnus/gnus-mlspl.el b/lisp/gnus/gnus-mlspl.el index 8dec6f2421..2d86d0b81a 100644 --- a/lisp/gnus/gnus-mlspl.el +++ b/lisp/gnus/gnus-mlspl.el @@ -146,20 +146,27 @@ Calling (gnus-group-split-fancy nil nil \"mail.others\") returns: (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)) diff --git a/lisp/gnus/gnus-notifications.el b/lisp/gnus/gnus-notifications.el index 0621c23c20..ee1083d800 100644 --- a/lisp/gnus/gnus-notifications.el +++ b/lisp/gnus/gnus-notifications.el @@ -102,6 +102,9 @@ Return a notification id if any, or t on success." ;; 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 diff --git a/lisp/gnus/gnus-picon.el b/lisp/gnus/gnus-picon.el index 83629df171..05301673a5 100644 --- a/lisp/gnus/gnus-picon.el +++ b/lisp/gnus/gnus-picon.el @@ -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) diff --git a/lisp/gnus/gnus-setup.el b/lisp/gnus/gnus-setup.el deleted file mode 100644 index 7ef8dc5253..0000000000 --- a/lisp/gnus/gnus-setup.el +++ /dev/null @@ -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 <[email protected]> -;; 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 <[email protected]> -;;; Patrick LoPresti <[email protected]> - -(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 <[email protected]> - -(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 diff --git a/lisp/gnus/gnus-spec.el b/lisp/gnus/gnus-spec.el index 54714d503b..e11ddc4c4f 100644 --- a/lisp/gnus/gnus-spec.el +++ b/lisp/gnus/gnus-spec.el @@ -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) diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el index 319f7a8cbc..a2176d0c72 100644 --- a/lisp/gnus/gnus-srvr.el +++ b/lisp/gnus/gnus-srvr.el @@ -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 diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index b9b259e0d1..b79b96e4fc 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -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") diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index d6c801fdd3..dca2a2c149 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -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)))) diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index a3038a1bfe..62977576a0 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -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)) diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index b1d60de93d..206f5a502f 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -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 diff --git a/lisp/gnus/gravatar.el b/lisp/gnus/gravatar.el index 650564e280..ffbc37ae15 100644 --- a/lisp/gnus/gravatar.el +++ b/lisp/gnus/gravatar.el @@ -138,9 +138,7 @@ You can provide a list of argument to pass to CB in CBARGS." "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))) diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el index d54377fae1..51b9c91154 100644 --- a/lisp/gnus/mail-source.el +++ b/lisp/gnus/mail-source.el @@ -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) diff --git a/lisp/gnus/mailcap.el b/lisp/gnus/mailcap.el index 5515a348b4..4f1bdf4b1d 100644 --- a/lisp/gnus/mailcap.el +++ b/lisp/gnus/mailcap.el @@ -216,10 +216,6 @@ This is a compatibility function for different Emacsen." (test . (fboundp 'vm-mode)) (type . "message/rfc822")) ("rfc-*822" - (viewer . w3-mode) - (test . (fboundp 'w3-mode)) - (type . "message/rfc822")) - ("rfc-*822" (viewer . view-mode) (type . "message/rfc822"))) ("image" @@ -253,10 +249,6 @@ This is a compatibility function for different Emacsen." ("needsx11"))) ("text" ("plain" - (viewer . w3-mode) - (test . (fboundp 'w3-mode)) - (type . "text/plain")) - ("plain" (viewer . view-mode) (test . (fboundp 'view-mode)) (type . "text/plain")) @@ -267,10 +259,6 @@ 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)) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 5300de5eab..1f42ccb61f 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -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)) diff --git a/lisp/gnus/mm-bodies.el b/lisp/gnus/mm-bodies.el index 4972459738..c2f6df9c62 100644 --- a/lisp/gnus/mm-bodies.el +++ b/lisp/gnus/mm-bodies.el @@ -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) diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index 17c8fb1b8d..a99e7a43ca 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -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) diff --git a/lisp/gnus/mm-extern.el b/lisp/gnus/mm-extern.el index 882c8545e5..d574b9d51d 100644 --- a/lisp/gnus/mm-extern.el +++ b/lisp/gnus/mm-extern.el @@ -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) diff --git a/lisp/gnus/mm-url.el b/lisp/gnus/mm-url.el index 4b46ab74f5..bb342d6b8b 100644 --- a/lisp/gnus/mm-url.el +++ b/lisp/gnus/mm-url.el @@ -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 diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el index 38ee8a563e..0d02e1db75 100644 --- a/lisp/gnus/mm-util.el +++ b/lisp/gnus/mm-util.el @@ -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) diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index a764fa51c5..27f772cffa 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -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) diff --git a/lisp/gnus/mml-smime.el b/lisp/gnus/mml-smime.el index bd7a50f718..caa1380a49 100644 --- a/lisp/gnus/mml-smime.el +++ b/lisp/gnus/mml-smime.el @@ -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) diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index 439d7c5dc1..168fe4908c 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -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)))) diff --git a/lisp/gnus/mml1991.el b/lisp/gnus/mml1991.el index 8c698edb06..2663107133 100644 --- a/lisp/gnus/mml1991.el +++ b/lisp/gnus/mml1991.el @@ -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))) diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el index 9fc8f6e8c0..a533829ce5 100644 --- a/lisp/gnus/mml2015.el +++ b/lisp/gnus/mml2015.el @@ -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 diff --git a/lisp/gnus/nndraft.el b/lisp/gnus/nndraft.el index 3e917b41b1..764314de0a 100644 --- a/lisp/gnus/nndraft.el +++ b/lisp/gnus/nndraft.el @@ -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) diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el index 1a799d3c57..a403f3965c 100644 --- a/lisp/gnus/nnfolder.el +++ b/lisp/gnus/nnfolder.el @@ -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) diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el index 3ce3dfa1e7..994c2d022c 100644 --- a/lisp/gnus/nnheader.el +++ b/lisp/gnus/nnheader.el @@ -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) diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 2fc2dd6af7..1730bd4252 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -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 diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index 5910cde1c3..e2051dfd31 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el @@ -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) diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el index ac4b638fda..d1a0455a1b 100644 --- a/lisp/gnus/nnmail.el +++ b/lisp/gnus/nnmail.el @@ -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 diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el index 7d33e511ba..21fa5b37aa 100644 --- a/lisp/gnus/nnmaildir.el +++ b/lisp/gnus/nnmaildir.el @@ -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) diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el index 5ef91d0be7..02a9513d07 100644 --- a/lisp/gnus/nnrss.el +++ b/lisp/gnus/nnrss.el @@ -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))) diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el index 5ef13984ab..6035162d29 100644 --- a/lisp/gnus/nntp.el +++ b/lisp/gnus/nntp.el @@ -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) diff --git a/lisp/gnus/nnweb.el b/lisp/gnus/nnweb.el index 3fb35b2278..e909372e8a 100644 --- a/lisp/gnus/nnweb.el +++ b/lisp/gnus/nnweb.el @@ -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) diff --git a/lisp/gnus/rfc1843.el b/lisp/gnus/rfc1843.el index 09c2b723eb..74e8f12fc3 100644 --- a/lisp/gnus/rfc1843.el +++ b/lisp/gnus/rfc1843.el @@ -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) diff --git a/lisp/gnus/sieve-manage.el b/lisp/gnus/sieve-manage.el index fd97c7d595..62d185e285 100644 --- a/lisp/gnus/sieve-manage.el +++ b/lisp/gnus/sieve-manage.el @@ -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)) diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el index 4a763caba8..bcebe3ddc3 100644 --- a/lisp/gnus/smime.el +++ b/lisp/gnus/smime.el @@ -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") diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el index 82f98c4294..664ac53a76 100644 --- a/lisp/gnus/spam.el +++ b/lisp/gnus/spam.el @@ -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 |