Mercurial > hg > xemacs-beta

diff lisp/w3/url-news.el @ 173:8eaf7971accc r20-3b13

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b13
author cvs
date Mon, 13 Aug 2007 09:49:09 +0200
parents 441bb1e64a06
children
line wrap: on
line diff
--- a/lisp/w3/url-news.el	Mon Aug 13 09:47:55 2007 +0200
+++ b/lisp/w3/url-news.el	Mon Aug 13 09:49:09 2007 +0200
@@ -1,7 +1,7 @@
 ;;; url-news.el --- News Uniform Resource Locator retrieval code
 ;; Author: wmperry
-;; Created: 1997/02/18 23:35:11
-;; Version: 1.7
+;; Created: 1997/07/05 22:54:24
+;; Version: 1.8
 ;; Keywords: comm, data, processes
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -28,6 +28,15 @@
 (require 'url-vars)
 (require 'url-parse)
 
+(defgroup url-news nil
+  "News related options"
+  :group 'url)
+
+(defcustom url-news-use-article-mode nil
+  "*Whether to use Gnus' article mode for displaying news articles."
+  :type 'boolean
+  :group 'url-news)
+
 (defun url-format-news ()
   (url-clear-tmp-buffer)
   (insert "HTTP/1.0 200 Retrieval OK\r\n"
@@ -43,6 +52,7 @@
 	 (qorg  (if org (url-insert-entities-in-string org) nil))
 	 (typ   (or (cdr (assoc "content-type" url-current-mime-headers))
 		    "text/plain"))
+	 (inhibit-read-only t)
 	 (qgrps (mapcar 'car
 			(url-split
 			 (url-insert-entities-in-string
@@ -63,69 +73,85 @@
     (if (or (not (string-match "text/" typ))
  	    (string-match "text/html" typ))
  	nil				; Let natural content-type take over
-      (insert "<html>\n"
- 	      " <head>\n"
- 	      "  <title>" qsubj "</title>\n"
- 	      "  <link rev=\"made\" href=\"mailto:" qfrom "\">\n"
- 	      " </head>\n"
- 	      " <body>\n"
- 	      "  <div>\n"
- 	      "   <h1 align=center>" qsubj "</h1>\n"
- 	      "   <p role=\"headers\">\n"
- 	      "    <b>From</b>: " qfrom "<br>\n"
- 	      "    <b>Newsgroups</b>: "
- 	      (mapconcat
- 	       (function
- 		(lambda (grp)
- 		  (concat "<a href=\"" grp "\">" grp "</a>"))) qgrps ", ")
- 	      "<br>\n"
- 	      (if org
- 		  (concat
- 		   "    <b>Organization</b>: <i> " qorg "</i> <br>\n")
- 		"")
- 	      "    <b>Date</b>: <date> " date "</date> <br>\n"
- 	      "   </p> <hr>\n"
- 	      (if (null qrefs)
- 		  ""
- 		(concat
- 		 "   <p>References\n"
- 		 "    <ol>\n"
- 		 (mapconcat
- 		  (function
- 		   (lambda (ref)
- 		     (concat "     <li> <a href=\"" ref "\"> " 
- 			     ref "</a></li>\n")))
- 		  qrefs "")
- 		 "    </ol>\n"
-		 "   </p>\n"
- 		 "   <hr>\n"))
- 	      "   <ul plain>\n"
- 	      "    <li><a href=\"newspost:disfunctional\"> "
- 	      "Post to this group </a></li>\n"
- 	      "    <li><a href=\"mailto:" qfrom "\"> Reply to " qfrom
- 	      "</a></li>\n"
- 	      "   </ul>\n"
- 	      "   <hr>"
- 	      "   <pre>\n")
-      (let ((s (buffer-substring (point) (point-max))))
-	(delete-region (point) (point-max))
-	(insert (url-insert-entities-in-string s)))
-      (goto-char (point-max))
-      (setq url-current-mime-type "text/html"
- 	    url-current-mime-viewer (mm-mime-info url-current-mime-type nil 5))
-      (let ((x (assoc "content-type" url-current-mime-headers)))
- 	(if x
- 	    (setcdr x "text/html")
- 	  (setq url-current-mime-headers (cons (cons "content-type"
- 						     "text/html")
- 					       url-current-mime-headers))))
-      (insert "\n"
- 	      "   </pre>\n"
- 	      "  </div>\n"
- 	      " </body>\n"
- 	      "</html>\n"
- 	      "<!-- Automatically generated by URL/" url-version
- 	      "-->"))))
+      (if (and (fboundp 'gnus-article-mode)
+	       url-news-use-article-mode)
+	  (progn
+	    (kill-buffer (current-buffer))
+	    (set-buffer (get-buffer-create "Emacs/W3 News"))
+	    (erase-buffer)
+	    (insert
+	     (save-excursion
+	       (set-buffer nntp-server-buffer)
+	       (save-restriction
+		 (widen)
+		 (buffer-string))))
+	    (gnus-article-mode)
+	    (article-hide-headers 1)
+	    (goto-char (point-min))
+	    (display-buffer (current-buffer)))
+	(insert "<html>\n"
+		" <head>\n"
+		"  <title>" qsubj "</title>\n"
+		"  <link rev=\"made\" href=\"mailto:" qfrom "\">\n"
+		" </head>\n"
+		" <body>\n"
+		"  <div>\n"
+		"   <h1 align=center>" qsubj "</h1>\n"
+		"   <p role=\"headers\">\n"
+		"    <b>From</b>: " qfrom "<br>\n"
+		"    <b>Newsgroups</b>: "
+		(mapconcat
+		 (function
+		  (lambda (grp)
+		    (concat "<a href=\"" grp "\">" grp "</a>"))) qgrps ", ")
+		"<br>\n"
+		(if org
+		    (concat
+		     "    <b>Organization</b>: <i> " qorg "</i> <br>\n")
+		  "")
+		"    <b>Date</b>: <date> " date "</date> <br>\n"
+		"   </p> <hr>\n"
+		(if (null qrefs)
+		    ""
+		  (concat
+		   "   <p>References\n"
+		   "    <ol>\n"
+		   (mapconcat
+		    (function
+		     (lambda (ref)
+		       (concat "     <li> <a href=\"" ref "\"> " 
+			       ref "</a></li>\n")))
+		    qrefs "")
+		   "    </ol>\n"
+		   "   </p>\n"
+		   "   <hr>\n"))
+		"   <ul plain>\n"
+		"    <li><a href=\"newspost:disfunctional\"> "
+		"Post to this group </a></li>\n"
+		"    <li><a href=\"mailto:" qfrom "\"> Reply to " qfrom
+		"</a></li>\n"
+		"   </ul>\n"
+		"   <hr>"
+		"   <pre>\n")
+	(let ((s (buffer-substring (point) (point-max))))
+	  (delete-region (point) (point-max))
+	  (insert (url-insert-entities-in-string s)))
+	(goto-char (point-max))
+	(setq url-current-mime-type "text/html"
+	      url-current-mime-viewer (mm-mime-info url-current-mime-type nil 5))
+	(let ((x (assoc "content-type" url-current-mime-headers)))
+	  (if x
+	      (setcdr x "text/html")
+	    (setq url-current-mime-headers (cons (cons "content-type"
+						       "text/html")
+						 url-current-mime-headers))))
+	(insert "\n"
+		"   </pre>\n"
+		"  </div>\n"
+		" </body>\n"
+		"</html>\n"
+		"<!-- Automatically generated by URL/" url-version
+		"-->")))))
 
 (defun url-check-gnus-version ()
   (require 'nntp)