;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; MORIOKA Tomohiko <tomo@m17n.org>
;; Katsumi Yamaoka <yamaoka@jpl.org>
;; Keywords: mail, news, MIME
: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.
(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.
(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
(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
: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)
(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)
(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)
(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
;;;
#'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))
(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
;;;
;; Copyright (C) 1997,98 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; MORIOKA Tomohiko <tomo@m17n.org>
;; Tatsuya Ichikawa <t-ichi@po.shiojiri.ne.jp>
;; Keywords: mail, news, MIME, offline
;; Copyright (C) 1996,1997 Free Software Foundation, Inc.
-;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Author: MORIOKA Tomohiko <tomo@m17n.org>
;; Created: 1997/11/27
;; Keywords: internationalization, news, mail
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; MORIOKA Tomohiko <tomo@m17n.org>
;; Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
;; Katsumi Yamaoka <yamaoka@jpl.org>
;; Kiyokazu SUTO <suto@merry.xmath.ous.ac.jp>
(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.
;;; Tools for MIME by
;;; UMEDA Masanobu <umerin@mse.kyutech.ac.jp>
-;;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;;; MORIOKA Tomohiko <tomo@m17n.org>
(when gnus-use-tm
(when (and (not gnus-use-installed-tm)
;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; MORIOKA Tomohiko <tomo@m17n.org>
;; Katsumi Yamaoka <yamaoka@jpl.org>
;; Keywords: mail, news, MIME
(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
;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; MORIOKA Tomohiko <tomo@m17n.org>
;; Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
;; Keiichi Suzuki <keiichi@nanap.org>
;; Tatsuya Ichikawa <t-ichi@po.shiojiri.ne.jp>
;; Copyright (C) 1998 Free Software Foundation, Inc.
-;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Author: MORIOKA Tomohiko <tomo@m17n.org>
;; Keywords: MIME, multimedia, mail, news
;; This file is part of Chao-gnus.
(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
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; MORIOKA Tomohiko <tomo@m17n.org>
;; Katsumi Yamaoka <yamaoka@jpl.org>
;; Keywords: mail, news, MIME
;;; Header access macros.
+(require 'mmgnus)
+
(defmacro mail-header-number (header)
"Return article number in HEADER."
`(mime-entity-location-internal ,header))
"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))
(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."
(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))
'(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)))
(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
(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)
(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.
projects / elisp / gnus.git- / commitdiff