X-Git-Url: https://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fmm-view.el;h=42e21cad514dd0a310abf4ee6da3c613be54a1a6;hp=5abeea16812a8eb38cba83fce358f55e7015a594;hb=e200fdc58ef97f1b02534d49a588c5721101b696;hpb=c358f44b1670d12d5eff5fe5a447a19afd34a252 diff --git a/lisp/mm-view.el b/lisp/mm-view.el index 5abeea168..42e21cad5 100644 --- a/lisp/mm-view.el +++ b/lisp/mm-view.el @@ -1,25 +1,23 @@ ;;; mm-view.el --- functions for viewing MIME objects -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, +;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; 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, or (at your option) -;; any later version. +;; 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 +;; 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; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -33,12 +31,11 @@ (require 'mm-decode) (require 'smime) -(eval-and-compile - (autoload 'gnus-article-prepare-display "gnus-art") - (autoload 'vcard-parse-string "vcard") - (autoload 'vcard-format-string "vcard") - (autoload 'fill-flowed "flow-fill") - (autoload 'html2text "html2text" nil t)) +(autoload 'gnus-article-prepare-display "gnus-art") +(autoload 'vcard-parse-string "vcard") +(autoload 'vcard-format-string "vcard") +(autoload 'fill-flowed "flow-fill") +(autoload 'html2text "html2text" nil t) (defvar gnus-article-mime-handles) (defvar gnus-newsgroup-charset) @@ -86,14 +83,14 @@ (defun mm-inline-image-emacs (handle) (let ((b (point-marker)) - buffer-read-only) + (inhibit-read-only t)) (put-image (mm-get-image handle) b) (insert "\n\n") (mm-handle-set-undisplayer handle `(lambda () (let ((b ,b) - buffer-read-only) + (inhibit-read-only t)) (remove-images b b) (delete-region b (+ b 2))))))) @@ -102,12 +99,12 @@ (insert "\n\n") (forward-char -2) (let ((annot (make-annotation (mm-get-image handle) nil 'text)) - buffer-read-only) + (inhibit-read-only t)) (mm-handle-set-undisplayer handle `(lambda () (let ((b ,(point-marker)) - buffer-read-only) + (inhibit-read-only t)) (delete-annotation ,annot) (delete-region (- b 2) b)))) (set-extent-property annot 'mm t) @@ -194,13 +191,12 @@ (mm-handle-set-undisplayer handle `(lambda () - (let (buffer-read-only) + (let ((inhibit-read-only t)) ,@(if (functionp 'remove-specifier) - '((mapcar (lambda (prop) - (remove-specifier - (face-property 'default prop) - (current-buffer))) - '(background background-pixmap foreground)))) + '((dolist (prop '(background background-pixmap foreground)) + (remove-specifier + (face-property 'default prop) + (current-buffer))))) (delete-region ,(point-min-marker) ,(point-max-marker))))))))) @@ -262,14 +258,35 @@ (let ((w3m-safe-url-regexp mm-w3m-safe-url-regexp) w3m-force-redisplay) (w3m-region (point-min) (point-max) nil charset)) + ;; Put the mark meaning this part was rendered by emacs-w3m. + (put-text-property (point-min) (point-max) + 'mm-inline-text-html-with-w3m t) (when (and mm-inline-text-html-with-w3m-keymap (boundp 'w3m-minor-mode-map) w3m-minor-mode-map) - (add-text-properties - (point-min) (point-max) - (list 'keymap w3m-minor-mode-map - ;; Put the mark meaning this part was rendered by emacs-w3m. - 'mm-inline-text-html-with-w3m t))) + (if (and (boundp 'w3m-link-map) + w3m-link-map) + (let* ((start (point-min)) + (end (point-max)) + (on (get-text-property start 'w3m-href-anchor)) + (map (copy-keymap w3m-link-map)) + next) + (set-keymap-parent map w3m-minor-mode-map) + (while (< start end) + (if on + (progn + (setq next (or (text-property-any start end + 'w3m-href-anchor nil) + end)) + (put-text-property start next 'keymap map)) + (setq next (or (text-property-not-all start end + 'w3m-href-anchor nil) + end)) + (put-text-property start next 'keymap w3m-minor-mode-map)) + (setq start next + on (not on)))) + (put-text-property (point-min) (point-max) + 'keymap w3m-minor-mode-map))) (mm-handle-set-undisplayer handle `(lambda () @@ -289,7 +306,7 @@ (let ((coding-system-for-write 'iso-2022-jp) (coding-system-for-read 'iso-2022-jp) (str (mm-decode-coding-string "\ -\e$B#D#o#e#s!!#w#3#m!!#s#u#p#p#o#r#t#s!!#m#1#7#n!)\e(B" 'iso-2022-jp))) +\e$B#D#o#e#s!!#w#3#m!!#s#u#p#p#o#r#t!!#m#1#7#n!)\e(B" 'iso-2022-jp))) (mm-with-multibyte-buffer (insert str) (call-process-region @@ -389,7 +406,7 @@ (defun mm-inline-text-html (handle) (let* ((func (or mm-inline-text-html-renderer mm-text-html-renderer)) (entry (assq func mm-text-html-renderer-alist)) - buffer-read-only) + (inhibit-read-only t)) (if entry (setq func (cdr entry))) (cond @@ -399,7 +416,7 @@ (apply (car func) handle (cdr func)))))) (defun mm-inline-text-vcard (handle) - (let (buffer-read-only) + (let ((inhibit-read-only t)) (mm-insert-inline handle (concat "\n-- \n" @@ -415,7 +432,7 @@ (type (mm-handle-media-subtype handle)) (charset (mail-content-type-get (mm-handle-type handle) 'charset)) - buffer-read-only) + (inhibit-read-only t)) (if (or (eq charset 'gnus-decoded) ;; This is probably not entirely correct, but ;; makes rfc822 parts with embedded multiparts work. @@ -437,15 +454,14 @@ (goto-char (point-max)))) (save-restriction (narrow-to-region b (point)) - (when (or (equal type "enriched") - (equal type "richtext")) - (set-text-properties (point-min) (point-max) nil) + (when (member type '("enriched" "richtext")) + (set-text-properties (point-min) (point-max) nil) (ignore-errors (enriched-decode (point-min) (point-max)))) (mm-handle-set-undisplayer handle `(lambda () - (let (buffer-read-only) + (let ((inhibit-read-only t)) (delete-region ,(point-min-marker) ,(point-max-marker)))))))) @@ -458,9 +474,9 @@ (mm-handle-set-undisplayer handle `(lambda () - (let (buffer-read-only) - (delete-region ,(set-marker (make-marker) b) - ,(set-marker (make-marker) (point)))))))) + (let ((inhibit-read-only t)) + (delete-region ,(copy-marker b) + ,(copy-marker (point)))))))) (defun mm-inline-audio (handle) (message "Not implemented")) @@ -527,13 +543,12 @@ (mm-handle-set-undisplayer handle `(lambda () - (let (buffer-read-only) + (let ((inhibit-read-only t)) (if (fboundp 'remove-specifier) ;; This is only valid on XEmacs. - (mapcar (lambda (prop) - (remove-specifier - (face-property 'default prop) (current-buffer))) - '(background background-pixmap foreground))) + (dolist (prop '(background background-pixmap foreground)) + (remove-specifier + (face-property 'default prop) (current-buffer)))) (delete-region ,(point-min-marker) ,(point-max-marker))))))))) (defun mm-display-inline-fontify (handle mode) @@ -605,22 +620,14 @@ ;; id-signedData OBJECT IDENTIFIER ::= { iso(1) member-body(2) ;; us(840) rsadsi(113549) pkcs(1) pkcs7(7) 2 } (defvar mm-pkcs7-signed-magic - (mm-string-as-unibyte - (mapconcat 'char-to-string - (list ?\x30 ?\x5c ?\x28 ?\x80 ?\x5c ?\x7c ?\x81 ?\x2e ?\x5c - ?\x7c ?\x82 ?\x2e ?\x2e ?\x5c ?\x7c ?\x83 ?\x2e ?\x2e - ?\x2e ?\x5c ?\x29 ?\x06 ?\x09 ?\x5c ?\x2a ?\x86 ?\x48 - ?\x86 ?\xf7 ?\x0d ?\x01 ?\x07 ?\x02) ""))) + "\x30\x5c\x28\x80\x5c\x7c\x81\x2e\x5c\x7c\x82\x2e\x2e\x5c\x7c\x83\x2e\x2e\ +\x2e\x5c\x29\x06\x09\x5c\x2a\x86\x48\x86\xf7\x0d\x01\x07\x02") ;; id-envelopedData OBJECT IDENTIFIER ::= { iso(1) member-body(2) ;; us(840) rsadsi(113549) pkcs(1) pkcs7(7) 3 } (defvar mm-pkcs7-enveloped-magic - (mm-string-as-unibyte - (mapconcat 'char-to-string - (list ?\x30 ?\x5c ?\x28 ?\x80 ?\x5c ?\x7c ?\x81 ?\x2e ?\x5c - ?\x7c ?\x82 ?\x2e ?\x2e ?\x5c ?\x7c ?\x83 ?\x2e ?\x2e - ?\x2e ?\x5c ?\x29 ?\x06 ?\x09 ?\x5c ?\x2a ?\x86 ?\x48 - ?\x86 ?\xf7 ?\x0d ?\x01 ?\x07 ?\x03) ""))) + "\x30\x5c\x28\x80\x5c\x7c\x81\x2e\x5c\x7c\x82\x2e\x2e\x5c\x7c\x83\x2e\x2e\ +\x2e\x5c\x29\x06\x09\x5c\x2a\x86\x48\x86\xf7\x0d\x01\x07\x03") (defun mm-view-pkcs7-get-type (handle) (mm-with-unibyte-buffer @@ -681,5 +688,5 @@ (provide 'mm-view) -;;; arch-tag: b60e749a-d05c-47f2-bccd-bdaa59327cb2 +;; arch-tag: b60e749a-d05c-47f2-bccd-bdaa59327cb2 ;;; mm-view.el ends here