Commit 31640842 authored by Miles Bader's avatar Miles Bader
Browse files

Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-291

Merge from gnus--rel--5.10

Patches applied:

 * gnus--rel--5.10  (patch 68)

   - Update from CVS

2005-04-28  Katsumi Yamaoka  <yamaoka@jpl.org>

   * lisp/gnus/gnus-art.el (article-date-ut): Support converting date in
   forwarded parts as well.
   (gnus-article-save-original-date): New macro.
   (gnus-display-mime): Use it.

2005-04-28  David Hansen  <david.hansen@physik.fu-berlin.de>

   * lisp/gnus/nnrss.el (nnrss-check-group, nnrss-request-article): Support the
   enclosure element of <item>.
parent 6c9fb588
2005-04-28 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-art.el (article-date-ut): Support converting date in
forwarded parts as well.
(gnus-article-save-original-date): New macro.
(gnus-display-mime): Use it.
2005-04-28 David Hansen <david.hansen@physik.fu-berlin.de>
* nnrss.el (nnrss-check-group, nnrss-request-article): Support the
enclosure element of <item>.
2005-04-24 Teodor Zlatanov <tzz@lifelogs.com>
* spam-report.el (spam-report-unplug-agent)
......@@ -18,7 +30,7 @@
Process requests from `spam-report-requests-file'.
(spam-report-url-ping-mm-url): Autoload.
[Added missing offline functionality from trunk.]
2005-04-18 Katsumi Yamaoka <yamaoka@jpl.org>
* qp.el (quoted-printable-encode-region): Save excursion.
......
......@@ -2824,72 +2824,76 @@ lines forward."
(forward-line 1)
(setq ended t)))))
(defun article-date-ut (&optional type highlight header)
(defun article-date-ut (&optional type highlight)
"Convert DATE date to universal time in the current article.
If TYPE is `local', convert to local time; if it is `lapsed', output
how much time has lapsed since DATE. For `lapsed', the value of
`gnus-article-date-lapsed-new-header' says whether the \"X-Sent:\" header
should replace the \"Date:\" one, or should be added below it."
(interactive (list 'ut t))
(let* ((header (or header
(message-fetch-field "date")
""))
(tdate-regexp "^Date:[ \t]\\|^X-Sent:[ \t]")
(date-regexp
(cond
((not gnus-article-date-lapsed-new-header)
tdate-regexp)
((eq type 'lapsed)
"^X-Sent:[ \t]")
(t
"^Date:[ \t]")))
(date (if (vectorp header) (mail-header-date header)
header))
(let* ((tdate-regexp "^Date:[ \t]\\|^X-Sent:[ \t]")
(date-regexp (cond ((not gnus-article-date-lapsed-new-header)
tdate-regexp)
((eq type 'lapsed)
"^X-Sent:[ \t]")
(article-lapsed-timer
"^Date:[ \t]")
(t
tdate-regexp)))
(case-fold-search t)
(inhibit-read-only t)
(inhibit-point-motion-hooks t)
pos
bface eface)
pos date bface eface)
(save-excursion
(save-restriction
(article-narrow-to-head)
(when (re-search-forward tdate-regexp nil t)
(setq bface (get-text-property (gnus-point-at-bol) 'face)
date (or (get-text-property (gnus-point-at-bol)
'original-date)
date)
eface (get-text-property (1- (gnus-point-at-eol)) 'face))
(forward-line 1))
(when (and date (not (string= date "")))
(widen)
(goto-char (point-min))
(while (or (setq date (get-text-property (setq pos (point))
'original-date))
(when (setq pos (next-single-property-change
(point) 'original-date))
(setq date (get-text-property pos 'original-date))
t))
(narrow-to-region pos (or (text-property-any pos (point-max)
'original-date nil)
(point-max)))
(goto-char (point-min))
(let ((inhibit-read-only t))
;; Delete any old Date headers.
(while (re-search-forward date-regexp nil t)
(if pos
(delete-region (progn (beginning-of-line) (point))
(progn (gnus-article-forward-header)
(point)))
(delete-region (progn (beginning-of-line) (point))
(progn (gnus-article-forward-header)
(forward-char -1)
(point)))
(setq pos (point))))
(when (and (not pos)
(re-search-forward tdate-regexp nil t))
(forward-line 1))
(when pos
(goto-char pos))
(insert (article-make-date-line date (or type 'ut)))
(unless pos
(insert "\n")
(forward-line -1))
;; Do highlighting.
(beginning-of-line)
(when (looking-at "\\([^:]+\\): *\\(.*\\)$")
(put-text-property (match-beginning 1) (1+ (match-end 1))
'original-date date)
(put-text-property (match-beginning 1) (1+ (match-end 1))
'face bface)
(put-text-property (match-beginning 2) (match-end 2)
'face eface))))))))
(when (re-search-forward tdate-regexp nil t)
(setq bface (get-text-property (gnus-point-at-bol) 'face)
eface (get-text-property (1- (gnus-point-at-eol)) 'face)))
(goto-char (point-min))
(setq pos nil)
;; Delete any old Date headers.
(while (re-search-forward date-regexp nil t)
(if pos
(delete-region (gnus-point-at-bol)
(progn
(gnus-article-forward-header)
(point)))
(delete-region (gnus-point-at-bol)
(progn
(gnus-article-forward-header)
(forward-char -1)
(point)))
(setq pos (point))))
(when (and (not pos)
(re-search-forward tdate-regexp nil t))
(forward-line 1))
(gnus-goto-char pos)
(insert (article-make-date-line date (or type 'ut)))
(unless pos
(insert "\n")
(forward-line -1))
;; Do highlighting.
(beginning-of-line)
(when (looking-at "\\([^:]+\\): *\\(.*\\)$")
(put-text-property (match-beginning 1) (1+ (match-end 1))
'face bface)
(put-text-property (match-beginning 2) (match-end 2)
'face eface))
(put-text-property (point-min) (1- (point-max)) 'original-date date)
(goto-char (point-max))
(widen))))))
(defun article-make-date-line (date type)
"Return a DATE line of TYPE."
......@@ -3075,6 +3079,27 @@ This format is defined by the `gnus-article-time-format' variable."
(interactive (list t))
(article-date-ut 'iso8601 highlight))
(defmacro gnus-article-save-original-date (&rest forms)
"Save the original date as a text property and evaluate FORMS."
`(let* ((case-fold-search t)
(start (progn
(goto-char (point-min))
(when (and (re-search-forward "^date:[\t\n ]+" nil t)
(not (bolp)))
(match-end 0))))
(date (when (and start
(re-search-forward "[\t ]*\n\\([^\t ]\\|\\'\\)"
nil t))
(buffer-substring-no-properties start
(match-beginning 0)))))
(goto-char (point-max))
(skip-chars-backward "\n")
(put-text-property (point-min) (point) 'original-date date)
,@forms
(goto-char (point-max))
(skip-chars-backward "\n")
(put-text-property (point-min) (point) 'original-date date)))
;; (defun article-show-all ()
;; "Show all hidden text in the article buffer."
;; (interactive)
......@@ -4686,7 +4711,8 @@ N is the numerical prefix."
(save-restriction
(article-goto-body)
(narrow-to-region (point-min) (point))
(gnus-treat-article 'head))))))))
(gnus-article-save-original-date
(gnus-treat-article 'head)))))))))
(defcustom gnus-mime-display-multipart-as-mixed nil
"Display \"multipart\" parts as \"multipart/mixed\".
......
......@@ -195,6 +195,7 @@ for decoding when the cdr that the data specify is not available.")
(delete "" (split-string (nth 6 e) "\n+"))
" ")))
(link (nth 2 e))
(enclosure (nth 7 e))
;; Enable encoding of Newsgroups header in XEmacs.
(default-enable-multibyte-characters t)
(rfc2047-header-encoding-alist
......@@ -203,18 +204,21 @@ for decoding when the cdr that the data specify is not available.")
rfc2047-header-encoding-alist)
rfc2047-header-encoding-alist))
rfc2047-encode-encoded-words body)
(when (or text link)
(when (or text link enclosure)
(insert "\n")
(insert "<#multipart type=alternative>\n"
"<#part type=\"text/plain\">\n")
(setq body (point))
(if text
(progn
(insert text "\n")
(when link
(insert "\n" link "\n")))
(when link
(insert link "\n")))
(when text
(insert text "\n")
(when (or link enclosure)
(insert "\n")))
(when link
(insert link "\n"))
(when enclosure
(insert (car enclosure) " "
(nth 2 enclosure) " "
(nth 3 enclosure) "\n"))
(setq body (buffer-substring body (point)))
(insert "<#/part>\n"
"<#part type=\"text/html\">\n"
......@@ -223,6 +227,10 @@ for decoding when the cdr that the data specify is not available.")
(insert text "\n"))
(when link
(insert "<p><a href=\"" link "\">link</a></p>\n"))
(when enclosure
(insert "<p><a href=\"" (car enclosure) "\">"
(cadr enclosure) "</a> " (nth 2 enclosure)
" " (nth 3 enclosure) "</p>\n"))
(insert "</body></html>\n"
"<#/part>\n"
"<#/multipart>\n"))
......@@ -518,8 +526,8 @@ nnrss: %s: Not valid XML %s and w3-parse doesn't work %s"
;;; Snarf functions
(defun nnrss-check-group (group server)
(let (file xml subject url extra changed author
date rss-ns rdf-ns content-ns dc-ns)
(let (file xml subject url extra changed author date
enclosure rss-ns rdf-ns content-ns dc-ns)
(if (and nnrss-use-local
(file-exists-p (setq file (expand-file-name
(nnrss-translate-file-chars
......@@ -567,6 +575,27 @@ nnrss: %s: Not valid XML %s and w3-parse doesn't work %s"
(setq date (or (nnrss-node-text dc-ns 'date item)
(nnrss-node-text rss-ns 'pubDate item)
(message-make-date)))
(when (setq enclosure (cadr (assq (intern (concat rss-ns "enclosure")) item)))
(let ((url (cdr (assq 'url enclosure)))
(len (cdr (assq 'length enclosure)))
(type (cdr (assq 'type enclosure)))
(name))
(setq len
(if (and len (integerp (setq len (string-to-number len))))
;; actually already in `ls-lisp-format-file-size' but
;; probably not worth to require it for one function
(do ((size (/ len 1.0) (/ size 1024.0))
(post-fixes (list "" "k" "M" "G" "T" "P" "E")
(cdr post-fixes)))
((< size 1024)
(format "%.1f%s" size (car post-fixes))))
"0"))
(setq url (or url ""))
(setq name (if (string-match "/\\([^/]*\\)$" url)
(match-string 1 url)
"file"))
(setq type (or type ""))
(setq enclosure (list url name len type))))
(push
(list
(incf nnrss-group-max)
......@@ -575,7 +604,8 @@ nnrss: %s: Not valid XML %s and w3-parse doesn't work %s"
(and subject (nnrss-mime-encode-string subject))
(and author (nnrss-mime-encode-string author))
date
(and extra (nnrss-decode-entities-string extra)))
(and extra (nnrss-decode-entities-string extra))
enclosure)
nnrss-group-data)
(gnus-sethash (or url extra) t nnrss-group-hashtb)
(setq changed t))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment