message.el (message-mail): A compose-mail function should accept headers as strings.
[gnus] / lisp / gnus-art.el
index b1d28ca..3694426 100644 (file)
@@ -1,7 +1,7 @@
 ;;; gnus-art.el --- article mode commands for Gnus
 
 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;;   2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
@@ -1594,6 +1594,7 @@ predicate.  See Info node `(gnus)Customizing Articles'."
   "Fill long lines.
 Valid values are nil, t, `head', `first', `last', an integer or a
 predicate.  See Info node `(gnus)Customizing Articles'."
+  :version "24.1"
   :group 'gnus-article-treat
   :link '(custom-manual "(gnus)Customizing Articles")
   :type gnus-article-treat-custom)
@@ -1636,6 +1637,12 @@ This requires GNU Libidn, and by default only enabled if it is found."
   :group 'gnus-article
   :type 'boolean)
 
+(defcustom gnus-inhibit-images nil
+  "Non-nil means inhibit displaying of images inline in the article body."
+  :version "24.1"
+  :group 'gnus-article
+  :type 'boolean)
+
 (defcustom gnus-blocked-images 'gnus-block-private-groups
   "Images that have URLs matching this regexp will be blocked.
 This can also be a function to be evaluated.  If so, it will be
@@ -2114,6 +2121,35 @@ try this wash."
   (interactive)
   (article-translate-strings gnus-article-dumbquotes-map))
 
+(defvar org-entities)
+
+(defun article-treat-non-ascii ()
+  "Translate many Unicode characters into their ASCII equivalents."
+  (interactive)
+  (require 'org-entities)
+  (let ((table (make-char-table (if (featurep 'xemacs) 'generic))))
+    (dolist (elem org-entities)
+      (when (and (listp elem)
+                (= (length (nth 6 elem)) 1))
+       (if (featurep 'xemacs)
+           (put-char-table (aref (nth 6 elem) 0) (nth 4 elem) table)
+         (set-char-table-range table (aref (nth 6 elem) 0) (nth 4 elem)))))
+    (save-excursion
+      (when (article-goto-body)
+       (let ((inhibit-read-only t)
+             replace props)
+         (while (not (eobp))
+           (if (not (setq replace (if (featurep 'xemacs)
+                                      (get-char-table (following-char) table)
+                                    (aref table (following-char)))))
+               (forward-char 1)
+             (if (prog1
+                     (setq props (text-properties-at (point)))
+                   (delete-char 1))
+                 (add-text-properties (point) (progn (insert replace) (point))
+                                      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
@@ -2242,6 +2278,17 @@ unfolded."
     (dolist (elem gnus-article-image-alist)
       (gnus-delete-images (car elem)))))
 
+(defun gnus-article-show-images ()
+  "Show any images that are in the HTML-rendered article buffer.
+This only works if the article in question is HTML."
+  (interactive)
+  (gnus-with-article-buffer
+    (dolist (region (gnus-find-text-property-region (point-min) (point-max)
+                                                   'image-displayer))
+      (destructuring-bind (start end function) region
+       (funcall function (get-text-property start 'image-url)
+                start end)))))
+
 (defun gnus-article-treat-fold-newsgroups ()
   "Unfold folded message headers.
 Only the headers that fit into the current window width will be
@@ -4248,6 +4295,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
      article-date-lapsed
      article-emphasize
      article-treat-dumbquotes
+     article-treat-non-ascii
      article-normalize-headers
      ;;(article-show-all . gnus-article-show-all-headers)
      )))
@@ -5804,7 +5852,12 @@ If displaying \"text/html\" is discouraged \(see
        (while ignored
          (when (string-match (pop ignored) type)
            (throw 'ignored nil)))
-       (if (and (setq not-attachment
+       (if (and (not (and (if (gnus-buffer-live-p gnus-summary-buffer)
+                              (with-current-buffer gnus-summary-buffer
+                                gnus-inhibit-images)
+                            gnus-inhibit-images)
+                          (string-match "\\`image/" type)))
+                (setq not-attachment
                       (and (not (mm-inline-override-p handle))
                            (or (not (mm-handle-disposition handle))
                                (equal (car (mm-handle-disposition handle))
@@ -8034,6 +8087,7 @@ url is put as the `gnus-button-url' overlay property on the button."
          (Info-index-next 1)))
       nil)))
 
+(autoload 'pgg-snarf-keys-region "pgg")
 ;; Called after pgg-snarf-keys-region, which autoloads pgg.el.
 (declare-function pgg-display-output-buffer "pgg" (start end status))
 
@@ -8094,6 +8148,7 @@ url is put as the `gnus-button-url' overlay property on the button."
 
 (defun gnus-url-mailto (url)
   ;; Send mail to someone
+  (setq url (replace-regexp-in-string "\n" " " url))
   (when (string-match "mailto:/*\\(.*\\)" url)
     (setq url (substring url (match-beginning 1) nil)))
   (let (to args subject func)
@@ -8103,8 +8158,7 @@ url is put as the `gnus-button-url' overlay property on the button."
                  (if (string-match "^\\([^?]+\\)\\?\\(.*\\)" url)
                      (concat "to=" (match-string 1 url) "&"
                              (match-string 2 url))
-                   (concat "to=" url)))
-               t)
+                   (concat "to=" url))))
          subject (cdr-safe (assoc "subject" args)))
     (gnus-msg-mail)
     (while args
@@ -8257,16 +8311,17 @@ For example:
 
 (defvar gnus-inhibit-article-treatments nil)
 
-(defun gnus-treat-article (condition &optional part-number total-parts type)
-  (let ((length (- (point-max) (point-min)))
+(defun gnus-treat-article (gnus-treat-condition
+                          &optional part-number total-parts gnus-treat-type)
+  (let ((gnus-treat-length (- (point-max) (point-min)))
        (alist gnus-treatment-function-alist)
        (article-goto-body-goes-to-point-min-p t)
        (treated-type
-        (or (not type)
+        (or (not gnus-treat-type)
             (catch 'found
               (let ((list gnus-article-treat-types))
                 (while list
-                  (when (string-match (pop list) type)
+                  (when (string-match (pop list) gnus-treat-type)
                     (throw 'found t)))))))
        (highlightp (gnus-visual-p 'article-highlight 'highlight))
        val elem)
@@ -8279,7 +8334,8 @@ For example:
              (symbol-value (car elem))))
       (when (and (or (consp val)
                     treated-type)
-                (not gnus-inhibit-article-treatments)
+                (or (not gnus-inhibit-article-treatments)
+                    (eq gnus-treat-condition 'head))
                 (gnus-treat-predicate val)
                 (or (not (get (car elem) 'highlight))
                     highlightp))
@@ -8289,16 +8345,16 @@ For example:
 ;; Dynamic variables.
 (defvar part-number)
 (defvar total-parts)
-(defvar type)
-(defvar condition)
-(defvar length)
+(defvar gnus-treat-type)
+(defvar gnus-treat-condition)
+(defvar gnus-treat-length)
 
 (defun gnus-treat-predicate (val)
   (cond
    ((null val)
     nil)
-   (condition
-    (eq condition val))
+   (gnus-treat-condition
+    (eq gnus-treat-condition val))
    ((and (listp val)
         (stringp (car val)))
     (apply 'gnus-or (mapcar `(lambda (s)
@@ -8314,7 +8370,7 @@ For example:
        ((eq pred 'not)
        (not (gnus-treat-predicate (car val))))
        ((eq pred 'typep)
-       (equal (car val) type))
+       (equal (car val) gnus-treat-type))
        (t
        (error "%S is not a valid predicate" pred)))))
    ((eq val t)
@@ -8326,7 +8382,7 @@ For example:
    ((eq val 'last)
     (eq part-number total-parts))
    ((numberp val)
-    (< length val))
+    (< gnus-treat-length val))
    (t
     (error "%S is not a valid value" val))))