X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-art.el;h=44b026ab830f5976949d77e1b2e4a1fa645b0353;hb=4b3bd6c2717eaec8fc48bf729db7ce9580d5bc24;hp=a7140cf1760968946ffde85dd365d62ca2f1263a;hpb=7a783418c081e681aa35d06bd1ffc3521849dd5d;p=gnus

diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el
index a7140cf17..44b026ab8 100644
--- a/lisp/gnus-art.el
+++ b/lisp/gnus-art.el
@@ -51,6 +51,7 @@
 (autoload 'ansi-color-apply-on-region "ansi-color")
 (autoload 'mm-url-insert-file-contents-external "mm-url")
 (autoload 'mm-extern-cache-contents "mm-extern")
+(autoload 'url-expand-file-name "url-expand")
 
 (defgroup gnus-article nil
   "Article display."
@@ -255,12 +256,10 @@ This can also be a list of the above values."
   :group 'gnus-article-signature)
 
 (defcustom gnus-hidden-properties
-  (if (featurep 'xemacs)
-      ;; `intangible' is evil, but I keep it here in case it's useful.
-      '(invisible t intangible t)
-    ;; Emacs's command loop moves point out of invisible text anyway, so
-    ;; `intangible' is clearly not needed there.
-    '(invisible t))
+  ;; We use to have `intangible' here as well, but Emacs's command loop moves
+  ;; point out of invisible text anyway, so `intangible' is clearly not
+  ;; needed there.  And XEmacs doesn't handle `intangible' anyway.
+  '(invisible t)
   "Property list to use for hiding text."
   :type 'sexp
   :group 'gnus-article-hiding)
@@ -1629,8 +1628,11 @@ It is a string, such as \"PGP\". If nil, ask user."
 
 (defvar idna-program)
 
-(defcustom gnus-use-idna (and (condition-case nil (require 'idna) (file-error))
-			      (mm-coding-system-p 'utf-8)
+(defcustom gnus-use-idna (and (mm-coding-system-p 'utf-8)
+			      (condition-case nil
+				  (require 'idna)
+				(file-error)
+				(invalid-operation))
 			      idna-program
 			      (executable-find idna-program))
   "Whether IDNA decoding of headers is used when viewing messages.
@@ -1772,19 +1774,12 @@ Initialized from `text-mode-syntax-table.")
   (re-search-forward (concat "^\\(" header "\\):") nil t))
 
 (defsubst gnus-article-hide-text (b e props)
-  "Set text PROPS on the B to E region, extending `intangible' 1 past B."
-  (gnus-add-text-properties-when 'article-type nil b e props)
-  (when (memq 'intangible props)
-    (put-text-property
-     (max (1- b) (point-min))
-     b 'intangible (cddr (memq 'intangible props)))))
+  "Set text PROPS on the B to E region."
+  (gnus-add-text-properties-when 'article-type nil b e props))
 
 (defsubst gnus-article-unhide-text (b e)
   "Remove hidden text properties from region between B and E."
-  (remove-text-properties b e gnus-hidden-properties)
-  (when (memq 'intangible gnus-hidden-properties)
-    (put-text-property (max (1- b) (point-min))
-		       b 'intangible nil)))
+  (remove-text-properties b e gnus-hidden-properties))
 
 (defun gnus-article-hide-text-type (b e type)
   "Hide text of TYPE between B and E."
@@ -1796,10 +1791,7 @@ Initialized from `text-mode-syntax-table.")
   "Unhide text of TYPE between B and E."
   (gnus-delete-wash-type type)
   (remove-text-properties
-   b e (cons 'article-type (cons type gnus-hidden-properties)))
-  (when (memq 'intangible gnus-hidden-properties)
-    (put-text-property (max (1- b) (point-min))
-		       b 'intangible nil)))
+   b e (cons 'article-type (cons type gnus-hidden-properties))))
 
 (defun gnus-article-delete-text-of-type (type)
   "Delete text of TYPE in the current buffer."
@@ -2329,7 +2321,7 @@ long lines if and only if arg is positive."
       (goto-char (point-max))
       (let ((start (point)))
 	(insert "X-Boundary: ")
-	(gnus-add-text-properties start (point) '(invisible t intangible t))
+	(gnus-add-text-properties start (point) gnus-hidden-properties)
        (insert (let (str (max (window-width)))
                  (if (featurep 'xemacs)
                      (setq max (1- max)))
@@ -2795,9 +2787,9 @@ summary buffer."
 
 (defun gnus-article-browse-html-save-cid-content (cid handles directory)
   "Find CID content in HANDLES and save it in a file in DIRECTORY.
-Return file name."
+Return file name relative to the parent of DIRECTORY."
   (save-match-data
-    (let (file)
+    (let (file afile)
       (catch 'found
 	(dolist (handle handles)
 	  (cond
@@ -2810,16 +2802,16 @@ Return file name."
 			      cid handle directory))
 	      (throw 'found file)))
 	   ((equal (concat "<" cid ">") (mm-handle-id handle))
-	    (setq file
-		  (expand-file-name
-		   (or (mm-handle-filename handle)
-		       (concat
-			(make-temp-name "cid")
-			(car (rassoc (car (mm-handle-type handle))
-				     mailcap-mime-extensions))))
-		   directory))
-	    (mm-save-part-to-file handle file)
-	    (throw 'found file))))))))
+	    (setq file (or (mm-handle-filename handle)
+			   (concat
+			    (make-temp-name "cid")
+			    (car (rassoc (car (mm-handle-type handle))
+					 mailcap-mime-extensions))))
+		  afile (expand-file-name file directory))
+	    (mm-save-part-to-file handle afile)
+	    (throw 'found (concat (file-name-nondirectory
+				   (directory-file-name directory))
+				  "/" file)))))))))
 
 (defun gnus-article-browse-html-parts (list &optional header)
   "View all \"text/html\" parts from LIST.
@@ -2855,8 +2847,32 @@ message header will be added to the bodies of the \"text/html\" parts."
 	       (insert content)
 	       ;; resolve cid contents
 	       (let ((case-fold-search t)
-		     cid-file)
+		     st base regexp cid-file)
 		 (goto-char (point-min))
+		 (when (and (re-search-forward "<head[\t\n >]" nil t)
+			    (progn
+			      (setq st (match-end 0))
+			      (re-search-forward "</head[\t\n >]" nil t))
+			    (re-search-backward "<base\
+\\(?:[\t\n ]+[^\t\n >]+\\)*[\t\n ]+href=\"\\([^\"]+\\)\"[^>]*>" st t))
+		   (setq base (match-string 1))
+		   (replace-match "<!--\\&-->")
+		   (setq st (point))
+		   (dolist (tag '(("a" . "href") ("form" . "action")
+				  ("img" . "src")))
+		     (setq regexp (concat "<" (car tag)
+					  "\\(?:[\t\n ]+[^\t\n >]+\\)*[\t\n ]+"
+					  (cdr tag) "=\"\\([^\"]+\\)"))
+		     (while (re-search-forward regexp nil t)
+		       (insert (prog1
+				   (condition-case nil
+				       (save-match-data
+					 (url-expand-file-name (match-string 1)
+							       base))
+				     (error (match-string 1)))
+				 (delete-region (match-beginning 1)
+						(match-end 1)))))
+		     (goto-char st)))
 		 (while (re-search-forward "\
 <img[\t\n ]+\\(?:[^\t\n >]+[\t\n ]+\\)*src=\"\\(cid:\\([^\"]+\\)\\)\""
 					   nil t)
@@ -2871,16 +2887,7 @@ message header will be added to the bodies of the \"text/html\" parts."
 				(with-current-buffer gnus-article-buffer
 				  gnus-article-mime-handles)
 				cid-dir))
-		     (when (eq system-type 'cygwin)
-		       (setq cid-file
-			     (concat "/" (substring
-					  (with-output-to-string
-					    (call-process "cygpath" nil
-							  standard-output
-							  nil "-m" cid-file))
-					  0 -1))))
-		     (replace-match (concat "file://" cid-file)
-				    nil nil nil 1))))
+		     (replace-match cid-file nil nil nil 1))))
 	       (unless content (setq content (buffer-string))))
 	     (when (or charset header (not file))
 	       (setq tmp-file (mm-make-temp-file
@@ -5055,6 +5062,7 @@ and `gnus-mime-delete-part', and not provided at run-time normally."
     (let ((gnus-mime-buttonized-part-id current-id))
       (gnus-article-edit-done))
     (gnus-configure-windows 'article)
+    (sit-for 0)
     (when (and current-id (integerp gnus-auto-select-part))
       (gnus-article-jump-to-part
        (min (max (+ current-id gnus-auto-select-part) 1)
@@ -5350,7 +5358,10 @@ Compressed files like .gz and .bz2 are decompressed."
 							      'gnus-data))))
 	(setq b btn))
       (if (and (not arg) (mm-handle-undisplayer handle))
-	  (mm-remove-part handle)
+	  (progn
+	    (setq b (copy-marker b)
+		  btn (copy-marker btn))
+	    (mm-remove-part handle))
 	(cond
 	 ((not arg) nil)
 	 ((numberp arg)
@@ -5364,6 +5375,9 @@ Compressed files like .gz and .bz2 are decompressed."
 	  (forward-line 1))
 	(mm-display-inline handle))
       ;; Toggle the button appearance between `[button]...' and `[button]'.
+      (when (markerp btn)
+	(setq btn (prog1 (marker-position btn)
+		    (set-marker btn nil))))
       (goto-char btn)
       (let ((displayed-p (mm-handle-displayed-p handle)))
 	(gnus-insert-mime-button handle (get-text-property btn 'gnus-part)
@@ -5399,6 +5413,9 @@ Compressed files like .gz and .bz2 are decompressed."
 		   '((gnus-treat-highlight-headers
 		      gnus-article-highlight-headers))))
 	      (gnus-treat-article 'head)))))
+      (when (markerp b)
+	(setq b (prog1 (marker-position b)
+		  (set-marker b nil))))
       (goto-char b))))
 
 (defun gnus-mime-set-charset-parameters (handle charset)
@@ -5496,7 +5513,8 @@ If no internal viewer is available, use an external viewer."
         (gnus-mime-view-part-as-type
          nil (lambda (type) (mm-inlinable-p handle type)))
       (when handle
-	(gnus-bind-safe-url-regexp (mm-display-part handle))))))
+	(gnus-bind-safe-url-regexp
+	 (mm-display-part handle nil t))))))
 
 (defun gnus-mime-action-on-part (&optional action)
   "Do something with the MIME attachment at \(point\)."
@@ -5720,7 +5738,8 @@ all parts."
 		point (previous-single-property-change start 'gnus-data))
 	  (if (mm-handle-displayed-p handle)
 	      ;; This will remove the part.
-	      (setq retval (mm-display-part handle))
+	      (setq point (copy-marker point)
+		    retval (mm-display-part handle))
 	    (let ((part (or (and (mm-inlinable-p handle)
 				 (mm-inlined-p handle)
 				 t)
@@ -5751,6 +5770,9 @@ all parts."
 					    ,(point-max-marker)))))))
 		    (part
 		     (mm-display-inline handle))))))
+      (when (markerp point)
+	(setq point (prog1 (marker-position point)
+		      (set-marker point nil))))
       (goto-char point)
       ;; Toggle the button appearance between `[button]...' and `[button]'.
       (let ((displayed-p (mm-handle-displayed-p handle)))
@@ -6091,7 +6113,7 @@ If nil, don't show those extra buttons."
 	      (gnus-article-insert-newline)
 	    (if (prog1
 		    (= (skip-chars-backward "\n") -1)
-		  (forward-char 1))
+		  (unless (eobp) (forward-char 1)))
 		(gnus-article-insert-newline)
 	      (put-text-property (point) (point-max) 'gnus-undeletable t))
 	    (goto-char (point-max)))
@@ -6422,8 +6444,7 @@ in the body.  Use `gnus-header-face-alist' to highlight buttons."
 	      (dolist (button (nreverse buttons))
 		(setq st (point))
 		(insert " ")
-		(mm-handle-set-undisplayer
-		 (setq handle (copy-sequence (cdr button))) nil)
+		(mm-handle-set-undisplayer (setq handle (cdr button)) nil)
 		(gnus-insert-mime-button handle (car button))
 		(skip-chars-backward "\t\n ")
 		(delete-region (point) (point-max))
@@ -7187,6 +7208,8 @@ If given a prefix, show the hidden text instead."
 	  (set-buffer buf))))))
 
 (defun gnus-block-private-groups (group)
+  "Allows images in newsgroups to be shown, blocks images in all
+other groups."
   (if (or (gnus-news-group-p group)
 	  (gnus-member-of-valid 'global group))
       ;; Block nothing in news groups.