X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-art.el;h=bf1b1b5b3658366acf009bb2db1b832654d148ab;hb=84f33dd19f522a59528341682bf9093c2834bab1;hp=1fcdfa193b65c1ee6fcad6a35c8e3c877c00fde1;hpb=f2d0a4889766f0387f6423f52502ea4842f83846;p=gnus diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 1fcdfa193..bf1b1b5b3 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -1636,6 +1636,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 +2120,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 +2277,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 +4294,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 +5851,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)) @@ -5992,7 +6044,7 @@ If displaying \"text/html\" is discouraged \(see (gnus-treat-article nil (length gnus-article-mime-handle-alist) (gnus-article-mime-total-parts) - (mm-handle-media-type handle)))))) + (mm-handle-media-type preferred)))))) (goto-char (point-max)) (setcdr begend (point-marker))))) (when ibegend @@ -8034,6 +8086,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 +8147,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 +8157,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 @@ -8255,16 +8308,19 @@ For example: ;;; Treatment top-level handling. ;;; -(defun gnus-treat-article (condition &optional part-number total-parts type) - (let ((length (- (point-max) (point-min))) +(defvar gnus-inhibit-article-treatments nil) + +(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) @@ -8277,6 +8333,8 @@ For example: (symbol-value (car elem)))) (when (and (or (consp val) treated-type) + (or (not gnus-inhibit-article-treatments) + (eq gnus-treat-condition 'head)) (gnus-treat-predicate val) (or (not (get (car elem) 'highlight)) highlightp)) @@ -8286,16 +8344,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) @@ -8311,7 +8369,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) @@ -8323,7 +8381,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))))