;;; gnus-art.el --- article mode commands for Gnus
-;; Copyright (C) 1996-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2013 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
(defvar w3m-minor-mode-map)
(require 'gnus)
+(require 'gnus-util)
(require 'gnus-sum)
(require 'gnus-spec)
(require 'gnus-int)
`gnus-article-update-date-headers' for details."
:version "24.1"
:group 'gnus-article-headers
- :type '(repeat
- (item :tag "Universal time (UT)" :value 'ut)
- (item :tag "Local time zone" :value 'local)
- (item :tag "Readable English" :value 'english)
- (item :tag "Elapsed time" :value 'lapsed)
- (item :tag "Original and elapsed time" :value 'combined-lapsed)
- (item :tag "Original date header" :value 'original)
- (item :tag "ISO8601 format" :value 'iso8601)
- (item :tag "User-defined" :value 'user-defined)))
+ :type '(set
+ (const :tag "Universal time (UT)" ut)
+ (const :tag "Local time zone" local)
+ (const :tag "Readable English" english)
+ (const :tag "Elapsed time" lapsed)
+ (const :tag "Original and elapsed time" combined-lapsed)
+ (const :tag "Original date header" original)
+ (const :tag "ISO8601 format" iso8601)
+ (const :tag "User-defined" user-defined)))
(defcustom gnus-article-update-date-headers nil
"A number that says how often to update the date header (in seconds).
(const :tag "Header" head)))
(defvar gnus-article-treat-types '("text/plain" "text/x-verbatim"
- "text/x-patch")
- "Parts to treat.")
+ "text/x-patch" "text/html")
+ "Part types eligible for treatment.")
(defvar gnus-inhibit-treatment nil
"Whether to inhibit treatment.")
regexp."
:version "24.1"
:group 'gnus-art
- :type 'regexp)
+ :type '(choice regexp function))
;;; Internal variables
(put-text-property (max (1- b) (point-min))
b 'intangible nil)))
-(defun gnus-article-hide-text-of-type (type)
- "Hide text of TYPE in the current buffer."
- (save-excursion
- (let ((b (point-min))
- (e (point-max)))
- (while (setq b (text-property-any b e 'article-type type))
- (add-text-properties b (incf b) gnus-hidden-properties)))))
-
(defun gnus-article-delete-text-of-type (type)
"Delete text of TYPE in the current buffer."
(save-excursion
b (or (text-property-not-all b (point-max) 'invisible t)
(point-max)))))))
-(defun gnus-article-text-type-exists-p (type)
- "Say whether any text of type TYPE exists in the buffer."
- (text-property-any (point-min) (point-max) 'article-type type))
-
(defsubst gnus-article-header-rank ()
"Give the rank of the string HEADER as given by `gnus-sorted-header-list'."
(let ((list gnus-sorted-header-list)
props)
(insert replace)))))))))
-(defun article-translate-characters (from to)
- "Translate all characters in the body of the article according to FROM and TO.
-FROM is a string of characters to translate from; to is a string of
-characters to translate to."
- (save-excursion
- (when (article-goto-body)
- (let ((inhibit-read-only t)
- (x (make-string 225 ?x))
- (i -1))
- (while (< (incf i) (length x))
- (aset x i i))
- (setq i 0)
- (while (< i (length from))
- (aset x (aref from i) (aref to i))
- (incf i))
- (translate-region (point) (point-max) x)))))
-
(defun article-translate-strings (map)
"Translate all string in the body of the article according to MAP.
MAP is an alist where the elements are on the form (\"from\" \"to\")."
(unfoldable
(or (equal gnus-article-unfold-long-headers t)
(and (stringp gnus-article-unfold-long-headers)
- (string-match gnus-article-unfold-long-headers header)))))
+ (string-match gnus-article-unfold-long-headers
+ header)))))
(with-temp-buffer
(insert header)
(goto-char (point-min))
(apply 'gnus-create-image png 'png t
(cdr (assq 'png gnus-face-properties-alist))))
(goto-char from)
- (gnus-add-wash-type 'face)
- (gnus-add-image 'face image)
- (gnus-put-image image nil 'face))))))))))
+ (when image
+ (gnus-add-wash-type 'face)
+ (gnus-add-image 'face image)
+ (gnus-put-image image nil 'face)))))))))))
(defun article-display-x-face (&optional force)
"Look for an X-Face header and display it if present."
(while (re-search-forward
"\\(\\(https?\\|ftp\\)://\\S-+\\) *\n\\(\\S-+\\)" nil t)
(replace-match "\\1\\3" t)))
- (when (interactive-p)
+ (when (gmm-called-interactively-p 'any)
(gnus-treat-article nil))))
(defun article-wash-html ()
(let ((handles nil)
(buffer-read-only nil))
(when (gnus-buffer-live-p gnus-original-article-buffer)
- (setq handles (mm-dissect-buffer t t)))
+ (with-current-buffer gnus-original-article-buffer
+ (setq handles (mm-dissect-buffer t t))))
(article-goto-body)
(delete-region (point) (point-max))
(mm-enable-multibyte)
(or how (setq how gnus-article-browse-delete-temp))
(if (eq how 'ask)
(let ((files (length gnus-article-browse-html-temp-list)))
- (gnus-y-or-n-p
- (if (= files 1)
- "Delete the temporary HTML file? "
- (format "Delete all %s temporary HTML files? "
- files))))
+ (or (gnus-y-or-n-p
+ (if (= files 1)
+ "Delete the temporary HTML file? "
+ (format "Delete all %s temporary HTML files? "
+ files)))
+ (setq gnus-article-browse-html-temp-list nil)))
how)))
(dolist (file gnus-article-browse-html-temp-list)
(cond ((file-directory-p file)
;; Add a meta html tag to specify charset and a header.
(cond
(header
- (let (title eheader body hcharset coding force-charset)
+ (let (title eheader body hcharset coding)
(with-temp-buffer
(mm-enable-multibyte)
(setq case-fold-search t)
(insert header "\n")
(setq title (message-fetch-field "subject"))
(goto-char (point-min))
- (while (re-search-forward "\\(<\\)\\|\\(>\\)\\|&" nil t)
+ (while (re-search-forward "\\(<\\)\\|\\(>\\)\\|\\(&\\)\\|\n"
+ nil t)
(replace-match (cond ((match-beginning 1) "<")
((match-beginning 2) ">")
- (t "&"))))
+ ((match-beginning 3) "&")
+ (t "<br>\n"))))
(goto-char (point-min))
- (insert "<pre>\n")
+ (insert "<div align=\"left\">\n")
(goto-char (point-max))
- (insert "</pre>\n<hr>\n")
+ (insert "</div>\n<hr>\n")
;; We have to examine charset one by one since
;; charset specified in parts might be different.
(if (eq charset 'gnus-decoded)
charset)
title (when title
(mm-encode-coding-string title charset))
- body (mm-encode-coding-string content charset)
- force-charset t)
+ body (mm-encode-coding-string content charset))
(setq hcharset (mm-find-mime-charset-region (point-min)
(point-max)))
(cond ((= (length hcharset) 1)
&
projects / gnus / blobdiff