Mercurial > emacs

comparison lisp/gnus/nnrss.el @ 90180:62afea0771d8

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Revision: miles@gnu.org--gnu-2005/emacs--unicode--0--patch-51 Merge from emacs--cvs-trunk--0 Patches applied: * emacs--cvs-trunk--0 (patch 289-301) - Update from CVS - Merge from gnus--rel--5.10 * gnus--rel--5.10 (patch 68) - Update from CVS
author Miles Bader <miles@gnu.org>
date Thu, 12 May 2005 03:41:19 +0000
parents d1245d218964
children 88db2adda4b7
comparison
equal deleted inserted replaced
90179:b745036dab36 90180:62afea0771d8
193 (text (if (nth 6 e) 193 (text (if (nth 6 e)
194 (mapconcat 'identity 194 (mapconcat 'identity
195 (delete "" (split-string (nth 6 e) "\n+")) 195 (delete "" (split-string (nth 6 e) "\n+"))
196 " "))) 196 " ")))
197 (link (nth 2 e)) 197 (link (nth 2 e))
198 (enclosure (nth 7 e))
198 ;; Enable encoding of Newsgroups header in XEmacs. 199 ;; Enable encoding of Newsgroups header in XEmacs.
199 (default-enable-multibyte-characters t) 200 (default-enable-multibyte-characters t)
200 (rfc2047-header-encoding-alist 201 (rfc2047-header-encoding-alist
201 (if (mm-coding-system-p 'utf-8) 202 (if (mm-coding-system-p 'utf-8)
202 (cons '("Newsgroups" . utf-8) 203 (cons '("Newsgroups" . utf-8)
203 rfc2047-header-encoding-alist) 204 rfc2047-header-encoding-alist)
204 rfc2047-header-encoding-alist)) 205 rfc2047-header-encoding-alist))
205 rfc2047-encode-encoded-words body) 206 rfc2047-encode-encoded-words body)
206 (when (or text link) 207 (when (or text link enclosure)
207 (insert "\n") 208 (insert "\n")
208 (insert "<#multipart type=alternative>\n" 209 (insert "<#multipart type=alternative>\n"
209 "<#part type=\"text/plain\">\n") 210 "<#part type=\"text/plain\">\n")
210 (setq body (point)) 211 (setq body (point))
211 (if text 212 (when text
212 (progn 213 (insert text "\n")
213 (insert text "\n") 214 (when (or link enclosure)
214 (when link 215 (insert "\n")))
215 (insert "\n" link "\n"))) 216 (when link
216 (when link 217 (insert link "\n"))
217 (insert link "\n"))) 218 (when enclosure
219 (insert (car enclosure) " "
220 (nth 2 enclosure) " "
221 (nth 3 enclosure) "\n"))
218 (setq body (buffer-substring body (point))) 222 (setq body (buffer-substring body (point)))
219 (insert "<#/part>\n" 223 (insert "<#/part>\n"
220 "<#part type=\"text/html\">\n" 224 "<#part type=\"text/html\">\n"
221 "<html><head></head><body>\n") 225 "<html><head></head><body>\n")
222 (when text 226 (when text
223 (insert text "\n")) 227 (insert text "\n"))
224 (when link 228 (when link
225 (insert "<p><a href=\"" link "\">link</a></p>\n")) 229 (insert "<p><a href=\"" link "\">link</a></p>\n"))
230 (when enclosure
231 (insert "<p><a href=\"" (car enclosure) "\">"
232 (cadr enclosure) "</a> " (nth 2 enclosure)
233 " " (nth 3 enclosure) "</p>\n"))
226 (insert "</body></html>\n" 234 (insert "</body></html>\n"
227 "<#/part>\n" 235 "<#/part>\n"
228 "<#/multipart>\n")) 236 "<#/multipart>\n"))
229 (condition-case nil 237 (condition-case nil
230 (mml-to-mime) 238 (mml-to-mime)
516 (buffer-string))) 524 (buffer-string)))
517 525
518 ;;; Snarf functions 526 ;;; Snarf functions
519 527
520 (defun nnrss-check-group (group server) 528 (defun nnrss-check-group (group server)
521 (let (file xml subject url extra changed author 529 (let (file xml subject url extra changed author date
522 date rss-ns rdf-ns content-ns dc-ns) 530 enclosure rss-ns rdf-ns content-ns dc-ns)
523 (if (and nnrss-use-local 531 (if (and nnrss-use-local
524 (file-exists-p (setq file (expand-file-name 532 (file-exists-p (setq file (expand-file-name
525 (nnrss-translate-file-chars 533 (nnrss-translate-file-chars
526 (concat group ".xml")) 534 (concat group ".xml"))
527 nnrss-directory)))) 535 nnrss-directory))))
565 (nnrss-node-text dc-ns 'creator item) 573 (nnrss-node-text dc-ns 'creator item)
566 (nnrss-node-text dc-ns 'contributor item))) 574 (nnrss-node-text dc-ns 'contributor item)))
567 (setq date (or (nnrss-node-text dc-ns 'date item) 575 (setq date (or (nnrss-node-text dc-ns 'date item)
568 (nnrss-node-text rss-ns 'pubDate item) 576 (nnrss-node-text rss-ns 'pubDate item)
569 (message-make-date))) 577 (message-make-date)))
578 (when (setq enclosure (cadr (assq (intern (concat rss-ns "enclosure")) item)))
579 (let ((url (cdr (assq 'url enclosure)))
580 (len (cdr (assq 'length enclosure)))
581 (type (cdr (assq 'type enclosure)))
582 (name))
583 (setq len
584 (if (and len (integerp (setq len (string-to-number len))))
585 ;; actually already in `ls-lisp-format-file-size' but
586 ;; probably not worth to require it for one function
587 (do ((size (/ len 1.0) (/ size 1024.0))
588 (post-fixes (list "" "k" "M" "G" "T" "P" "E")
589 (cdr post-fixes)))
590 ((< size 1024)
591 (format "%.1f%s" size (car post-fixes))))
592 "0"))
593 (setq url (or url ""))
594 (setq name (if (string-match "/\\([^/]*\\)$" url)
595 (match-string 1 url)
596 "file"))
597 (setq type (or type ""))
598 (setq enclosure (list url name len type))))
570 (push 599 (push
571 (list 600 (list
572 (incf nnrss-group-max) 601 (incf nnrss-group-max)
573 (current-time) 602 (current-time)
574 url 603 url
575 (and subject (nnrss-mime-encode-string subject)) 604 (and subject (nnrss-mime-encode-string subject))
576 (and author (nnrss-mime-encode-string author)) 605 (and author (nnrss-mime-encode-string author))
577 date 606 date
578 (and extra (nnrss-decode-entities-string extra))) 607 (and extra (nnrss-decode-entities-string extra))
608 enclosure)
579 nnrss-group-data) 609 nnrss-group-data)
580 (gnus-sethash (or url extra) t nnrss-group-hashtb) 610 (gnus-sethash (or url extra) t nnrss-group-hashtb)
581 (setq changed t)) 611 (setq changed t))
582 (setq extra nil)) 612 (setq extra nil))
583 (when changed 613 (when changed