From 03172ab11d342819a040a8feaf897ff66dbe6d52 Mon Sep 17 00:00:00 2001 From: keiichi Date: Tue, 1 Jun 1999 10:38:46 +0000 Subject: [PATCH] Sync up with Chaos-1_13. --- lisp/gnus-art.el | 219 ++++++++++------------------------- lisp/gnus-draft.el | 2 +- lisp/gnus-i18n.el | 2 +- lisp/gnus-msg.el | 2 +- lisp/gnus-score.el | 55 +++++++-- lisp/gnus-setup.el | 2 +- lisp/gnus-sum.el | 5 +- lisp/message.el | 2 +- lisp/mmgnus.el | 84 +++++++++----- lisp/nnheader.el | 326 ++++++++++++++++++++++++++++++++++++++++++---------- 10 files changed, 437 insertions(+), 262 deletions(-) diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index b67fa90..13c4c56 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -2,7 +2,7 @@ ;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen -;; MORIOKA Tomohiko +;; MORIOKA Tomohiko ;; Katsumi Yamaoka ;; Keywords: mail, news, MIME @@ -391,6 +391,13 @@ The function is called from the article buffer." :group 'gnus-article-mime :type 'function) +(defcustom gnus-article-display-method-for-encoded-word + 'gnus-article-display-message-with-encoded-word + "*Function to display a message with MIME encoded-words. +The function is called from the article buffer." + :group 'gnus-article-mime + :type 'function) + (defcustom gnus-article-display-method-for-traditional 'gnus-article-display-traditional-message "*Function to display a traditional message. @@ -2011,37 +2018,23 @@ commands: (erase-buffer) (insert-buffer-substring gnus-original-article-buffer))) -(defun gnus-article-make-full-mail-header (&optional number charset) - "Create a new mail header structure in a raw article buffer." - (unless (and number charset) - (save-current-buffer - (set-buffer gnus-summary-buffer) - (unless number - (setq number (or (cdr gnus-article-current) 0))) - (unless charset - (setq charset (or default-mime-charset 'x-ctext))))) - (goto-char (point-min)) - (let ((header-end (if (search-forward "\n\n" nil t) - (1- (point)) - (goto-char (point-max)))) - (chars (- (point-max) (point))) - (lines (count-lines (point) (point-max))) - (default-mime-charset charset) - xref) - (narrow-to-region (point-min) header-end) - (setq xref (std11-fetch-field "xref")) - (prog1 - (make-full-mail-header - number - (std11-fetch-field "subject") - (std11-fetch-field "from") - (std11-fetch-field "date") - (std11-fetch-field "message-id") - (std11-fetch-field "references") - chars - lines - (when xref (concat "Xref: " xref))) - (widen)))) +(defun gnus-article-display-message-with-encoded-word () + "Article display method for message with encoded-words." + (let ((charset (save-excursion + (set-buffer gnus-summary-buffer) + default-mime-charset))) + (make-local-variable 'default-mime-charset) + (setq default-mime-charset charset) + (gnus-article-display-traditional-message) + (make-local-variable 'default-mime-charset) + (setq default-mime-charset charset) + (let (buffer-read-only) + (mime-decode-header-in-buffer charset) + (goto-char (point-min)) + (if (search-forward "\n\n" nil t) + (decode-mime-charset-region (match-end 0) (point-max) charset))) + (mime-maybe-hide-echo-buffer)) + (gnus-run-hooks 'gnus-mime-article-prepare-hook)) (defun gnus-article-prepare (article &optional all-headers header) "Prepare ARTICLE in article mode buffer. @@ -2136,7 +2129,33 @@ If ALL-HEADERS is non-nil, no headers are hidden." (or all-headers gnus-show-all-headers)))) (when (or (numberp article) (stringp article)) - (gnus-article-prepare-display) + ;; Hooks for getting information from the article. + ;; This hook must be called before being narrowed. + (let ((method + (if gnus-show-mime + (progn + (setq mime-message-structure gnus-current-headers) + (mime-buffer-entity-set-buffer-internal + mime-message-structure + gnus-original-article-buffer) + (mime-entity-set-representation-type-internal + mime-message-structure 'mime-buffer-entity) + (luna-send mime-message-structure + 'initialize-instance + mime-message-structure) + (if (or (not gnus-strict-mime) + (mime-fetch-field "MIME-Version")) + gnus-article-display-method-for-mime + gnus-article-display-method-for-encoded-word)) + gnus-article-display-method-for-traditional))) + (gnus-run-hooks 'gnus-tmp-internal-hook) + (gnus-run-hooks 'gnus-article-prepare-hook) + ;; Display message. + (funcall method) + ;; Associate this article with the current summary buffer. + (setq gnus-article-current-summary summary-buffer) + ;; Perform the article display hooks. + (gnus-run-hooks 'gnus-article-display-hook)) ;; Do page break. (goto-char (point-min)) (setq gnus-page-broken @@ -2150,23 +2169,6 @@ If ALL-HEADERS is non-nil, no headers are hidden." (set-window-point (get-buffer-window (current-buffer)) (point)) t)))))) -(defun gnus-article-prepare-display () - "Make the current buffer look like a nice article." - (let ((method - (if gnus-show-mime - (progn - (setq mime-message-structure gnus-current-headers) - gnus-article-display-method-for-mime) - gnus-article-display-method-for-traditional))) - (gnus-run-hooks 'gnus-tmp-internal-hook) - (gnus-run-hooks 'gnus-article-prepare-hook) - ;; Display message. - (funcall method) - ;; Associate this article with the current summary buffer. - (setq gnus-article-current-summary gnus-summary-buffer) - ;; Perform the article display hooks. - (gnus-run-hooks 'gnus-article-display-hook))) - (defun gnus-article-wash-status () "Return a string which display status of article washing." (save-excursion @@ -2596,12 +2598,6 @@ If given a prefix, show the hidden text instead." :group 'gnus-article-various :type 'hook) -(defcustom gnus-article-edit-article-setup-function - 'gnus-article-mime-edit-article-setup - "Function called to setup an editing article buffer." - :group 'gnus-article-various - :type 'function) - (defvar gnus-article-edit-done-function nil) (defvar gnus-article-edit-mode-map nil) @@ -2659,8 +2655,6 @@ groups." (gnus-configure-windows 'edit-article) (setq gnus-article-edit-done-function exit-func) (setq gnus-prev-winconf winconf) - (when gnus-article-edit-article-setup-function - (funcall gnus-article-edit-article-setup-function)) (gnus-message 6 "C-c C-c to end edits"))) (defun gnus-article-edit-done (&optional arg) @@ -2691,8 +2685,6 @@ groups." (let ((func gnus-article-edit-done-function) (buf (current-buffer)) (start (window-start))) - (remove-hook 'gnus-article-mode-hook - 'gnus-article-mime-edit-article-unwind) (gnus-article-edit-exit) (save-excursion (set-buffer buf) @@ -2744,86 +2736,6 @@ groups." (query-replace-regexp "\\([.!?][])}]* \\)\\([[({A-Z]\\)" "\\1 \\2")))) ;;; -;;; Article editing with MIME-Edit -;;; - -(defcustom gnus-article-mime-edit-article-setup-hook nil - "Hook run after setting up a MIME editing article buffer." - :group 'gnus-article-various - :type 'hook) - -(defun gnus-article-mime-edit-article-unwind () - "Unwind `gnus-article-buffer' if article editing was given up." - (remove-hook 'gnus-article-mode-hook 'gnus-article-mime-edit-article-unwind) - (when mime-edit-mode-flag - (mime-edit-exit 'nomime 'no-error) - (message "")) - (when (featurep 'font-lock) - (setq font-lock-defaults nil) - (font-lock-mode 0))) - -(defun gnus-article-mime-edit-article-setup () - "Convert current buffer to MIME-Edit buffer and turn on MIME-Edit mode -after replacing with the original article." - (setq gnus-show-mime t) - (setq gnus-article-edit-done-function - `(lambda (&rest args) - (when mime-edit-mode-flag - (mime-edit-exit) - (message "")) - (goto-char (point-min)) - (let (case-fold-search) - (when (re-search-forward - (format "^%s$" (regexp-quote mail-header-separator)) - nil t) - (replace-match ""))) - (when (featurep 'font-lock) - (setq font-lock-defaults nil) - (font-lock-mode 0)) - (apply ,gnus-article-edit-done-function args) - (set-buffer gnus-original-article-buffer) - (erase-buffer) - (insert-buffer gnus-article-buffer) - (setq gnus-current-headers (gnus-article-make-full-mail-header)) - (gnus-article-prepare-display))) - (define-key (current-local-map) "\C-c\C-k" 'gnus-article-mime-edit-exit) - (erase-buffer) - (insert-buffer gnus-original-article-buffer) - (mime-edit-again) - (when (featurep 'font-lock) - (set (make-local-variable 'font-lock-defaults) - '(message-font-lock-keywords t)) - (font-lock-set-defaults) - (turn-on-font-lock)) - (add-hook 'gnus-article-mode-hook 'gnus-article-mime-edit-article-unwind) - (gnus-run-hooks 'gnus-article-mime-edit-article-setup-hook)) - -(defun gnus-article-mime-edit-exit () - "Exit the article MIME editing without updating." - (interactive) - (let ((winconf gnus-prev-winconf) - buf) - (when mime-edit-mode-flag - (mime-edit-exit) - (message "")) - (goto-char (point-min)) - (let (case-fold-search) - (when (re-search-forward - (format "^%s$" (regexp-quote mail-header-separator)) nil t) - (replace-match ""))) - (when (featurep 'font-lock) - (setq font-lock-defaults nil) - (font-lock-mode 0)) - ;; We remove all text props from the article buffer. - (setq buf (format "%s" (buffer-string))) - (set-buffer (get-buffer-create gnus-original-article-buffer)) - (erase-buffer) - (insert buf) - (setq gnus-current-headers (gnus-article-make-full-mail-header)) - (gnus-article-prepare-display) - (set-window-configuration winconf))) - -;;; ;;; Article highlights ;;; @@ -3407,17 +3319,22 @@ forbidden in URL encoding." #'gnus-article-header-presentation-method) (defun gnus-mime-preview-quitting-method () - (mime-preview-kill-buffer) - (delete-other-windows) - (gnus-article-show-summary) - (gnus-summary-select-article gnus-show-all-headers t)) + (if gnus-show-mime + (gnus-article-show-summary) + (mime-preview-kill-buffer) + (delete-other-windows) + (gnus-article-show-summary) + (gnus-summary-select-article nil t) + )) (set-alist 'mime-preview-quitting-method-alist 'gnus-original-article-mode #'gnus-mime-preview-quitting-method) (defun gnus-following-method (buf) (set-buffer buf) - (message-followup) + (if (gnus-group-find-parameter gnus-newsgroup-name 'newsgroup) + (message-followup) + (message-wide-reply)) (message-yank-original) (kill-buffer buf) (goto-char (point-min)) @@ -3426,18 +3343,6 @@ forbidden in URL encoding." (set-alist 'mime-preview-following-method-alist 'gnus-original-article-mode #'gnus-following-method) -(set-alist 'mime-preview-over-to-previous-method-alist - 'gnus-original-article-mode - (lambda () - (gnus-article-read-summary-keys - nil (gnus-character-to-event ?P)))) - -(set-alist 'mime-preview-over-to-next-method-alist - 'gnus-original-article-mode' - (lambda () - (gnus-article-read-summary-keys - nil (gnus-character-to-event ?N)))) - ;;; @ end ;;; diff --git a/lisp/gnus-draft.el b/lisp/gnus-draft.el index b2e9c7a..34ff739 100644 --- a/lisp/gnus-draft.el +++ b/lisp/gnus-draft.el @@ -2,7 +2,7 @@ ;; Copyright (C) 1997,98 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen -;; MORIOKA Tomohiko +;; MORIOKA Tomohiko ;; Tatsuya Ichikawa ;; Keywords: mail, news, MIME, offline diff --git a/lisp/gnus-i18n.el b/lisp/gnus-i18n.el index 7e3f2f3..f8fc415 100644 --- a/lisp/gnus-i18n.el +++ b/lisp/gnus-i18n.el @@ -2,7 +2,7 @@ ;; Copyright (C) 1996,1997 Free Software Foundation, Inc. -;; Author: MORIOKA Tomohiko +;; Author: MORIOKA Tomohiko ;; Created: 1997/11/27 ;; Keywords: internationalization, news, mail diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 5ca0e78..59f121d 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -3,7 +3,7 @@ ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen -;; MORIOKA Tomohiko +;; MORIOKA Tomohiko ;; Shuhei KOBAYASHI ;; Katsumi Yamaoka ;; Kiyokazu SUTO diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el index 96aff32..8e135c9 100644 --- a/lisp/gnus-score.el +++ b/lisp/gnus-score.el @@ -435,20 +435,53 @@ of the last successful match.") (defconst gnus-header-index ;; Name to index alist. - '(("number" 1 gnus-score-integer) - ("subject" 8 gnus-score-string) - ("from" 9 gnus-score-string) - ("date" 10 gnus-score-date) - ("message-id" 11 gnus-score-string) - ("references" 12 gnus-score-string) - ("chars" 13 gnus-score-integer) - ("lines" 14 gnus-score-integer) - ("xref" 15 gnus-score-string) + `(("number" + ,(luna-class-slot-index (luna-find-class 'mime-gnus-entity) + 'location) + gnus-score-integer) + ("subject" + ,(luna-class-slot-index (luna-find-class 'mime-gnus-entity) + 'subject) + gnus-score-string) + ("from" + ,(luna-class-slot-index (luna-find-class 'mime-gnus-entity) + 'from) + gnus-score-string) + ("date" + ,(luna-class-slot-index (luna-find-class 'mime-gnus-entity) + 'date) + gnus-score-date) + ("message-id" + ,(luna-class-slot-index (luna-find-class 'mime-gnus-entity) + 'id) + gnus-score-string) + ("references" + ,(luna-class-slot-index (luna-find-class 'mime-gnus-entity) + 'references) + gnus-score-string) + ("chars" + ,(luna-class-slot-index (luna-find-class 'mime-gnus-entity) + 'chars) + gnus-score-integer) + ("lines" + ,(luna-class-slot-index (luna-find-class 'mime-gnus-entity) + 'lines) + gnus-score-integer) + ("xref" + ,(luna-class-slot-index (luna-find-class 'mime-gnus-entity) + 'xref) + gnus-score-string) ("head" -1 gnus-score-body) ("body" -1 gnus-score-body) ("all" -1 gnus-score-body) - ("followup" 9 gnus-score-followup) - ("thread" 12 gnus-score-thread))) + ("followup" + ,(luna-class-slot-index (luna-find-class 'mime-gnus-entity) + 'from) + gnus-score-followup) + ("thread" + ,(luna-class-slot-index (luna-find-class 'mime-gnus-entity) + 'references) + gnus-score-thread))) ;;; Summary mode score maps. diff --git a/lisp/gnus-setup.el b/lisp/gnus-setup.el index ae9909b..028ee17 100644 --- a/lisp/gnus-setup.el +++ b/lisp/gnus-setup.el @@ -91,7 +91,7 @@ ;;; Tools for MIME by ;;; UMEDA Masanobu -;;; MORIOKA Tomohiko +;;; MORIOKA Tomohiko (when gnus-use-tm (when (and (not gnus-use-installed-tm) diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index d0dcc55..f2087c2 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -2,7 +2,7 @@ ;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen -;; MORIOKA Tomohiko +;; MORIOKA Tomohiko ;; Katsumi Yamaoka ;; Keywords: mail, news, MIME @@ -3058,7 +3058,8 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (nnheader-nov-field) ; subject (nnheader-nov-field) ; from (nnheader-nov-field) ; date - (nnheader-nov-read-message-id) ; id + (or (nnheader-nov-field) + (nnheader-generate-fake-message-id)) ; id (nnheader-nov-field) ; refs (nnheader-nov-read-integer) ; chars (nnheader-nov-read-integer) ; lines diff --git a/lisp/message.el b/lisp/message.el index 4b816a6..9c9f226 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -2,7 +2,7 @@ ;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen -;; MORIOKA Tomohiko +;; MORIOKA Tomohiko ;; Shuhei KOBAYASHI ;; Keiichi Suzuki ;; Tatsuya Ichikawa diff --git a/lisp/mmgnus.el b/lisp/mmgnus.el index a2f5d2c..2799f6e 100644 --- a/lisp/mmgnus.el +++ b/lisp/mmgnus.el @@ -2,7 +2,7 @@ ;; Copyright (C) 1998 Free Software Foundation, Inc. -;; Author: MORIOKA Tomohiko +;; Author: MORIOKA Tomohiko ;; Keywords: MIME, multimedia, mail, news ;; This file is part of Chao-gnus. @@ -26,32 +26,62 @@ (require 'mmbuffer) -(mm-define-backend gnus (generic)) - -(mm-define-method entity-buffer ((entity gnus)) - ;; (if (with-current-buffer gnus-summary-buffer - ;; (eq gnus-current-article (mail-header-number entity))) - ;; ...) - (unless (mime-entity-header-start-internal entity) - (set-buffer gnus-original-article-buffer) - (mime-entity-set-header-start-internal entity (point-min)) - (mime-entity-set-body-end-internal entity (point-max)) - (goto-char (point-min)) - (if (re-search-forward "^$" nil t) - (progn - (mime-entity-set-header-end-internal entity (match-end 0)) - (mime-entity-set-body-start-internal - entity - (if (= (mime-entity-header-end-internal entity) - (mime-entity-body-end-internal entity)) - (mime-entity-body-end-internal entity) - (1+ (mime-entity-header-end-internal entity)) - )) - ) - (mime-entity-set-header-end-internal entity (point-min)) - (mime-entity-set-body-start-internal entity (point-min)) - )) - gnus-original-article-buffer) +(luna-define-class mime-gnus-entity (mime-buffer-entity) + (number + subject from date id references chars lines xref)) + +(luna-define-internal-accessors 'mime-gnus-entity) + +(luna-define-method initialize-instance ((entity mime-gnus-entity) + &rest init-args) + (apply (car (luna-class-find-functions + (luna-find-class 'standard-object) + 'initialize-instance)) + entity init-args) + ) + +;; (luna-define-method mime-entity-fetch-field ((entity mime-gnus-entity) +;; field-name) +;; (or (funcall (car (luna-class-find-functions +;; (luna-find-class 'mime-entity) +;; 'mime-entity-fetch-field)) +;; entity field-name) +;; (with-current-buffer gnus-original-article-buffer +;; (let ((ret (std11-field-body field-name))) +;; (when ret +;; (or (symbolp field-name) +;; (setq field-name +;; (intern (capitalize (capitalize field-name))))) +;; (mime-entity-set-original-header-internal +;; entity +;; (put-alist field-name ret +;; (mime-entity-original-header-internal entity))) +;; ret))))) + +;; (luna-define-method mime-entity-buffer ((entity mime-gnus-entity)) +;; ;; (if (with-current-buffer gnus-summary-buffer +;; ;; (eq gnus-current-article (mail-header-number entity))) +;; ;; ...) +;; (unless (mime-buffer-entity-header-end-internal entity) +;; (set-buffer gnus-original-article-buffer) +;; (mime-buffer-entity-set-header-start-internal entity (point-min)) +;; (mime-buffer-entity-set-body-end-internal entity (point-max)) +;; (goto-char (point-min)) +;; (if (re-search-forward "^$" nil t) +;; (progn +;; (mime-buffer-entity-set-header-end-internal entity (match-end 0)) +;; (mime-buffer-entity-set-body-start-internal +;; entity +;; (if (= (mime-buffer-entity-header-end-internal entity) +;; (mime-buffer-entity-body-end-internal entity)) +;; (mime-buffer-entity-body-end-internal entity) +;; (1+ (mime-buffer-entity-header-end-internal entity)) +;; )) +;; ) +;; (mime-buffer-entity-set-header-end-internal entity (point-min)) +;; (mime-buffer-entity-set-body-start-internal entity (point-min)) +;; )) +;; gnus-original-article-buffer) ;;; @ end diff --git a/lisp/nnheader.el b/lisp/nnheader.el index 2267749..51ddb2a 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -3,7 +3,7 @@ ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen -;; MORIOKA Tomohiko +;; MORIOKA Tomohiko ;; Katsumi Yamaoka ;; Keywords: mail, news, MIME @@ -69,6 +69,8 @@ on your system, you could say something like: ;;; Header access macros. +(require 'mmgnus) + (defmacro mail-header-number (header) "Return article number in HEADER." `(mime-entity-location-internal ,header)) @@ -77,31 +79,32 @@ on your system, you could say something like: "Set article number of HEADER to NUMBER." `(mime-entity-set-location-internal ,header ,number)) -(defalias 'mail-header-subject 'mime-entity-decoded-subject-internal) -(defalias 'mail-header-set-subject 'mime-entity-set-decoded-subject-internal) +(defalias 'mail-header-subject 'mime-gnus-entity-subject-internal) +(defalias 'mail-header-set-subject 'mime-gnus-entity-set-subject-internal) -(defalias 'mail-header-from 'mime-entity-decoded-from-internal) -(defalias 'mail-header-set-from 'mime-entity-set-decoded-from-internal) +(defalias 'mail-header-from 'mime-gnus-entity-from-internal) +(defalias 'mail-header-set-from 'mime-gnus-entity-set-from-internal) -(defalias 'mail-header-date 'mime-entity-date-internal) -(defalias 'mail-header-set-date 'mime-entity-set-date-internal) +(defalias 'mail-header-date 'mime-gnus-entity-date-internal) +(defalias 'mail-header-set-date 'mime-gnus-entity-set-date-internal) -(defalias 'mail-header-message-id 'mime-entity-message-id-internal) -(defalias 'mail-header-id 'mime-entity-message-id-internal) -(defalias 'mail-header-set-message-id 'mime-entity-set-message-id-internal) -(defalias 'mail-header-set-id 'mime-entity-set-message-id-internal) +(defalias 'mail-header-message-id 'mime-gnus-entity-id-internal) +(defalias 'mail-header-id 'mime-gnus-entity-id-internal) +(defalias 'mail-header-set-message-id 'mime-gnus-entity-set-id-internal) +(defalias 'mail-header-set-id 'mime-gnus-entity-set-id-internal) -(defalias 'mail-header-references 'mime-entity-references-internal) -(defalias 'mail-header-set-references 'mime-entity-set-references-internal) +(defalias 'mail-header-references 'mime-gnus-entity-references-internal) +(defalias 'mail-header-set-references + 'mime-gnus-entity-set-references-internal) -(defalias 'mail-header-chars 'mime-entity-chars-internal) -(defalias 'mail-header-set-chars 'mime-entity-set-chars-internal) +(defalias 'mail-header-chars 'mime-gnus-entity-chars-internal) +(defalias 'mail-header-set-chars 'mime-gnus-entity-set-chars-internal) -(defalias 'mail-header-lines 'mime-entity-lines-internal) -(defalias 'mail-header-set-lines 'mime-entity-set-lines-internal) +(defalias 'mail-header-lines 'mime-gnus-entity-lines-internal) +(defalias 'mail-header-set-lines 'mime-gnus-entity-set-lines-internal) -(defalias 'mail-header-xref 'mime-entity-xref-internal) -(defalias 'mail-header-set-xref 'mime-entity-set-xref-internal) +(defalias 'mail-header-xref 'mime-gnus-entity-xref-internal) +(defalias 'mail-header-set-xref 'mime-gnus-entity-set-xref-internal) (defalias 'nnheader-decode-subject (mime-find-field-decoder 'Subject 'nov)) @@ -119,33 +122,58 @@ on your system, you could say something like: (defsubst make-full-mail-header (&optional number subject from date id references chars lines xref) "Create a new mail header structure initialized with the parameters given." - (make-mime-entity-internal - 'gnus number - nil - nil nil nil - (if subject - (nnheader-decode-subject subject) - ) - (if from - (nnheader-decode-from from) - ) - date id references - chars lines xref - (list (cons 'Subject subject) - (cons 'From from)) - )) + (luna-make-entity (mm-expand-class-name 'gnus) + :location number + :subject (if subject + (nnheader-decode-subject subject)) + :from (if from + (nnheader-decode-from from)) + :date date + :id id + :references references + :chars chars + :lines lines + :xref xref + :original-header (list (cons 'Subject subject) + (cons 'From from))) + ;;(make-mime-entity-internal + ;; 'gnus number + ;; nil + ;; nil nil nil + ;; (if subject + ;; (nnheader-decode-subject subject) + ;; ) + ;; (if from + ;; (nnheader-decode-from from) + ;; ) + ;; date id references + ;; chars lines xref + ;; (list (cons 'Subject subject) + ;; (cons 'From from))) + ) (defsubst make-full-mail-header-from-decoded-header (&optional number subject from date id references chars lines xref) "Create a new mail header structure initialized with the parameters given." - (make-mime-entity-internal - 'gnus number - nil - nil nil nil - subject - from - date id references - chars lines xref)) + (luna-make-entity (mm-expand-class-name 'gnus) + :location number + :subject subject + :from from + :date date + :id id + :references references + :chars chars + :lines lines + :xref xref) + ;;(make-mime-entity-internal + ;; 'gnus number + ;; nil + ;; nil nil nil + ;; subject + ;; from + ;; date id references + ;; chars lines xref) + ) (defun make-mail-header (&optional init) "Create a new mail header structure initialized with INIT." @@ -265,13 +293,6 @@ on your system, you could say something like: (goto-char (point-min)) (delete-char 1))))) -(defmacro nnheader-nov-next-field () - ;; Go to the beginning of the next field and returns a point of - ;; the end of the current field. - '(if (search-forward "\t" eol t) - (1- (point)) - eol)) - (defmacro nnheader-nov-skip-field () '(search-forward "\t" eol 'move)) @@ -279,16 +300,15 @@ on your system, you could say something like: '(buffer-substring (point) (if (nnheader-nov-skip-field) (1- (point)) eol))) (defmacro nnheader-nov-read-integer () - '(let ((field (buffer-substring (point) (nnheader-nov-next-field)))) - (if (string-match "^[0-9]+$" field) - (string-to-number field) - 0))) + '(prog1 + (if (eq (char-after) ?\t) + 0 + (let ((num (ignore-errors (read (current-buffer))))) + (if (numberp num) num 0))) + (unless (eobp) + (search-forward "\t" eol 'move)))) -(defmacro nnheader-nov-read-message-id () - '(let ((id (buffer-substring (point) (nnheader-nov-next-field)))) - (if (string-match "^<[^>]+>$" id) - id - (nnheader-generate-fake-message-id)))) +;; (defvar nnheader-none-counter 0) (defun nnheader-parse-nov () (let ((eol (gnus-point-at-eol))) @@ -297,7 +317,8 @@ on your system, you could say something like: (nnheader-nov-field) ; subject (nnheader-nov-field) ; from (nnheader-nov-field) ; date - (nnheader-nov-read-message-id) ; id + (or (nnheader-nov-field) + (nnheader-generate-fake-message-id)) ; id (nnheader-nov-field) ; refs (nnheader-nov-read-integer) ; chars (nnheader-nov-read-integer) ; lines @@ -393,6 +414,191 @@ the line could be found." (beginning-of-line) (eq num article))) +(defun nnheader-retrieve-headers-from-directory* (articles + directory dependencies + &optional + fetch-old force-new large + backend) + (with-temp-buffer + (let* ((file nil) + (number (length articles)) + (count 0) + (pathname-coding-system 'binary) + (case-fold-search t) + (cur (current-buffer)) + article + headers header id end ref in-reply-to lines chars ctype) + ;; We don't support fetching by Message-ID. + (if (stringp (car articles)) + 'headers + (while articles + (when (and (file-exists-p + (setq file (expand-file-name + (int-to-string + (setq article (pop articles))) + directory))) + (not (file-directory-p file))) + (erase-buffer) + (nnheader-insert-head file) + (save-restriction + (std11-narrow-to-header) + (setq + header + (make-full-mail-header + ;; Number. + article + ;; Subject. + (or (std11-fetch-field "Subject") + "(none)") + ;; From. + (or (std11-fetch-field "From") + "(nobody)") + ;; Date. + (or (std11-fetch-field "Date") + "") + ;; Message-ID. + (progn + (goto-char (point-min)) + (setq id (if (re-search-forward + "^Message-ID: *\\(<[^\n\t> ]+>\\)" nil t) + ;; We do it this way to make sure the Message-ID + ;; is (somewhat) syntactically valid. + (buffer-substring (match-beginning 1) + (match-end 1)) + ;; If there was no message-id, we just fake one + ;; to make subsequent routines simpler. + (nnheader-generate-fake-message-id)))) + ;; References. + (progn + (goto-char (point-min)) + (if (search-forward "\nReferences: " nil t) + (progn + (setq end (point)) + (prog1 + (buffer-substring (match-end 0) (std11-field-end)) + (setq ref + (buffer-substring + (progn + ;; (end-of-line) + (search-backward ">" end t) + (1+ (point))) + (progn + (search-backward "<" end t) + (point)))))) + ;; Get the references from the in-reply-to header if there + ;; were no references and the in-reply-to header looks + ;; promising. + (if (and (search-forward "\nIn-Reply-To: " nil t) + (setq in-reply-to + (buffer-substring (match-end 0) + (std11-field-end))) + (string-match "<[^>]+>" in-reply-to)) + (let (ref2) + (setq ref (substring in-reply-to (match-beginning 0) + (match-end 0))) + (while (string-match "<[^>]+>" + in-reply-to (match-end 0)) + (setq ref2 + (substring in-reply-to (match-beginning 0) + (match-end 0))) + (when (> (length ref2) (length ref)) + (setq ref ref2))) + ref) + (setq ref nil)))) + ;; Chars. + (progn + (goto-char (point-min)) + (if (search-forward "\nChars: " nil t) + (if (numberp (setq chars (ignore-errors (read cur)))) + chars 0) + 0)) + ;; Lines. + (progn + (goto-char (point-min)) + (if (search-forward "\nLines: " nil t) + (if (numberp (setq lines (ignore-errors (read cur)))) + lines 0) + 0)) + ;; Xref. + (std11-fetch-field "Xref") + )) + (goto-char (point-min)) + (if (setq ctype (std11-fetch-field "Content-Type")) + (mime-entity-set-content-type-internal + header (mime-parse-Content-Type ctype))) + ) + (when (setq header + (gnus-dependencies-add-header + header dependencies force-new)) + (push header headers)) + ) + (setq count (1+ count)) + + (and large + (zerop (% count 20)) + (nnheader-message 5 "%s: Receiving headers... %d%%" + backend + (/ (* count 100) number)))) + + (when large + (nnheader-message 5 "%s: Receiving headers...done" backend)) + + headers)))) + +(defun nnheader-retrieve-headers-from-directory (articles + directory dependencies + &optional + fetch-old force-new large + backend) + (cons 'header + (nreverse (nnheader-retrieve-headers-from-directory* + articles directory dependencies + fetch-old force-new large backend)))) + +(defun nnheader-get-newsgroup-headers-xover* (sequence + &optional + force-new dependencies + group) + "Parse the news overview data in the server buffer, and return a +list of headers that match SEQUENCE (see `nntp-retrieve-headers')." + ;; Get the Xref when the users reads the articles since most/some + ;; NNTP servers do not include Xrefs when using XOVER. + ;; (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs)) + (let ((cur nntp-server-buffer) + number headers header) + (save-excursion + (set-buffer nntp-server-buffer) + ;; Allow the user to mangle the headers before parsing them. + (gnus-run-hooks 'gnus-parse-headers-hook) + (goto-char (point-min)) + (while (not (eobp)) + (condition-case () + (while (and sequence (not (eobp))) + (setq number (read cur)) + (while (and sequence + (< (car sequence) number)) + (setq sequence (cdr sequence))) + (and sequence + (eq number (car sequence)) + (progn + (setq sequence (cdr sequence)) + (setq header (inline + (gnus-nov-parse-line + number dependencies force-new)))) + (push header headers)) + (forward-line 1)) + (error + (gnus-error 4 "Strange nov line (%d)" + (count-lines (point-min) (point))))) + (forward-line 1)) + ;; A common bug in inn is that if you have posted an article and + ;; then retrieves the active file, it will answer correctly -- + ;; the new article is included. However, a NOV entry for the + ;; article may not have been generated yet, so this may fail. + ;; We work around this problem by retrieving the last few + ;; headers using HEAD. + headers))) + ;; Various cruft the backends and Gnus need to communicate. (defvar nntp-server-buffer nil) @@ -414,8 +620,8 @@ the line could be found." (set-buffer nntp-server-buffer) (erase-buffer) (kill-all-local-variables) - (setq case-fold-search t) ;Should ignore case. (set (make-local-variable 'nntp-process-response) nil) + (setq case-fold-search t) ;Should ignore case. t)) ;;; Various functions the backends use. -- 1.7.10.4