(contents-end . "<!--BODYEND-->"))
))
+(defvar nnshimbun-x-face-alist
+ '(("default" .
+ (("default" .
+ "X-Face: Ygq$6P.,%Xt$U)DS)cRY@k$VkW!7(X'X'?U{{osjjFG\"E]hND;SPJ-J?O?R|a?L
+ g2$0rVng=O3Lt}?~IId8Jj&vP^3*o=LKUyk(`t%0c!;t6REk=JbpsEn9MrN7gZ%"))))
+ "Alist of server vs. alist of group vs. X-Face field. It looks like:
+
+\((\"asahi\" . ((\"national\" . \"X-face: ***\")
+ (\"business\" . \"X-Face: ***\")
+ ;;
+ ;;
+ (\"default\" . \"X-face: ***\")))
+ (\"sponichi\" . ((\"baseball\" . \"X-face: ***\")
+ (\"soccer\" . \"X-Face: ***\")
+ ;;
+ ;;
+ (\"default\" . \"X-face: ***\")))
+ ;;
+ (\"default\" . ((\"default\" . \"X-face: ***\")))")
+
(defvoo nnshimbun-directory (nnheader-concat gnus-directory "shimbun/")
"Where nnshimbun will save its files.")
(defvoo nnshimbun-pre-fetch-article nil
"*Non nil means that nnshimbun fetch unread articles when scanning groups.")
-;; set by nnshimbun-possibly-change-server
+;; set by nnshimbun-possibly-change-group
(defvoo nnshimbun-buffer nil)
(defvoo nnshimbun-current-directory nil)
(defvoo nnshimbun-current-group nil)
(set-buffer (nnshimbun-open-nov group))
(and (nnheader-find-nov-line article)
(nnheader-parse-nov))))
- (let ((xref (substring (mail-header-xref header) 6)))
+ (let* ((xref (substring (mail-header-xref header) 6))
+ (x-faces (cdr (or (assoc (or server
+ (nnoo-current-server 'nnshimbun))
+ nnshimbun-x-face-alist)
+ (assoc "default" nnshimbun-x-face-alist))))
+ (x-face (cdr (or (assoc group x-faces)
+ (assoc "default" x-faces)))))
(save-excursion
(set-buffer nnshimbun-buffer)
(erase-buffer)
(nnshimbun-retrieve-url xref)
(nnheader-message 6 "nnshimbun: Make contents...")
(goto-char (point-min))
- (setq contents (funcall nnshimbun-make-contents header))
+ (setq contents (funcall nnshimbun-make-contents header x-face))
(nnheader-message 6 "nnshimbun: Make contents...done"))))
(when contents
(save-excursion
(nnshimbun-generate-nov-database group))
(deffoo nnshimbun-close-group (group &optional server)
+ (nnshimbun-write-nov group)
t)
(deffoo nnshimbun-request-list (&optional server)
(defun nnshimbun-generate-nov-database (group)
(prog1 (funcall nnshimbun-generate-nov group)
- (save-excursion
- (set-buffer (nnshimbun-open-nov group))
- (when (buffer-modified-p)
- (nnmail-write-region 1 (point-max) nnshimbun-nov-buffer-file-name
- nil 'nomesg)))))
+ (nnshimbun-write-nov group)))
(defun nnshimbun-generate-nov-for-each-group (group)
(nnshimbun-possibly-change-group group)
(goto-char (point-max))
(forward-line -1)
(setq i (or (ignore-errors (read (current-buffer))) 0))
- (goto-char (point-max))
(dolist (header (save-excursion
(set-buffer nnshimbun-buffer)
(erase-buffer)
(funcall nnshimbun-get-headers)))
(unless (nnshimbun-search-id group (mail-header-id header))
(mail-header-set-number header (setq i (1+ i)))
+ (goto-char (point-max))
(nnheader-insert-nov header)
(if nnshimbun-pre-fetch-article
(nnshimbun-request-article-1 i group nil nnshimbun-buffer)))))))
(goto-char (point-max))
(forward-line -1)
(setq i (or (ignore-errors (read (current-buffer))) 0))
- (goto-char (point-max))
(dolist (header (cdr list))
(unless (nnshimbun-search-id group (mail-header-id header))
(mail-header-set-number header (setq i (1+ i)))
+ (goto-char (point-max))
(nnheader-insert-nov header)
(if nnshimbun-pre-fetch-article
(nnshimbun-request-article-1 i group nil nnshimbun-buffer))))))))
(nnshimbun-save-nov)
(setq nnshimbun-nov-last-check (current-time)))))
-(defun nnshimbun-search-id (group id)
+(defun nnshimbun-search-id (group id &optional nov)
(save-excursion
(set-buffer (nnshimbun-open-nov group))
(goto-char (point-min))
- (let (number found)
+ (let (found)
(while (and (not found)
(search-forward id nil t)) ; We find the ID.
;; And the id is in the fourth field.
(if (not (and (search-backward "\t" nil t 4)
(not (search-backward "\t" (gnus-point-at-bol) t))))
(forward-line 1)
- (beginning-of-line)
- (setq found t)
- ;; We return the article number.
- (setq number (ignore-errors (read (current-buffer))))))
- number)))
+ (forward-line 0)
+ (setq found t)))
+ (unless found
+ (goto-char (point-min))
+ (when (search-forward (concat "X-Nnshimbun-Original-Id: " id) nil t)
+ (forward-line 0)
+ (setq found t)))
+ (if found
+ (if nov
+ (nnheader-parse-nov)
+ ;; We return the article number.
+ (ignore-errors (read (current-buffer))))))))
+
+(defun nnshimbun-nov-fix-header (group header args)
+ (save-excursion
+ (set-buffer (nnshimbun-open-nov group))
+ (when (nnheader-find-nov-line (mail-header-number header))
+ (dolist (arg args)
+ (if (eq (car arg) 'id)
+ (let ((extra (mail-header-extra header)) x)
+ (when (setq x (assq 'X-Nnshimbun-Original-Id extra))
+ (setq extra (delq x extra)))
+ (mail-header-set-extra
+ header
+ (cons (cons 'X-Nnshimbun-Original-Id (cdr arg)) extra)))
+ (let ((func (intern (concat "mail-header-set-" (symbol-name (car arg))))))
+ (if (cdr arg) (eval (list func header (cdr arg)))))))
+ (let ((xref (mail-header-xref header)))
+ (when (string-match "^Xref: " xref)
+ (mail-header-set-xref header (substring xref 6))))
+ (delete-region (point) (progn (forward-line 1) (point)))
+ (nnheader-insert-nov header))))
(defun nnshimbun-open-nov (group)
(let ((buffer (cdr (assoc group nnshimbun-nov-buffer-alist))))
(push (cons group buffer) nnshimbun-nov-buffer-alist)
buffer)))
+(defun nnshimbun-write-nov (group)
+ (let ((buffer (cdr (assoc group nnshimbun-nov-buffer-alist))))
+ (when (buffer-live-p buffer)
+ (save-excursion
+ (set-buffer buffer)
+ (buffer-modified-p)
+ (nnmail-write-region 1 (point-max) nnshimbun-nov-buffer-file-name
+ nil 'nomesg)))))
+
(defun nnshimbun-save-nov ()
(save-excursion
(while nnshimbun-nov-buffer-alist
(aref [nil "Jan" "Feb" "Mar" "Apr" "May" "Jun"
"Jul" "Aug" "Sep" "Oct" "Nov" "Dec"]
month)
- year
+ (cond ((< year 69)
+ (+ year 2000))
+ ((< year 100)
+ (+ year 1900))
+ ((< year 1000) ; possible 3-digit years.
+ (+ year 1900))
+ (t year))
(or time "00:00")))
(if (fboundp 'regexp-opt)
(defun nnshimbun-fill-line ()
(forward-line 0)
(let ((top (point)) chr)
- (while (if (>= (move-to-column fill-column) fill-column)
+ (while (if (>= (move-to-column nnshimbun-fill-column)
+ nnshimbun-fill-column)
(not (progn
(if (memq (preceding-char) nnshimbun-kinsoku-eol-list)
(progn
(delete-region (point) (point-max)))
(insert "\n"))
-(defun nnshimbun-make-text-or-html-contents (header)
+(defun nnshimbun-make-text-or-html-contents (header &optional x-face)
(let ((case-fold-search t) (html t) (start))
(when (and (search-forward nnshimbun-contents-start nil t)
(setq start (point))
(goto-char (point-min))
(nnshimbun-insert-header header)
(insert "Content-Type: " (if html "text/html" "text/plain")
- "; charset=ISO-2022-JP\nMIME-Version: 1.0\n\n")
+ "; charset=ISO-2022-JP\nMIME-Version: 1.0\n")
+ (when x-face
+ (insert x-face)
+ (unless (bolp)
+ (insert "\n")))
+ (insert "\n")
(encode-coding-string (buffer-string)
(mime-charset-to-coding-system "ISO-2022-JP"))))
-(defun nnshimbun-make-html-contents (header)
+(defun nnshimbun-make-html-contents (header &optional x-face)
(let (start)
(when (and (search-forward nnshimbun-contents-start nil t)
(setq start (point))
(delete-region (- (point) (length nnshimbun-contents-end)) (point-max)))
(goto-char (point-min))
(nnshimbun-insert-header header)
- (insert "Content-Type: text/html; charset=ISO-2022-JP\nMIME-Version: 1.0\n\n")
+ (insert "Content-Type: text/html; charset=ISO-2022-JP\n"
+ "MIME-Version: 1.0\n")
+ (when x-face
+ (insert x-face)
+ (unless (bolp)
+ (insert "\n")))
+ (insert "\n")
(encode-coding-string (buffer-string)
(mime-charset-to-coding-system "ISO-2022-JP"))))
(buffer-substring
(match-end 0)
(progn (search-forward "<br>" nil t) (point)))
- "<[^>]+>")
+ "\\(<[^>]+>\\|\r\\)")
""))
nnshimbun-from-address
"" id "" 0 0 (concat nnshimbun-url url))
projects / elisp / gnus.git- / blobdiff