From 870822142dbdbf720ada0e93c8f0649bbac1bd16 Mon Sep 17 00:00:00 2001 From: yamaoka Date: Fri, 23 Oct 1998 05:31:33 +0000 Subject: [PATCH] Sync up with chao-6_9. --- lisp/gnus-agent.el | 1 + lisp/gnus-art.el | 50 +++++++------------- lisp/gnus-cache.el | 9 ++-- lisp/gnus-draft.el | 4 +- lisp/gnus-i18n.el | 66 ++++++++++---------------- lisp/gnus-int.el | 5 -- lisp/gnus-msg.el | 110 ++++++++++++++++++++++---------------------- lisp/gnus-score.el | 22 ++++----- lisp/gnus-spec.el | 1 + lisp/gnus-sum.el | 116 ++++++++++++---------------------------------- lisp/gnus-util.el | 1 + lisp/gnus-xmas.el | 1 + lisp/gnus.el | 16 ++++--- lisp/message.el | 42 ++++++++--------- lisp/nnheader.el | 130 ++++++++++++++++++++++++---------------------------- lisp/nnheaderxm.el | 1 + 16 files changed, 236 insertions(+), 339 deletions(-) diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index 11f751a..39f1f2f 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -2,6 +2,7 @@ ;; Copyright (C) 1997,98 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen +;; Tatsuya Ichikawa ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 0e570d7..d6fa8ba 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -2,7 +2,8 @@ ;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen -;; MORIOKA Tomohiko +;; MORIOKA Tomohiko +;; Katsumi Yamaoka ;; Keywords: mail, news, MIME ;; This file is part of GNU Emacs. @@ -383,13 +384,6 @@ 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. @@ -2021,7 +2015,6 @@ commands: (substring name (match-end 0)))))) (setq gnus-article-buffer name) (setq gnus-original-article-buffer original) - (setq gnus-article-mime-handle-alist nil) ;; This might be a variable local to the summary buffer. (unless gnus-single-article-buffer (save-excursion @@ -2070,11 +2063,15 @@ commands: (defun gnus-article-display-mime-message () "Article display method for MIME message." ;; called from `gnus-original-article-buffer'. - (let ((default-mime-charset (save-excursion - (set-buffer gnus-summary-buffer) - default-mime-charset))) + (let ((charset (with-current-buffer gnus-summary-buffer + default-mime-charset))) + (make-local-variable 'default-mime-charset) + (setq default-mime-charset charset) (mime-display-message mime-message-structure - gnus-article-buffer nil gnus-article-mode-map)) + gnus-article-buffer nil gnus-article-mode-map) + (make-local-variable 'default-mime-charset) + (setq default-mime-charset charset) + ) ;; `mime-display-message' changes current buffer to `gnus-article-buffer'. (make-local-variable 'mime-button-mother-dispatcher) (setq mime-button-mother-dispatcher @@ -2088,20 +2085,6 @@ commands: (erase-buffer) (insert-buffer-substring gnus-original-article-buffer))) -(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))) - (gnus-article-display-traditional-message) - (let (buffer-read-only) - (eword-decode-header 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. ARTICLE should either be an article number or a Message-ID. @@ -2211,13 +2194,12 @@ If ALL-HEADERS is non-nil, no headers are hidden." (defun gnus-article-prepare-display () "Make the current buffer look like a nice article." - (let ((method (if gnus-show-mime - (progn - (mime-parse-buffer) - gnus-article-display-method-for-mime) - gnus-article-display-method-for-traditional))) - ;; 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) + 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. diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el index 33aad1f..e1e3d72 100644 --- a/lisp/gnus-cache.el +++ b/lisp/gnus-cache.el @@ -2,6 +2,7 @@ ;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen +;; Tatsuya Ichikawa ;; Keywords: news ;; This file is part of GNU Emacs. @@ -207,12 +208,8 @@ it's not cached." ;; [number subject from date id references chars lines xref] (insert (format "%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t\n" (mail-header-number headers) - (let ((subject (mail-header-subject headers))) - (or (get-text-property 0 'raw-text subject) - subject)) - (let ((from (mail-header-from headers))) - (or (get-text-property 0 'raw-text from) - from)) + (mime-fetch-field 'Subject headers) + (mime-fetch-field 'From headers) (mail-header-date headers) (mail-header-id headers) (or (mail-header-references headers) "") diff --git a/lisp/gnus-draft.el b/lisp/gnus-draft.el index f54bba4..49b9715 100644 --- a/lisp/gnus-draft.el +++ b/lisp/gnus-draft.el @@ -2,8 +2,8 @@ ;; Copyright (C) 1997,98 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen -;; MORIOKA Tomohiko -;; Tatsuya Ichikawa +;; MORIOKA Tomohiko +;; Tatsuya Ichikawa ;; Keywords: mail, news, MIME, offline ;; This file is part of GNU Emacs. diff --git a/lisp/gnus-i18n.el b/lisp/gnus-i18n.el index 24142e5..78eeb03 100644 --- a/lisp/gnus-i18n.el +++ b/lisp/gnus-i18n.el @@ -25,9 +25,6 @@ ;;; Code: -(require 'gnus-sum) -(require 'gnus-util) - ;;; @ newsgroup default charset ;;; @@ -47,12 +44,14 @@ newsgroup name. SYMBOL is MIME charset or coding-system.") (defun gnus-set-newsgroup-default-charset (newsgroup charset) "Set CHARSET for the NEWSGROUP as default MIME charset." (let* ((ng-regexp (concat "^" (regexp-quote newsgroup) "\\($\\|\\.\\)")) - (pair (assoc ng-regexp gnus-newsgroup-default-charset-alist))) + (pair (assoc ng-regexp gnus-newsgroup-default-charset-alist)) + ) (if pair (setcdr pair charset) (setq gnus-newsgroup-default-charset-alist (cons (cons ng-regexp charset) - gnus-newsgroup-default-charset-alist))))) + gnus-newsgroup-default-charset-alist)) + ))) ;;; @ localization @@ -62,46 +61,31 @@ newsgroup name. SYMBOL is MIME charset or coding-system.") "Set up `default-mime-charset' of summary buffer. It is specified by variable `gnus-newsgroup-default-charset-alist' \(cf. function `gnus-set-newsgroup-default-charset')." - ;; We are in `nntp-server-buffer' now. (if (buffer-live-p gnus-summary-buffer) - (let* ((qgroup (save-excursion - (set-buffer gnus-summary-buffer) - gnus-newsgroup-name)) - (rgroup (gnus-group-real-name qgroup)) - alist pair charset) - (setq charset (catch 'found - ;; First, use "qualified" newsgroup name. - (setq alist gnus-newsgroup-default-charset-alist) - (while (setq pair (car alist)) - (if (string-match (car pair) qgroup) - (throw 'found (cdr pair))) - (setq alist (cdr alist))) - ;; Next, try "real" newsgroup name. - (setq alist gnus-newsgroup-default-charset-alist) - (while (setq pair (car alist)) - (if (string-match (car pair) rgroup) - (throw 'found (cdr pair))) - (setq alist (cdr alist))))) + (let ((charset + (catch 'found + (let ((group + (save-excursion + (set-buffer gnus-summary-buffer) + gnus-newsgroup-name)) + (alist gnus-newsgroup-default-charset-alist)) + (while alist + (let ((pair (car alist))) + (if (string-match (car pair) group) + (throw 'found (cdr pair)) + )) + (setq alist (cdr alist))) + )))) (if charset - (progn - (save-excursion - ;; Set `default-mime-charset' in summary buffer. - (set-buffer gnus-summary-buffer) - (make-local-variable 'default-mime-charset) - (setq default-mime-charset charset)) - ;; Also set `default-mime-charset' in current buffer. - (make-local-variable 'default-mime-charset) - (setq default-mime-charset charset)) - ;; Reset `default-mime-charset' in current buffer. + (progn + (save-excursion + (set-buffer gnus-summary-buffer) + (make-local-variable 'default-mime-charset) + (setq default-mime-charset charset)) + (make-local-variable 'default-mime-charset) + (setq default-mime-charset charset)) (kill-local-variable 'default-mime-charset))))) -(defun gnus-get-summary-default-charset () - "Get the value of `default-mime-charset' from summary buffer." - (and (buffer-live-p gnus-summary-buffer) - (save-excursion - (set-buffer gnus-summary-buffer) - default-mime-charset))) - ;;; @ end ;;; diff --git a/lisp/gnus-int.el b/lisp/gnus-int.el index 818ddda..6afd0bd 100644 --- a/lisp/gnus-int.el +++ b/lisp/gnus-int.el @@ -453,11 +453,6 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned." last))) (defun gnus-request-replace-article (article group buffer &optional no-encode) - (unless no-encode - (save-restriction - (message-narrow-to-head) - (mail-encode-encoded-word-buffer)) - (message-encode-message-body)) (let ((func (car (gnus-group-name-to-method group)))) (funcall (intern (format "%s-request-replace-article" func)) article (gnus-group-real-name group) buffer))) diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index b7e7204..06e76af 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -190,52 +190,6 @@ Thank you for your help in stamping out bugs. ;;; Internal functions. -(defun gnus-extended-version () - "Stringified gnus version." - (concat gnus-product-name "/" gnus-version-number " (based on " - gnus-original-product-name " " gnus-original-version-number ")")) - -(defun gnus-message-make-user-agent (&optional include-mime-info max-column) - "Return user-agent info. -INCLUDE-MIME-INFO the optional first argument if it is non-nil and the variable - `mime-edit-user-agent-value' exists, the return value will include it. -MAX-COLUMN the optional second argument if it is specified, the return value - will be folded up in the proper way." - (let ((user-agent (if (and include-mime-info - (boundp 'mime-edit-user-agent-value)) - (concat (gnus-extended-version) - " " - mime-edit-user-agent-value) - (gnus-extended-version)))) - (if max-column - (let (boundary) - (unless (natnump max-column) (setq max-column 76)) - (with-temp-buffer - (insert " " user-agent) - (goto-char 13) - (while (re-search-forward "[\n\t ]+" nil t) - (replace-match " ")) - (goto-char 13) - (while (re-search-forward "[^ ()/]+\\(/[^ ()/]+\\)? ?" nil t) - (while (eq ?\( (char-after (point))) - (forward-list) - (skip-chars-forward " ")) - (skip-chars-backward " ") - (if (> (current-column) max-column) - (progn - (if (or (not boundary) (eq ?\n (char-after boundary))) - (progn - (setq boundary (point)) - (unless (eobp) - (delete-char 1) - (insert "\n "))) - (goto-char boundary) - (delete-char 1) - (insert "\n "))) - (setq boundary (point)))) - (buffer-substring 13 (point-max)))) - user-agent))) - (defvar gnus-article-reply nil) (defmacro gnus-setup-message (config &rest forms) (let ((winconf (make-symbol "gnus-setup-message-winconf")) @@ -256,9 +210,6 @@ MAX-COLUMN the optional second argument if it is specified, the return value (add-hook 'message-header-setup-hook 'gnus-inews-insert-gcc) (add-hook 'message-header-setup-hook 'gnus-inews-insert-archive-gcc) (add-hook 'message-mode-hook 'gnus-configure-posting-styles) - (add-hook 'message-mode-hook - (lambda () - (setq message-user-agent (gnus-extended-version)))) (unwind-protect (progn ,@forms) @@ -278,6 +229,7 @@ MAX-COLUMN the optional second argument if it is specified, the return value (setq message-post-method `(lambda (arg) (gnus-post-method arg ,gnus-newsgroup-name))) + (setq message-user-agent (gnus-extended-version)) (message-add-action `(set-window-configuration ,winconf) 'exit 'postpone 'kill) (message-add-action @@ -599,6 +551,54 @@ If SILENT, don't prompt the user." (t gnus-select-method)))) + +(defun gnus-extended-version () + "Stringified gnus version." + (concat gnus-product-name "/" gnus-version-number " (based on " + gnus-original-product-name " " gnus-original-version-number ")")) + +(defun gnus-message-make-user-agent (&optional include-mime-info max-column) + "Return user-agent info. +INCLUDE-MIME-INFO the optional first argument if it is non-nil and the variable + `mime-edit-user-agent-value' exists, the return value will include it. +MAX-COLUMN the optional second argument if it is specified, the return value + will be folded up in the proper way." + (let ((user-agent (if (and include-mime-info + (boundp 'mime-edit-user-agent-value)) + (concat (gnus-extended-version) + " " + mime-edit-user-agent-value) + (gnus-extended-version)))) + (if max-column + (let (boundary) + (unless (natnump max-column) (setq max-column 76)) + (with-temp-buffer + (insert " " user-agent) + (goto-char 13) + (while (re-search-forward "[\n\t ]+" nil t) + (replace-match " ")) + (goto-char 13) + (while (re-search-forward "[^ ()/]+\\(/[^ ()/]+\\)? ?" nil t) + (while (eq ?\( (char-after (point))) + (forward-list) + (skip-chars-forward " ")) + (skip-chars-backward " ") + (if (> (current-column) max-column) + (progn + (if (or (not boundary) (eq ?\n (char-after boundary))) + (progn + (setq boundary (point)) + (unless (eobp) + (delete-char 1) + (insert "\n "))) + (goto-char boundary) + (delete-char 1) + (insert "\n "))) + (setq boundary (point)))) + (buffer-substring 13 (point-max)))) + user-agent))) + + ;;; ;;; Gnus Mail Functions ;;; @@ -660,12 +660,6 @@ If FULL-HEADERS (the prefix), include full headers when forwarding." (if full-headers "" message-included-forward-headers))) (message-forward post)))) -(defun gnus-summary-post-forward (&optional full-headers) - "Forward the current article to a newsgroup. -If FULL-HEADERS (the prefix), include full headers when forwarding." - (interactive "P") - (gnus-summary-mail-forward full-headers t)) - ;;; XXX: generate Subject and ``Topics''? (defun gnus-summary-mail-digest (&optional n post) "Digests and forwards all articles in this series." @@ -704,6 +698,12 @@ If FULL-HEADERS (the prefix), include full headers when forwarding." (set-buffer gnus-original-article-buffer) (message-resend address))))) +(defun gnus-summary-post-forward (&optional full-headers) + "Forward the current article to a newsgroup. +If FULL-HEADERS (the prefix), include full headers when forwarding." + (interactive "P") + (gnus-summary-mail-forward full-headers t)) + (defvar gnus-nastygram-message "The following article was inappropriately posted to %s.\n\n" "Format string to insert in nastygrams. diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el index f5505be..ff1ff41 100644 --- a/lisp/gnus-score.el +++ b/lisp/gnus-score.el @@ -435,20 +435,20 @@ of the last successful match.") (defconst gnus-header-index ;; Name to index alist. - '(("number" 0 gnus-score-integer) - ("subject" 1 gnus-score-string) - ("from" 2 gnus-score-string) - ("date" 3 gnus-score-date) - ("message-id" 4 gnus-score-string) - ("references" 5 gnus-score-string) - ("chars" 6 gnus-score-integer) - ("lines" 7 gnus-score-integer) - ("xref" 8 gnus-score-string) + '(("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) ("head" -1 gnus-score-body) ("body" -1 gnus-score-body) ("all" -1 gnus-score-body) - ("followup" 2 gnus-score-followup) - ("thread" 5 gnus-score-thread))) + ("followup" 9 gnus-score-followup) + ("thread" 12 gnus-score-thread))) ;;; Summary mode score maps. diff --git a/lisp/gnus-spec.el b/lisp/gnus-spec.el index cdaabe7..1a6b2f0 100644 --- a/lisp/gnus-spec.el +++ b/lisp/gnus-spec.el @@ -2,6 +2,7 @@ ;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen +;; Katsumi Yamaoka ;; Keywords: news ;; This file is part of GNU Emacs. diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index e37c1c4..10a135f 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -674,24 +674,7 @@ is not run if `gnus-visual' is nil." :group 'gnus-summary-visual :type 'hook) -(defcustom gnus-structured-field-decoder - #'eword-decode-and-unfold-structured-field - "Function to decode non-ASCII characters in structured field for summary." - :group 'gnus-various - :type 'function) - -(defcustom gnus-unstructured-field-decoder - (function - (lambda (string) - (eword-decode-unstructured-field-body - (std11-unfold-string string) 'must-unfold) - )) - "Function to decode non-ASCII characters in unstructured field for summary." - :group 'gnus-various - :type 'function) - -(defcustom gnus-parse-headers-hook - '(gnus-set-summary-default-charset) +(defcustom gnus-parse-headers-hook '(gnus-set-summary-default-charset) "*A hook called before parsing the headers." :group 'gnus-various :type 'hook) @@ -829,9 +812,10 @@ which it may alter in any way.") (?S ,(macroexpand '(mail-header-subject gnus-tmp-header)) ?s) (?s gnus-tmp-subject-or-nil ?s) (?n gnus-tmp-name ?s) - (?A (car (cdr (funcall gnus-extract-address-components gnus-tmp-from))) - ?s) - (?a (or (car (funcall gnus-extract-address-components gnus-tmp-from)) + (?A (std11-address-string + (car (mime-read-field 'From gnus-tmp-header))) ?s) + (?a (or (std11-full-name-string + (car (mime-read-field 'From gnus-tmp-header))) gnus-tmp-from) ?s) (?F gnus-tmp-from ?s) (?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s) @@ -1017,25 +1001,6 @@ variable (string, integer, character, etc).") ;; Byte-compiler warning. (defvar gnus-article-mode-map) -;; MIME stuff. - -(defvar gnus-encoded-word-method-alist - '(("chinese" mail-decode-encoded-word-string rfc1843-decode-string) - (".*" mail-decode-encoded-word-string)) - "Alist of regexps (to match group names) and lists of functions to be applied.") - -(defun gnus-multi-decode-encoded-word-string (string) - "Apply the functions from `gnus-encoded-word-method-alist' that match." - (let ((alist gnus-encoded-word-method-alist) - elem) - (while (setq elem (pop alist)) - (when (string-match (car elem) gnus-newsgroup-name) - (pop elem) - (while elem - (setq string (funcall (pop elem) string))) - (setq alist nil))) - string)) - ;; Subject simplification. (defun gnus-simplify-whitespace (str) @@ -1274,7 +1239,6 @@ increase the score of each group you read." "L" gnus-summary-lower-score "\M-i" gnus-symbolic-argument "h" gnus-summary-select-article-buffer - "b" gnus-article-view-part "V" gnus-summary-score-map "X" gnus-uu-extract-map @@ -2399,7 +2363,8 @@ marks of articles." (let ((gnus-summary-line-format-spec spec) (gnus-newsgroup-downloadable '((0 . t)))) (gnus-summary-insert-line - [0 "" "" "" "" "" 0 0 ""] 0 nil 128 t nil "" nil 1) + (make-full-mail-header 0 "" "" "" "" "" 0 0 "") + 0 nil 128 t nil "" nil 1) (goto-char (point-min)) (setq pos (list (cons 'unread (and (search-forward "\200" nil t) (- (point) 2))))) @@ -2469,7 +2434,7 @@ marks of articles." (setq gnus-tmp-name gnus-tmp-from)) (unless (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0)) - (gnus-put-text-property + (gnus-put-text-property-excluding-characters-with-faces (point) (progn (eval gnus-summary-line-format-spec) (point)) 'gnus-number gnus-tmp-number) @@ -3092,7 +3057,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (defsubst gnus-nov-parse-line (number dependencies &optional force-new) (let ((eol (gnus-point-at-eol)) (buffer (current-buffer)) - header rawtext decoded) + header) ;; overview: [num subject from date id refs chars lines misc] (unwind-protect @@ -3104,22 +3069,8 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (setq header (make-full-mail-header number ; number - (progn - (setq rawtext (gnus-nov-field) ; subject - decoded (funcall - gnus-unstructured-field-decoder rawtext)) - (if (string= rawtext decoded) - rawtext - (put-text-property 0 (length decoded) 'raw-text rawtext decoded) - decoded)) - (progn - (setq rawtext (gnus-nov-field) ; from - decoded (funcall - gnus-structured-field-decoder rawtext)) - (if (string= rawtext decoded) - rawtext - (put-text-property 0 (length decoded) 'raw-text rawtext decoded) - decoded)) + (gnus-nov-field) ; subject + (gnus-nov-field) ; from (gnus-nov-field) ; date (or (gnus-nov-field) (nnheader-generate-fake-message-id)) ; id @@ -3515,14 +3466,15 @@ If LINE, insert the rebuilt thread starting on line LINE." (defsubst gnus-article-sort-by-author (h1 h2) "Sort articles by root author." (string-lessp - (let ((extract (funcall - gnus-extract-address-components - (mail-header-from h1)))) - (or (car extract) (cadr extract) "")) - (let ((extract (funcall - gnus-extract-address-components - (mail-header-from h2)))) - (or (car extract) (cadr extract) "")))) + (let ((addr (mime-read-field 'From h1))) + (or (std11-full-name-string addr) + (std11-address-string addr) + "")) + (let ((addr (mime-read-field 'From h2))) + (or (std11-full-name-string addr) + (std11-address-string addr) + "")) + )) (defun gnus-thread-sort-by-author (h1 h2) "Sort threads by root author." @@ -4434,8 +4386,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." (subst-char-in-region (point-min) (point-max) ?\t ? t) (gnus-run-hooks 'gnus-parse-headers-hook) (let ((case-fold-search t) - rawtext decoded - in-reply-to header p lines chars) + in-reply-to header p lines chars ctype) (goto-char (point-min)) ;; Search to the beginning of the next header. Error messages ;; do not begin with 2 or 3. @@ -4450,7 +4401,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." ;; doesn't always go hand in hand. (setq header - (vector + (make-full-mail-header ;; Number. (prog1 (read cur) @@ -4464,27 +4415,13 @@ The resulting hash table is returned, or nil if no Xrefs were found." (progn (goto-char p) (if (search-forward "\nsubject: " nil t) - (progn - (setq rawtext (nnheader-header-value) - decoded (funcall - gnus-unstructured-field-decoder rawtext)) - (if (string-equal rawtext decoded) - rawtext - (put-text-property 0 (length decoded) 'raw-text rawtext decoded) - decoded)) + (nnheader-header-value) "(none)")) ;; From. (progn (goto-char p) (if (search-forward "\nfrom: " nil t) - (progn - (setq rawtext (nnheader-header-value) - decoded (funcall - gnus-structured-field-decoder rawtext)) - (if (string-equal rawtext decoded) - rawtext - (put-text-property 0 (length decoded) 'raw-text rawtext decoded) - decoded)) + (nnheader-header-value) "(nobody)")) ;; Date. (progn @@ -4555,6 +4492,11 @@ The resulting hash table is returned, or nil if no Xrefs were found." (goto-char p) (and (search-forward "\nxref: " nil t) (nnheader-header-value))))) + (goto-char p) + (if (and (search-forward "\ncontent-type: " nil t) + (setq ctype (nnheader-header-value))) + (mime-entity-set-content-type-internal + header (mime-parse-Content-Type ctype))) (when (equal id ref) (setq ref nil)) diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index c31a804..570c037 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -2,6 +2,7 @@ ;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen +;; Tatsuya Ichikawa ;; Keywords: mail, news, MIME ;; This file is part of GNU Emacs. diff --git a/lisp/gnus-xmas.el b/lisp/gnus-xmas.el index 08f9c44..afd1476 100644 --- a/lisp/gnus-xmas.el +++ b/lisp/gnus-xmas.el @@ -2,6 +2,7 @@ ;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen +;; Katsumi Yamaoka ;; Keywords: news ;; This file is part of GNU Emacs. diff --git a/lisp/gnus.el b/lisp/gnus.el index 2006b4a..5cc77f0 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -3,6 +3,8 @@ ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen +;; Tatsuya Ichikawa +;; Yoshiki Hayashi ;; Keywords: news, mail ;; This file is part of GNU Emacs. @@ -253,17 +255,17 @@ is restarted, and sometimes reloaded." (defconst gnus-product-name "T-gnus" "Product name of this version of gnus.") -(defconst gnus-version-number "6.10.025" +(defconst gnus-version-number "6.10.026" "Version number for this version of gnus.") (defconst gnus-original-version-number "0.36" "Version number for this version of Gnus.") (defconst gnus-original-product-name "Pterodactyl Gnus" - "Version number for this version of Gnus.") + "Product name of the original version of Gnus.") (defconst gnus-version - (format "%s %s (based on %s %s ; for SEMI 1.8-1.10, FLIM 1.8-1.11)" + (format "%s %s (based on %s %s ; for SEMI 1.10, FLIM 1.11)" gnus-product-name gnus-version-number gnus-original-product-name gnus-original-version-number) "Version string for this version of gnus.") @@ -1205,10 +1207,10 @@ commands will still require prompting." (defcustom gnus-extract-address-components 'gnus-extract-address-components "*Function for extracting address components from a From header. - -`gnus-extract-address-components' is a quite fast, and too simplistic. -`mail-extract-address-components' works much better, but is slower. -`std11-extract-address-components' also works better, and less slower." +Two pre-defined function exist: `gnus-extract-address-components', +which is the default, quite fast, and too simplistic solution, and +`mail-extract-address-components', which works much better, but is +slower." :group 'gnus-summary-format :type '(radio (function-item gnus-extract-address-components) (function-item mail-extract-address-components) diff --git a/lisp/message.el b/lisp/message.el index a9eedcb..650647d 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -5,6 +5,8 @@ ;; MORIOKA Tomohiko ;; Shuhei KOBAYASHI ;; Keiichi Suzuki +;; Tatsuya Ichikawa +;; Katsumi Yamaoka ;; Keywords: mail, news, MIME ;; This file is part of GNU Emacs. @@ -1060,7 +1062,6 @@ The cdr of ech entry is a function for applying the face to a region.") (Lines) (Expires) (Message-ID) - ;; (References . message-shorten-references) (References . message-fill-header) (User-Agent)) "Alist used for formatting headers.") @@ -2307,12 +2308,11 @@ the user from the mailer." (let ((errbuf (if message-interactive (generate-new-buffer " sendmail errors") 0)) - resend-addresses delimline) + resend-to-addresses delimline) (let ((case-fold-search t)) (save-restriction (message-narrow-to-headers) - ;; XXX: We need to handle Resent-CC/Resent-BCC, too. - (setq resend-addresses (message-fetch-field "resent-to"))) + (setq resend-to-addresses (message-fetch-field "resent-to"))) ;; Change header-delimiter to be what sendmail expects. (goto-char (point-min)) (re-search-forward @@ -2352,8 +2352,8 @@ the user from the mailer." ;; We must not do that for a resend ;; because we would find the original addresses. ;; For a resend, include the specific addresses. - (if resend-addresses - (list resend-addresses) + (if resend-to-addresses + (list resend-to-addresses) '("-t"))))) (when message-interactive (save-excursion @@ -2371,7 +2371,7 @@ the user from the mailer." "Pass the prepared message buffer to qmail-inject. Refer to the documentation for the variable `message-send-mail-function' to find out how to use this." - ;; replace the header delimiter with a blank line. + ;; replace the header delimiter with a blank line (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "\n")) @@ -3362,7 +3362,8 @@ Headers already prepared in the buffer are not modified." (if (or (= (following-char) ?,) (eobp)) (when (not quoted) - (if last + (if (and (> (current-column) 78) + last) (save-excursion (goto-char last) (looking-at "[ \t]*") @@ -3522,7 +3523,6 @@ Headers already prepared in the buffer are not modified." (nconc message-buffer-list (list (current-buffer)))))) (defvar mc-modes-alist) -(defvar message-get-reply-buffer-function nil) (defun message-setup (headers &optional replybuffer actions) (when (and (boundp 'mc-modes-alist) (not (assq 'message-mode mc-modes-alist))) @@ -3636,10 +3636,10 @@ OTHER-HEADERS is an alist of header/value pairs." "Start editing a reply to the article in the current buffer." (interactive) (let ((cur (current-buffer)) + from subject date to cc + references message-id follow-to (inhibit-point-motion-hooks t) - from date subject mct mft mrt - never-mct to cc - references message-id follow-to gnus-warning) + mct never-mct mft mrt gnus-warning) (save-restriction (message-narrow-to-head) ;; Allow customizations to have their say. @@ -3776,7 +3776,8 @@ that further discussion should take place only in " (if wide to-address nil))) (setq message-reply-headers - (vector 0 subject from date message-id references 0 0 "")) + (make-full-mail-header-from-decoded-header + 0 subject from date message-id references 0 0 "")) (message-setup `((Subject . ,subject) @@ -3794,22 +3795,20 @@ that further discussion should take place only in " ;;;###autoload (defun message-followup (&optional to-newsgroups) - "Follow up to the message in the current buffer." + "Follow up to the message in the current buffer. +If TO-NEWSGROUPS, use that as the new Newsgroups line." (interactive) (let ((cur (current-buffer)) + from subject date mct + references message-id follow-to (inhibit-point-motion-hooks t) - from date subject mct mft mrt (message-this-is-news t) - followup-to distribution newsgroups posted-to - references message-id follow-to gnus-warning) + followup-to distribution newsgroups gnus-warning posted-to mft mrt) (save-restriction (message-narrow-to-head) - ;; Allow customizations to have their say. - ;; This is a followup. (when (message-functionp message-followup-to-function) (setq follow-to (funcall message-followup-to-function))) - ;; Find all relevant headers we need. (setq from (message-fetch-field "from") date (message-fetch-field "date" t) subject (or (message-fetch-field "subject") "none") @@ -3944,7 +3943,8 @@ that further discussion should take place only in " (message-pop-to-buffer (message-buffer-name "followup" from newsgroups)) (setq message-reply-headers - (vector 0 subject from date message-id references 0 0 "")) + (make-full-mail-header-from-decoded-header + 0 subject from date message-id references 0 0 "")) (message-setup `((Subject . ,subject) diff --git a/lisp/nnheader.el b/lisp/nnheader.el index 25d0da4..cfdccf0 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -3,7 +3,9 @@ ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen -;; Keywords: news +;; MORIOKA Tomohiko +;; Katsumi Yamaoka +;; Keywords: mail, news, MIME ;; This file is part of GNU Emacs. @@ -40,6 +42,7 @@ (eval-when-compile (require 'cl)) (require 'mail-utils) +(require 'mime) (defvar nnheader-max-head-length 4096 "*Max length of the head of articles.") @@ -67,86 +70,73 @@ on your system, you could say something like: (defmacro mail-header-number (header) "Return article number in HEADER." - `(aref ,header 0)) + `(mime-entity-location-internal ,header)) (defmacro mail-header-set-number (header number) "Set article number of HEADER to NUMBER." - `(aset ,header 0 ,number)) + `(mime-entity-set-location-internal ,header ,number)) -(defmacro mail-header-subject (header) - "Return subject string in HEADER." - `(aref ,header 1)) +(defalias 'mail-header-subject 'mime-entity-decoded-subject-internal) +(defalias 'mail-header-set-subject 'mime-entity-set-decoded-subject-internal) -(defmacro mail-header-set-subject (header subject) - "Set article subject of HEADER to SUBJECT." - `(aset ,header 1 ,subject)) +(defalias 'mail-header-from 'mime-entity-decoded-from-internal) +(defalias 'mail-header-set-from 'mime-entity-set-decoded-from-internal) -(defmacro mail-header-from (header) - "Return author string in HEADER." - `(aref ,header 2)) +(defalias 'mail-header-date 'mime-entity-date-internal) +(defalias 'mail-header-set-date 'mime-entity-set-date-internal) -(defmacro mail-header-set-from (header from) - "Set article author of HEADER to FROM." - `(aset ,header 2 ,from)) +(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) -(defmacro mail-header-date (header) - "Return date in HEADER." - `(aref ,header 3)) +(defalias 'mail-header-references 'mime-entity-references-internal) +(defalias 'mail-header-set-references 'mime-entity-set-references-internal) -(defmacro mail-header-set-date (header date) - "Set article date of HEADER to DATE." - `(aset ,header 3 ,date)) +(defalias 'mail-header-chars 'mime-entity-chars-internal) +(defalias 'mail-header-set-chars 'mime-entity-set-chars-internal) -(defalias 'mail-header-message-id 'mail-header-id) -(defmacro mail-header-id (header) - "Return Id in HEADER." - `(aref ,header 4)) +(defalias 'mail-header-lines 'mime-entity-lines-internal) +(defalias 'mail-header-set-lines 'mime-entity-set-lines-internal) -(defalias 'mail-header-set-message-id 'mail-header-set-id) -(defmacro mail-header-set-id (header id) - "Set article Id of HEADER to ID." - `(aset ,header 4 ,id)) +(defalias 'mail-header-xref 'mime-entity-xref-internal) +(defalias 'mail-header-set-xref 'mime-entity-set-xref-internal) -(defmacro mail-header-references (header) - "Return references in HEADER." - `(aref ,header 5)) - -(defmacro mail-header-set-references (header ref) - "Set article references of HEADER to REF." - `(aset ,header 5 ,ref)) - -(defmacro mail-header-chars (header) - "Return number of chars of article in HEADER." - `(aref ,header 6)) - -(defmacro mail-header-set-chars (header chars) - "Set number of chars in article of HEADER to CHARS." - `(aset ,header 6 ,chars)) - -(defmacro mail-header-lines (header) - "Return lines in HEADER." - `(aref ,header 7)) - -(defmacro mail-header-set-lines (header lines) - "Set article lines of HEADER to LINES." - `(aset ,header 7 ,lines)) - -(defmacro mail-header-xref (header) - "Return xref string in HEADER." - `(aref ,header 8)) - -(defmacro mail-header-set-xref (header xref) - "Set article xref of HEADER to xref." - `(aset ,header 8 ,xref)) +(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 + (eword-decode-and-unfold-unstructured-field subject) + ) + (if from + (eword-decode-and-unfold-structured-field 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)) (defun make-mail-header (&optional init) "Create a new mail header structure initialized with INIT." - (make-vector 9 init)) - -(defun 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." - (vector number subject from date id references chars lines xref)) + (make-full-mail-header init init init init init + init init init init)) ;; fake message-ids: generation and detection @@ -182,7 +172,7 @@ on your system, you could say something like: ;; about twice as fast, even though it looks messier. You ;; can't have everything, I guess. Speed and elegance ;; don't always go hand in hand. - (vector + (make-full-mail-header ;; Number. (if naked (progn @@ -279,7 +269,7 @@ on your system, you could say something like: (defun nnheader-parse-nov () (let ((eol (gnus-point-at-eol))) - (vector + (make-full-mail-header (nnheader-nov-read-integer) ; number (nnheader-nov-field) ; subject (nnheader-nov-field) ; from @@ -298,8 +288,8 @@ on your system, you could say something like: (princ (mail-header-number header) (current-buffer)) (insert "\t" - (or (mail-header-subject header) "(none)") "\t" - (or (mail-header-from header) "(nobody)") "\t" + (or (mime-fetch-field 'Subject header) "(none)") "\t" + (or (mime-fetch-field 'From header) "(nobody)") "\t" (or (mail-header-date header) "") "\t" (or (mail-header-id header) (nnmail-message-id)) diff --git a/lisp/nnheaderxm.el b/lisp/nnheaderxm.el index 7c1435c..457b76e 100644 --- a/lisp/nnheaderxm.el +++ b/lisp/nnheaderxm.el @@ -2,6 +2,7 @@ ;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen +;; Katsumi Yamaoka ;; Keywords: news ;; This file is part of GNU Emacs. -- 1.7.10.4