From: keiichi Date: Mon, 18 Jan 1999 10:30:27 +0000 (+0000) Subject: Sync up with gnus-6_10. X-Git-Tag: keiichi-199901181900~1 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=20a738c772cb42117006e13ffb78f67286d3c880;p=elisp%2Fgnus.git- Sync up with gnus-6_10. --- diff --git a/README.semi b/README.semi index 8540989..89c5749 100644 --- a/README.semi +++ b/README.semi @@ -1,4 +1,4 @@ -This package contains Semi-gnus 6.9. +This package contains Semi-gnus 6.10. What is Semi-gnus? ================== @@ -7,10 +7,10 @@ What is Semi-gnus? all features of Gnus and gnus-mime, so there are no need to install Gnus to use it, and you must not use gnus-mime for SEMI. - It requires SEMI package, so please get and install SEMI package -before to install it. Nana-gnus 6.11 requires SEMI 1.12. You can get -SEMI from -ftp://ftp.jaist.ac.jp/pub/elisp/semi/ + It requires APEL, FLIM and SEMI packages, so please get and install +them before to install it. Semi-gnus 6.10 requires APEL 9.12 or later, +the latest FLIM 1.12 and SEMI 1.12. You can get these packages from +ftp://ftp.jaist.ac.jp/pub/GNU/elisp/semi/ Required environment for SEMI is written in README.en of SEMI package. How to get? (via CVS) @@ -42,7 +42,7 @@ Major tags are following: semi-gnus assigned to the latest stable version. It is very conservative. - for-semi-N1_N2 assigned to the latest stable version for SEMI + for-semi-N1_N2 assigned to the latest stable version for SEMI API N1.N2 (N1 and N2 are natural number). (e.g. `for-semi-1_3' is for SEMI API 1.3) diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index d37bd7b..8b8c9dd 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 +;; Katsumi Yamaoka ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify @@ -92,7 +93,7 @@ If nil, only read articles will be expired." (defvar gnus-agent-spam-hashtb nil) (defvar gnus-agent-file-name nil) (defvar gnus-agent-send-mail-function nil) -(defvar gnus-agent-file-coding-system 'no-conversion) +(defvar gnus-agent-file-coding-system 'raw-text) ;; Dynamic variables (defvar gnus-headers) diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index f17bc65..595c6f7 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -391,13 +391,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. @@ -848,7 +841,7 @@ characters to translate to." (when (search-forward "\n\n" nil t) (let ((buffer-read-only nil)) (while (search-forward "\b" nil t) - (let ((next (following-char)) + (let ((next (char-after)) (previous (char-after (- (point) 2)))) ;; We do the boldification/underlining by hiding the ;; overstrikes and putting the proper text property @@ -881,7 +874,7 @@ characters to translate to." (adaptive-fill-mode t)) (while (not (eobp)) (and (>= (current-column) (min fill-column (window-width))) - (/= (preceding-char) ?:) + (not (eq (char-before) ?:)) (fill-paragraph nil)) (end-of-line 2)))))) @@ -1840,8 +1833,28 @@ If variable `gnus-use-long-file-name' is non-nil, it is "\M-^" gnus-article-read-summary-keys "\M-g" gnus-article-read-summary-keys) -(substitute-key-definition - 'undefined 'gnus-article-read-summary-keys gnus-article-mode-map) +;; Define almost undefined keys to `gnus-article-read-summary-keys'. +(mapcar + (lambda (key) + (unless (lookup-key gnus-article-mode-map key) + (define-key gnus-article-mode-map key + 'gnus-article-read-summary-keys))) + (delq nil + (append + (mapcar + (lambda (elt) + (let ((key (car elt))) + (and (> (length key) 0) + (not (eq 'menu-bar (aref key 0))) + (symbolp (lookup-key gnus-summary-mode-map key)) + key))) + (accessible-keymaps gnus-summary-mode-map)) + (let ((c 127) + keys) + (while (>= c 32) + (push (char-to-string c) keys) + (decf c)) + keys)))) (defun gnus-article-make-menu-bar () (gnus-turn-off-edit-menu 'article) @@ -1968,11 +1981,19 @@ 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 all-headers) + (with-current-buffer gnus-summary-buffer + (setq charset default-mime-charset + all-headers gnus-have-all-headers)) + (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) + (when all-headers + (gnus-article-hide-headers nil -1)) + (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 @@ -1986,24 +2007,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))) - (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-make-full-mail-header (&optional number charset) "Create a new mail header structure in a raw article buffer." (unless (and number charset) @@ -2148,11 +2151,8 @@ If ALL-HEADERS is non-nil, no headers are hidden." (let ((method (if gnus-show-mime (progn - (mime-parse-buffer) - (if (or (not gnus-strict-mime) - (mime-fetch-field "MIME-Version")) - gnus-article-display-method-for-mime - gnus-article-display-method-for-encoded-word)) + (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) @@ -3395,7 +3395,7 @@ forbidden in URL encoding." ;;; (defun gnus-article-header-presentation-method (entity situation) - (mime-insert-decoded-header entity) + (mime-insert-header entity) ) (set-alist 'mime-header-presentation-method-alist @@ -3403,13 +3403,10 @@ forbidden in URL encoding." #'gnus-article-header-presentation-method) (defun gnus-mime-preview-quitting-method () - (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) - )) + (mime-preview-kill-buffer) + (delete-other-windows) + (gnus-article-show-summary) + (gnus-summary-select-article gnus-show-all-headers t)) (set-alist 'mime-preview-quitting-method-alist 'gnus-original-article-mode #'gnus-mime-preview-quitting-method) @@ -3425,6 +3422,18 @@ 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 9cbf51c..b2e9c7a 100644 --- a/lisp/gnus-draft.el +++ b/lisp/gnus-draft.el @@ -189,12 +189,6 @@ :group 'gnus-agent :type 'function) -;;;!!!If this is byte-compiled, it fails miserably. -;;;!!!This is because `gnus-setup-message' uses uninterned symbols. -;;;!!!This has been fixed in recent versions of Emacs and XEmacs, -;;;!!!but for the time being, we'll just run this tiny function uncompiled. - -(progn (defun gnus-draft-setup-for-editing (narticle group) (gnus-setup-message 'forward (let ((article narticle)) @@ -209,10 +203,9 @@ (forward-char -1) (insert mail-header-separator) (forward-line 1) - (message-set-auto-save-file-name)))))) + (message-set-auto-save-file-name))))) ;; (defvar gnus-draft-send-draft-buffer " *send draft*") -(progn (defun gnus-draft-setup-for-sending (narticle group) (let ((article narticle)) (if (not (get-buffer gnus-draft-send-draft-buffer)) @@ -221,7 +214,7 @@ (erase-buffer) (if (not (gnus-request-restore-buffer article group)) (error "Couldn't restore the article") - )))) + ))) ;; For draft TEST (defun gnus-draft-article-sendable-p (article) diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index d56f5ce..af57904 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -1327,7 +1327,7 @@ If FIRST-TOO, the current line is also eligible as a target." (beginning-of-line) (forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2)) (subst-char-in-region - (point) (1+ (point)) (following-char) + (point) (1+ (point)) (char-after) (if unmark (progn (setq gnus-group-marked (delete group gnus-group-marked)) diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index d2bcbfa..76f48d6 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -5,6 +5,8 @@ ;; Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko ;; Shuhei KOBAYASHI +;; Katsumi Yamaoka +;; Kiyokazu SUTO ;; Keywords: mail, news, MIME ;; This file is part of GNU Emacs. @@ -93,7 +95,7 @@ Thank you. The first %s will be replaced by the Newsgroups header; the second with the current group name.") -(defvar gnus-message-setup-hook nil +(defvar gnus-message-setup-hook '(gnus-maybe-setup-default-charset) "Hook run after setting up a message buffer.") (defvar gnus-bug-create-help-buffer t @@ -145,7 +147,6 @@ Please describe the bug in annoying, painstaking detail. Thank you for your help in stamping out bugs. " - gnus-product-name (if (string= gnus-product-name "Semi-gnus") "" @@ -307,6 +308,42 @@ If prefix argument YANK is non-nil, original article is yanked automatically." (interactive "P") (gnus-summary-followup (gnus-summary-work-articles arg) t)) +(defun gnus-summary-gather-references (articles) + (and articles + (let ((tbuf (gnus-get-buffer-create " *gnus-summary-gather-references*")) + refs ref article i) + (save-excursion + (set-buffer tbuf) + (erase-buffer) + (while (setq article (pop articles)) + (save-window-excursion + (set-buffer gnus-summary-buffer) + (gnus-summary-select-article nil nil nil article) + (gnus-summary-remove-process-mark article)) + (gnus-copy-article-buffer) + (set-buffer gnus-article-copy) + (save-restriction + (message-narrow-to-head) + (setq refs (if articles + (concat (message-fetch-field "references") + (message-fetch-field "message-id")) + (message-fetch-field "references")) + i 0) + (widen) + (if refs + (progn (set-buffer tbuf) + (while (string-match "<[^>]+>" refs i) + (setq i (match-end 0) + ref (substring refs (match-beginning 0) i)) + (goto-char (point-max)) + (unless (search-backward ref (point-min) t) + (insert " " ref))))))) + (set-buffer tbuf) + (goto-char (point-min)) + (if (looking-at "\\s +") + (goto-char (match-end 0))) + (buffer-substring (point) (point-max)))))) + (defun gnus-inews-yank-articles (articles) (let (beg article) (message-goto-body) @@ -353,7 +390,7 @@ This is done simply by taking the old article and adding a Supersedes header line with the old Message-ID." (interactive) (let ((article (gnus-summary-article-number)) - gnus-message-setup-hook) + (gnus-message-setup-hook '(gnus-maybe-setup-default-charset))) (gnus-setup-message 'reply-yank (gnus-summary-select-article t) (set-buffer gnus-original-article-buffer) @@ -449,7 +486,8 @@ header line with the old Message-ID." (message-news (or to-group group)) (set-buffer gnus-article-copy) (gnus-msg-treat-broken-reply-to) - (message-followup (if (or newsgroup-p force-news) nil to-group))) + (message-followup (if (or newsgroup-p force-news) nil to-group) + (gnus-summary-gather-references yank))) ;; The is mail. (if post (progn @@ -463,7 +501,7 @@ header line with the old Message-ID." message-send-actions))) (set-buffer gnus-article-copy) (gnus-msg-treat-broken-reply-to) - (message-wide-reply to-address))) + (message-wide-reply to-address (gnus-summary-gather-references yank)))) (when yank (gnus-inews-yank-articles yank)))))) @@ -545,10 +583,6 @@ If SILENT, don't prompt the user." -;; Dummy to avoid byte-compile warning. -;;(defvar nnspool-rejected-article-hook) -;;(defvar xemacs-codename) - (defun gnus-extended-version () "Stringified gnus version." (interactive) @@ -617,7 +651,7 @@ automatically." (gnus-summary-select-article) (set-buffer (gnus-copy-article-buffer)) (gnus-msg-treat-broken-reply-to) - (message-reply nil wide) + (message-reply nil wide (gnus-summary-gather-references yank)) (when yank (gnus-inews-yank-articles yank))))) @@ -955,7 +989,7 @@ this is a reply." (interactive "P") (gnus-summary-select-article t) (set-buffer gnus-original-article-buffer) - (let (gnus-message-setup-hook) + (let ((gnus-message-setup-hook '(gnus-maybe-setup-default-charset))) (gnus-setup-message 'compose-bounce (let* ((references (mail-fetch-field "references")) (parent (and references (gnus-parent-id references)))) diff --git a/lisp/gnus-nocem.el b/lisp/gnus-nocem.el index d678531..0a69970 100644 --- a/lisp/gnus-nocem.el +++ b/lisp/gnus-nocem.el @@ -271,7 +271,7 @@ matches an previously scanned and verified nocem message." gnus-nocem-real-group-hashtb) ;; Valid group. (beginning-of-line) - (while (= (following-char) ?\t) + (while (eq (char-after) ?\t) (forward-line -1)) (setq id (buffer-substring (point) (1- (search-forward "\t")))) (unless (gnus-gethash id gnus-nocem-hashtb) @@ -279,7 +279,7 @@ matches an previously scanned and verified nocem message." (gnus-sethash id t gnus-nocem-hashtb) (push id ncm)) (forward-line 1) - (while (= (following-char) ?\t) + (while (eq (char-after) ?\t) (forward-line 1)))))) (when ncm (setq gnus-nocem-touched-alist t) diff --git a/lisp/gnus-offline.el b/lisp/gnus-offline.el new file mode 100644 index 0000000..d43b850 --- /dev/null +++ b/lisp/gnus-offline.el @@ -0,0 +1,876 @@ +;;; gnus-offline.el --- To process mail & news at offline environment. +;;; $Id: gnus-offline.el,v 1.1.6.1 1999-01-18 10:29:35 keiichi Exp $ + +;;; Copyright (C) 1998 Tatsuya Ichikawa +;;; Yukihiro Ito +;;; Author: Tatsuya Ichikawa +;;; Yukihiro Ito +;;; Hidekazu Nakamura +;;; Tsukamoto Tetsuo + +;;; Version: 2.02 +;;; Keywords: news , mail , offline , gnus +;;; +;;; SPECIAL THANKS +;;; Keiichi Suzuki +;;; KORIYAMA Naohiro +;;; Katsumi Yamaoka + +;;; This file is part of Semi-gnus. +;;; +;;; GNU Emacs is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2, or (at your option) +;;; any later version. + +;;; GNU Emacs is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. + +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Emacs; see the file COPYING. If not, write to the +;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;;; Boston, MA 02111-1307, USA. +;;; +;;;; Commentary: +;;; Note. +;;; This file works only with after version of Emacs 19.30. +;;; This file needs miee.el and SEMI. +;;; If you set gnus-offline-drafts-queue-type to 'agent , you don't need +;;; miee.el +;;; You must use Semi-gnus 6.X.X. +;;; +;;; How to use. +;;; +;;; Add following code at the end in your .emacs +;;; +;;; (load "gnus-ofsetup") +;;; (gnus-setup-for-offline) +;;; (load gnus-offline-setting-file) +;;; +;;; If you use gnus-agent as souper , put gnus-agent setup code in you .gnus.el +;;; +;;; If you use nnspool as souper , put following code in your .emacs before +;;; gnus-offline setting. +;;; +;;; Then , put hang.exe in exec-path directory. +;;; +;;; In Gnus group buffer , type g to get all news and mail. +;;; Then send mail and news in spool directory. +;;; +;;; Variables. +;;; gnus-offline-dialup-program-arguments +;;; ... List of dialup program arguments. +;;; gnus-offline-hangup-program-arguments +;;; ... List of hangup program arguments. +;;; gnus-offline-mail-treat-environ ... toggle sending mail online/offline. +;;; gnus-offline-articles-to-fetch ... toggle fetch articles. +;;; both->mail->news->both... +;;; gnus-offline-load-hook ... hook before gnus-offline load. +;;; gnus-offline-before-online-hook ... hook before all online jobs. +;;; gnus-offline-after-online-hook ... hook after all online jobs. +;;; gnus-offline-interval-time ... Interval time to do all online jobs. +;;; (minutes) +;;; gnus-offline-dialup-function ... Function to diualup. +;;; gnus-offline-hangup-function ... Function to hangup. + +;;; Code: + +(eval '(run-hooks 'gnus-offline-load-hook)) + +(require 'cl) +(require 'custom) +(require 'pop3-fma) +(require 'easymenu) + +(unless (and (condition-case () + (require 'custom) + (file-error nil)) + (fboundp 'defgroup) + (fboundp 'defcustom)) + (require 'backquote) + (defmacro defgroup (&rest args)) + (defmacro defcustom (symbol value &optional doc &rest args) + (` (defvar (, symbol) (, value) (, doc)))) + ) +(defgroup gnus-offline nil + "Offline backend utility for Gnus." + :prefix "gnus-offline-" + :group 'mail + :group 'news) + +(defconst gnus-offline-version-number "2.02") +(defconst gnus-offline-codename +;; "Beta5" ; Beta +;; "This is the time" ; 2.00 +;; "A matter of trust" + "Modern Woman" +;; "Code of silence" + ) + +(defconst gnus-offline-version (format "Gnus offline backend utiliy v%s" + gnus-offline-version-number)) + +(defcustom gnus-offline-dialup-program-arguments nil + "*Program arguments of gnus-offline-dialup-program." + :group 'gnus-offline + :type '(repeat (string :tag "Argument"))) + +(defcustom gnus-offline-hangup-program-arguments nil + "*Program arguments of gnus-offline-hangup-program." + :group 'gnus-offline + :type '(repeat (string :tag "Argument"))) + +(defcustom gnus-offline-auto-hangup t + "*Whether dialup-network automatically hang up when all online jobs has done." + :group 'gnus-offline + :type 'boolean) + +(defcustom gnus-offline-load-hook nil + "*Hook to be run after the gnus-offline package has been loaded." + :group 'gnus-offline + :type 'hook) + +(defcustom gnus-offline-before-online-hook nil + "*Hook to be run before all online jobs." + :group 'gnus-offline + :type 'hook) + +(defcustom gnus-offline-after-online-hook nil + "*Hook to be run after all online jobs." + :group 'gnus-offline + :type 'hook) + +(defcustom gnus-offline-mail-treat-environ 'offline + "*If online , gnus-offline send all mail under online environ. +If offline , gnus-offline send all mail temporary to spool dir." + :group 'gnus-offline + :type '(choice (const offline) + (const online))) + +(defcustom gnus-offline-articles-to-fetch 'both + "*If both , gnus-offline fetch mail and news articles. +If mail , gnus-offline only fetch mail articles. + If news , gnus-offline only fetch news articles." + :group 'gnus-offline + :type '(choice (const both) + (const mail) + (const news))) + +(defcustom gnus-offline-interval-time 0 + "*Interval time(minutes) to do online jobs. +If set to 0 , timer call is disabled." + :group 'gnus-offline + :type 'integer) + +(defcustom gnus-offline-mail-group-level 1 + "*Group level for mail group." + :group 'gnus-offline + :type 'integer) + +(defcustom gnus-offline-after-empting-spool-hook nil + "*Hook to be run before empting spool." + :group 'gnus-offline + :type 'hook) + +(defcustom gnus-offline-before-empting-spool-hook nil + "*Hook to be run after empting spool." + :group 'gnus-offline + :type 'hook) + +(defcustom gnus-offline-dialup-function 'gnus-offline-connect-server + "*Function to dialup." + :group 'gnus-offline + :type 'function) + +(defcustom gnus-offline-hangup-function 'gnus-offline-hangup-line + "*Function to hangup." + :group 'gnus-offline + :type 'function) + +;;; Internal variables. +(defvar gnus-offline-connected nil + "*If value is t , dialup line is connected status. +If value is nil , dialup line is disconnected status.") + +(defvar gnus-offline-news-fetch-method nil + "*Method to fetch news articles.") + +(defvar gnus-offline-mail-fetch-method nil + "*Method to fetch mail articles.") + +(defvar gnus-offline-header-string + (format "%s - \"%s\"" + gnus-offline-version + gnus-offline-codename) + "*Header string for gnus-offline.") + +(defvar gnus-offline-stored-group-level nil + "*Mail Group level before changing.") + +(defvar gnus-offline-movemail-arguments nil + "*All command line arguments of exec-directory/movemail.") + +;;; Temporary variable: +(defvar string) +(defvar hdr) +(defvar str) +(defvar ver) +(defvar passwd) +(defvar num) +(defvar gnus-offline-error-buffer " *Error*") +(defvar gnus-offline-map (make-sparse-keymap)) + +;;; To silence byte compiler +(and + (fboundp 'eval-when-compile) + (eval-when-compile + (save-excursion + (beginning-of-defun) + (eval-region (point-min) (point))) + (let (case-fold-search) + (mapcar + (function + (lambda (symbol) + (unless (boundp symbol) + (make-local-variable symbol) + (eval (list 'setq symbol nil))))) + '(:group + :prefix :type + sendmail-to-spool-directory + news-spool-request-post-directory + nnspool-version + nnagent-version + msspool-news-server + msspool-news-service + gnspool-get-news + mail-spool-send + news-spool-post + gnus-agent-handle-level + )) + (make-local-variable 'byte-compile-warnings) + (setq byte-compile-warnings nil)))) + +(put 'gnus-offline-set-unplugged-state 'menu-enable 'gnus-offline-connected) +(if (eq system-type 'windows-nt) + (define-process-argument-editing "/hang\\.exe\\'" + (lambda (x) (general-process-argument-editing-function + x nil t t nil t t)))) +;;; Functions +;; +;; Setting up... +;; +(defun gnus-offline-setup () + "*Initialize gnus-offline function" + + ;; Load setting file - required. + (load gnus-offline-setting-file) + + ;; Menu and keymap + (gnus-offline-define-menu-and-key) + + ;; To transfer Mail/News function. + (cond ((eq gnus-offline-mail-treat-environ 'offline) + ;; send mail under offline environ. + (gnus-offline-set-offline-sendmail-function)) + ((eq gnus-offline-mail-treat-environ 'online) + ;; send mail under offline environ. + (gnus-offline-set-online-sendmail-function)))) +;; (add-hook 'gnus-group-mode-hook 'gnus-offline-setup)) + +;; +;; Setting Error check. +(defun gnus-offline-error-check () + ;; Check gnus-agent and nnspool setting. + (cond ((eq gnus-offline-news-fetch-method 'nnagent) + ;; nnagent and gnus-agent loaded ?? + (if (not (and (featurep 'gnus-agent) + (featurep 'nnagent))) + (progn + (get-buffer-create gnus-offline-error-buffer) + (set-buffer gnus-offline-error-buffer) + (erase-buffer) + (insert "WARNING!!: gnus-agent.el or nnagent.el is not loaded.\n") + (insert "Please check your .emacs or .gnus.el to work gnus-agent fine.") + (pop-to-buffer gnus-offline-error-buffer)))) + + ((eq gnus-offline-news-fetch-method 'nnspool) + (if (not (featurep 'nnspool)) + (progn + (get-buffer-create gnus-offline-error-buffer) + (set-buffer gnus-offline-error-buffer) + (erase-buffer) + (insert "WARNING!!: nnspool.el is not loaded.\n") + (insert "Please check your .emacs or .gnus.el to work nnspool fine.") + (pop-to-buffer gnus-offline-error-buffer)))))) +;; +;; +(defun gnus-offline-set-offline-sendmail-function () + "*Initialize sendmail-function when unplugged status." + (if (eq gnus-offline-drafts-queue-type 'miee) + (progn + (if (eq gnus-offline-news-fetch-method 'nnagent) + (setq gnus-agent-send-mail-function 'sendmail-to-spool-in-gnspool-format)) + (setq message-send-mail-function 'sendmail-to-spool-in-gnspool-format)) + (setq gnus-agent-send-mail-function (gnus-offline-set-online-sendmail-function) + message-send-mail-function 'gnus-agent-send-mail))) +;; +(defun gnus-offline-set-online-sendmail-function () + "*Initialize sendmail-function when plugged status." + (if (eq gnus-offline-MTA-type 'smtp) + (setq message-send-mail-function 'message-send-mail-with-smtp) + (setq message-send-mail-function 'message-send-mail-with-sendmail))) +;; +(defun gnus-offline-set-offline-post-news-function () + "*Initialize sendnews-function when unplugged status." + (if (eq gnus-offline-drafts-queue-type 'miee) + (setq message-send-news-function 'gnspool-request-post))) +;; +(defun gnus-offline-set-online-post-news-function () + "*Initialize sendnews-function when plugged status." + (setq message-send-news-function 'message-send-news-with-gnus)) +;; +;; Get new news jobs. (gnus-agent and nnspool) +;; +(defun gnus-offline-gnus-get-new-news (&optional arg) + "*Override function \"gnus-group-get-new-news\"." + (interactive "P") + (run-hooks 'gnus-offline-before-online-hook) + (if (functionp gnus-offline-dialup-function) + (funcall gnus-offline-dialup-function)) + (gnus-offline-get-new-news-function) + (gnus-group-get-new-news arg)) + +;; +;; dialup... +;; +(defun gnus-offline-connect-server () + "*Dialup function." + ;; Dialup if gnus-offline-dialup-program is specified + (if (stringp gnus-offline-dialup-program) + (progn + (message "Dialing ...") + (apply 'call-process gnus-offline-dialup-program nil nil nil + gnus-offline-dialup-program-arguments) + (sleep-for 1) + (message "Dialing ... done.")))) + +;; +;; Jobs before get new news , send mail and post news. +;; +(defun gnus-offline-get-new-news-function () + "*Prepare to get new news/mail." + ;; Set mail group level + (if (eq gnus-offline-articles-to-fetch 'mail) + (gnus-offline-set-mail-group-level gnus-offline-mail-group-level)) + + ;; Set to online environ. + (setq gnus-offline-connected t) + + ;; Set send mail/news functions to online functions. + (gnus-offline-set-online-sendmail-function) + (gnus-offline-set-online-post-news-function) + (message "Set to online status.") + + ;; fetch only news + (if (eq gnus-offline-articles-to-fetch 'news) + (gnus-offline-disable-fetch-mail)) + + ;; fetch both mail and news. or Only mail. + (gnus-offline-enable-fetch-news) + (if (memq gnus-offline-articles-to-fetch '(both mail)) + (gnus-offline-enable-fetch-mail)) + + ;; fetch only mail for gnus-agent + (if (and (eq gnus-offline-news-fetch-method 'nnagent) + (eq gnus-offline-articles-to-fetch 'mail)) + (setq gnus-agent-handle-level gnus-offline-mail-group-level))) + +;; +;; Change mail group level to handle only mail. +;; +(defun gnus-offline-set-mail-group-level (level) + "*Set nnm* group level." + (switch-to-buffer gnus-group-buffer) + (goto-char (point-min)) + + ;; Save current level + (if (not gnus-offline-stored-group-level) + (while (re-search-forward " nnm" nil t) + (setq gnus-offline-stored-group-level + (append gnus-offline-stored-group-level + (list (gnus-group-group-level))))) + (forward-line 1) + (beginning-of-line)) + ;; + (goto-char (point-min)) + (while (re-search-forward " nnm" nil t) + (gnus-group-set-current-level 1 level) + (forward-line 1) + (beginning-of-line)) + t) +;; +;; Restore mail group level +;; +(defun gnus-offline-restore-mail-group-level () + "*Restore nnm* group level." + (switch-to-buffer gnus-group-buffer) + (goto-char (point-min)) + (setq num 0) + (while (re-search-forward " nnm" nil t) + (gnus-group-set-current-level 1 (nth num gnus-offline-stored-group-level)) + (forward-line 1) + (setq num (+ num 1)) + (beginning-of-line))) +;; +;; Jobs after getting new news. +;; +(defun gnus-offline-after-get-new-news () + "*After getting news and mail jobs." + (if (memq gnus-offline-articles-to-fetch '(both mail)) + (progn + ;; Mail/both + ;; send mail/news in spool + (gnus-offline-empting-spool) + (if (eq gnus-offline-articles-to-fetch 'mail) + (progn + ;; Send only mail and hang up... + (if (and gnus-offline-connected + gnus-offline-auto-hangup) + (gnus-offline-set-unplugged-state)) + ;; Disable fetch mail. + (gnus-offline-disable-fetch-mail) + (gnus-offline-after-jobs-done))))) + + ;; News/Both + (if (memq gnus-offline-articles-to-fetch '(both news)) + (progn + (if gnus-offline-connected + (cond ((eq gnus-offline-news-fetch-method 'nnagent) + ;; Get New News (gnus-agent) + (gnus-agent-toggle-plugged t) + + ;; fetch articles + (gnus-agent-fetch-session) + + ;; Hang Up line. then set to offline status. + (if (and gnus-offline-connected + gnus-offline-auto-hangup) + (gnus-offline-set-unplugged-state)) + + ;; All online jobs has done. + (gnus-offline-after-jobs-done)) + (t + (if (eq gnus-offline-news-fetch-method 'nnspool) + ;; Get New News (nnspool) + (gnspool-get-news)))))))) +;; +;; Disable fetch mail +;; +(defun gnus-offline-disable-fetch-mail () + "*Set do not fetch mail." + (setq nnmail-spool-file nil)) +;; +;; Enable fetch mail +;; +(defun gnus-offline-enable-fetch-mail () + "*Set to fetch mail." + (setq gnus-offline-mail-fetch-method 'nnmail) + (setq nnmail-movemail-program 'pop3-fma-movemail) + (setq nnmail-spool-file (append + pop3-fma-local-spool-file-alist + (mapcar + (lambda (spool) + (car spool)) + pop3-fma-spool-file-alist)))) +;; +;; Enable fetch news +;; +(defun gnus-offline-enable-fetch-news () + "*Set to fetch news." + (if (eq gnus-offline-news-fetch-method 'nnagent) + (progn + (setq gnus-agent-handle-level gnus-level-subscribed) + (gnus-agent-toggle-plugged t)))) + +;; +;; Add your custom header. +;; +(defun gnus-offline-add-custom-header (header string) + "*Add X-Gnus-Offline-Backend header to Mail/News message." + (let ((delimline + (progn (goto-char (point-min)) + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "\n")) + (point-marker)))) + (goto-char (point-min)) + (or (re-search-forward (concat "^" header) delimline t) + (progn + (goto-char delimline) + (forward-line -1) + (beginning-of-line) + (setq hdr (concat header " ")) + (setq str (concat hdr string)) + (setq hdr (concat str "\n")) + (insert-string hdr))))) +;; +;; Add X-Offline-Backend header. +;; +(defun gnus-offline-message-add-header () + "*Add X-Gnus-Offline-Backend header to Mail/News message." + (if (eq gnus-offline-mail-treat-environ 'offline) + (progn + (if (eq gnus-offline-news-fetch-method 'nnagent) + (setq ver nnagent-version) + (setq ver nnspool-version)) + (setq str (format "\n with %s" ver) + string (concat gnus-offline-header-string str)) + (gnus-offline-add-custom-header "X-Gnus-Offline-Backend:" string)))) + + +;; +;; Toggle plugged/unplugged +;; +(defun gnus-offline-toggle-plugged (plugged) + "*Override function \"Jj\" - gnus-agent-toggle-plugged." + (interactive (list (not gnus-offline-connected))) + (if plugged + (progn + (setq gnus-offline-connected plugged) + (gnus-agent-toggle-plugged plugged) + ;; Set send mail/news function to offline functions. + (gnus-offline-set-online-sendmail-function) + (gnus-offline-set-online-post-news-function)) + ;; Set to offline status + (gnus-offline-set-unplugged-state))) +;; +;; Function of hang up line. +;; +(defun gnus-offline-set-unplugged-state () + "*Set to unplugged state." + (interactive) + ;; Hang Up Line. + (if (functionp gnus-offline-hangup-function) + (funcall gnus-offline-hangup-function)) + (setq gnus-offline-connected nil) + (if (eq gnus-offline-news-fetch-method 'nnagent) + (gnus-agent-toggle-plugged nil)) + + ;; Set send mail/news function to offline functions. + (gnus-offline-set-offline-sendmail-function) + (gnus-offline-set-offline-post-news-function) + ;; + (setenv "MAILHOST" nil)) +;; +;; Hangup line function +;; +(defun gnus-offline-hangup-line () + "*Hangup line function." + (message "Hang up line ... ") + (if (stringp gnus-offline-hangup-program) + (apply 'start-process "hup" nil gnus-offline-hangup-program + gnus-offline-hangup-program-arguments)) + (message "Hang up line ... done.")) +;; +;; Hang Up line routine whe using nnspool +;; +(defun gnus-offline-nnspool-hangup-line () + (if (and gnus-offline-connected + gnus-offline-auto-hangup) + (gnus-offline-set-unplugged-state)) + (gnus-offline-after-jobs-done)) +;; +;; Function of all jobs has done. +;; +(defun gnus-offline-after-jobs-done () + "*Jobs after all online jobs." + (run-hooks 'gnus-offline-after-online-hook) + (if (eq gnus-offline-articles-to-fetch 'mail) + (gnus-offline-restore-mail-group-level)) + (if (eq gnus-offline-news-fetch-method 'nnagent) + (or gnus-agent-expire-all + (gnus-offline-agent-expire))) + (if (and (featurep 'xemacs) + (fboundp 'play-sound-file)) + (ding nil 'drum) + (ding)) + (gnus-group-save-newsrc) + (message "All online jobs has done.")) + + +;; +;; Toggle auto hang up +;; +(defun gnus-offline-toggle-auto-hangup () + "*Toggle auto hangup flag." + (interactive) + (setq string "Auto hang up logic") + (if gnus-offline-auto-hangup + (progn + (setq gnus-offline-auto-hangup nil + str "disabled.")) + (setq gnus-offline-auto-hangup t + str "enabled.")) + (message (format "%s %s" string str))) +;; +;; Toggle offline/online to send mail. +;; +(defun gnus-offline-toggle-on/off-send-mail () + "*Toggel online/offline sendmail." + (interactive) + (if (eq gnus-offline-mail-treat-environ 'offline) + (progn + ;; Sending mail under online environ. + (gnus-offline-set-online-sendmail-function) + (setq gnus-offline-mail-treat-environ 'online) + (message "Sending mail immidiately.")) + ;; Sending mail under offline environ. + (gnus-offline-set-offline-sendmail-function) + (setq gnus-offline-mail-treat-environ 'offline) + (message "Sending mail temporary to spool directory."))) +;; +;; Toggle articles to fetch ... both -> mail -> news -> both +;; +(defun gnus-offline-toggle-articles-to-fetch () + "*Set articles to fetch... both(Mail/News) -> mail only -> News only -> both" + (interactive) + (setq string "Articles fetch from server.") + (cond ((eq gnus-offline-articles-to-fetch 'both) + (setq gnus-offline-articles-to-fetch 'mail + str "Only Mail")) + ((eq gnus-offline-articles-to-fetch 'mail) + (setq gnus-offline-articles-to-fetch 'news + str "Only News")) + (t + (setq gnus-offline-articles-to-fetch 'both + str "Mail/News both"))) + (message (format "%s %s" string str))) +;; +;; Toggle movemail program pop3.el -> movemail -> pop3.el +;; +(defun gnus-offline-toggle-movemail-program () + "*Toggle movemail program movemail -> pop3.el -> movemail ->..." + (interactive) + (setq string "Set nnmail-movemail-program") + (cond ((eq pop3-fma-movemail-type 'lisp) + (setq pop3-fma-movemail-type 'exe + str "to movemail")) + (t + (setq pop3-fma-movemail-type 'lisp + str "to pop3.el"))) + (message (format "%s %s" string str))) +;; +;; Send mail and Post news using Miee or gnus-agent. +;; +(defun gnus-offline-empting-spool () + "*Send all drafts on queue." + (run-hooks 'gnus-offline-before-empting-spool-hook) + (if (eq gnus-offline-drafts-queue-type 'miee) + ;; Send queued message by miee.el. + (progn + (if (eq gnus-offline-mail-treat-environ 'offline) + (progn + (message "Sending mails in spool ...") + ;; Using miee to send mail. + (mail-spool-send) + (message "Sending mails in spool ... done."))) + (message "Posting news in spool ...") + ;; Using miee to post news. + (if (and (not (stringp msspool-news-server)) + (not msspool-news-service)) + (progn + (setq msspool-news-server (nth 1 gnus-select-method)) + (setq msspool-news-service 119))) + (news-spool-post) + (message "Posting news in spool ... done.")) + ;; Send queued message by gnus-agent + (message "Sending messages in spool ...") + (gnus-group-send-drafts) + (message "Sending messages in spool ... done.")) + ;; + (run-hooks 'gnus-offline-after-empting-spool-hook)) +;; +;; Set interval time +;; +(defun gnus-offline-set-interval-time () + "*Set interval time for gnus-daemon." + (interactive) + (setq gnus-offline-interval-time + (string-to-int (read-from-minibuffer + (format "Interval time (now %s minutes) : " + gnus-offline-interval-time) + nil))) + (if (< gnus-offline-interval-time 2) + (progn + (message "Retrieving message logic by timer is disabled.") + (setq gnus-offline-interval-time 0)) + (message (format "Interval time set to %d minutes" gnus-offline-interval-time))) + (gnus-offline-processed-by-timer)) +;; +;; Expire articles using gnus-agent. +;; +(defun gnus-offline-agent-expire () + "*Expire expirable article on News group." + (interactive) + (gnus-agent-expire)) +;; +;; Menu. +;; +(defun gnus-offline-define-menu-and-key () + "*Set key and menu." + (if (eq gnus-offline-drafts-queue-type 'miee) + (if (featurep 'xemacs) + (add-hook 'gnus-group-mode-hook 'gnus-offline-define-menu-on-miee) + (gnus-offline-define-menu-on-miee)) + (add-hook 'gnus-group-mode-hook 'gnus-offline-define-menu-on-agent)) + (add-hook 'gnus-group-mode-hook + '(lambda () + (local-set-key "\C-coh" 'gnus-offline-set-unplugged-state) + (local-set-key "\C-com" 'gnus-offline-toggle-movemail-program) + (local-set-key "\C-cof" 'gnus-offline-toggle-articles-to-fetch) + (local-set-key "\C-coo" 'gnus-offline-toggle-on/off-send-mail) + (local-set-key "\C-cox" 'gnus-offline-toggle-auto-hangup) + (local-set-key "\C-cos" 'gnus-offline-set-interval-time) + (substitute-key-definition + 'gnus-group-get-new-news 'gnus-offline-gnus-get-new-news + gnus-group-mode-map) + (if (eq gnus-offline-news-fetch-method 'nnagent) + (progn + (substitute-key-definition + 'gnus-agent-toggle-plugged 'gnus-offline-toggle-plugged + gnus-agent-group-mode-map) + (local-set-key "\C-coe" 'gnus-offline-agent-expire))) + (or (featurep 'xemacs) + (define-key gnus-group-mode-map + (if (eq system-type 'windows-nt) [S-mouse-2] [mouse-3]) + 'gnus-offline-popup-menu)))) + (if (eq gnus-offline-news-fetch-method 'nnagent) + (add-hook 'gnus-summary-mode-hook + '(lambda () + (substitute-key-definition + 'gnus-agent-toggle-plugged 'gnus-offline-toggle-plugged + gnus-agent-summary-mode-map)))) + (if (featurep 'xemacs) + ;; Overwrite the toolbar spec for gnus-group-mode. + (add-hook 'gnus-startup-hook + (lambda () + (let ((i 0) (stat t) but) + (while (and stat (setq but (nth i gnus-group-toolbar))) + (and (equal 'gnus-group-get-new-news (aref but 1)) + (aset but 1 'gnus-offline-gnus-get-new-news) + (setq stat nil)) + (setq i (1+ i)))))))) +;; +;; +(defun gnus-offline-define-menu-on-miee () + "*Set and change menu bar on MIEE menu." + (let ((menu + (if (featurep 'meadow) + (easy-menu-change + nil + "Miee" + '( + ["Spool $B$K$"$k5-;v$NAw?.(B" news-spool-post t] + ["Spool $B$K$"$k(B Mail $B$NAw?.(B" mail-spool-send t] + "----" + ["Offline $B>uBV$X(B" message-offline-state (not message-offline-state)] + ["Online $B>uBV$X(B" message-online-state message-offline-state] + "----" + ("Gnus Offline" + ["movemail $B$N@ZBX$((B" gnus-offline-toggle-movemail-program t] + ["$BC$9(B" gnus-offline-agent-expire (eq gnus-offline-news-fetch-method 'nnagent)] + ["$B5-;vC$9(B" gnus-offline-agent-expire (eq gnus-offline-news-fetch-method 'nnagent)] + ["$B5-;v gnus-offline-interval-time 0) + (not gnus-offline-connected)) + ;; Timer call + (gnus-demon-add-handler 'gnus-offline-gnus-get-new-news + gnus-offline-interval-time + gnus-offline-interval-time)) + (if (= gnus-offline-interval-time 0) + (gnus-demon-remove-handler 'gnus-offline-gnus-get-new-news t))) +;; +;; +(provide 'gnus-offline) +;;; gnus-offline.el ends here diff --git a/lisp/gnus-ofsetup.el b/lisp/gnus-ofsetup.el new file mode 100644 index 0000000..a711a88 --- /dev/null +++ b/lisp/gnus-ofsetup.el @@ -0,0 +1,317 @@ +;;; gnus-ofsetup.el --- Setup advisor for Offline reading for Mail/News. +;;; +;;; $Id: gnus-ofsetup.el,v 1.1.6.1 1999-01-18 10:29:36 keiichi Exp $ +;;; +;;; Copyright (C) 1998 Tatsuya Ichikawa +;;; Author: Tatsuya Ichikawa +;;; +;;; This file is part of Semi-gnus. +;;; +;;; GNU Emacs is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2, or (at your option) +;;; any later version. + +;;; GNU Emacs is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. + +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Emacs; see the file COPYING. If not, write to the +;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;;; Boston, MA 02111-1307, USA. +;;; +;;;; Commentary: +;;; How to use. +;;; +;;; M-x load[RET]gnus-ofsetup +;;; M-x gnus-setup-for-offline +;;; + +;;; Code: + +(defvar gnus-offline-setting-file "~/.gnus-offline.el") +(defvar gnus-offline-use-miee nil) +(defvar gnus-offline-news-fetch-method nil) +(defvar gnus-offline-mail-fetch-method nil) +(defvar gnus-offline-hangup-program nil) +(defvar gnus-offline-dialup-program nil) +(defvar pop3-fma-spool-file-alist nil) +(defvar pop3-fma-movemail-type nil) +(defvar pop3-fma-movemail-arguments nil) +(defvar use-miee nil) +(defvar address) +(defvar options) + +;;; To silence byte compiler +(and + (fboundp 'eval-when-compile) + (eval-when-compile + (save-excursion + (beginning-of-defun) + (eval-region (point-min) (point))) + (let (case-fold-search) + (mapcar + (function + (lambda (symbol) + (unless (boundp symbol) + (make-local-variable symbol) + (eval (list 'setq symbol nil))))) + '(:group + :prefix :type + sendmail-to-spool-directory + news-spool-request-post-directory + nnspool-version + nnagent-version + msspool-news-server + msspool-news-service + gnspool-get-news + mail-spool-send + news-spool-post + gnus-agent-handle-level + )) + (make-local-variable 'byte-compile-warnings) + (setq byte-compile-warnings nil)))) + +(defun gnus-setup-for-offline () + "*Set up Gnus for offline environment." + (interactive) + + (if (not (file-exists-p gnus-offline-setting-file)) + (progn + (let ((news-method + (completing-read + "Method for offline News reading (TAB to completion): " + '(("gnus-agent" 1) ("nnspool" 2)) + nil t nil)) + (mail-method 'nnmail) + (program + (read-file-name "Dialup/Hangup program(type nil you do not use): ")) + (mta-type + (completing-read + "Select MTA type for sending mail (TAB to completion): " + '(("smtp" 1) ("sendmail" 2)) + nil t nil)) + (num-of-address + (read-from-minibuffer "How many e-mail address do you have: ")) + ) + (if (string-equal news-method "nnspool") + (setq use-miee t) + (setq use-miee (y-or-n-p "Use MIEE post/send message "))) + ;; + ;; Set variables. + (if (string-equal news-method "gnus-agent") + (setq gnus-offline-news-fetch-method 'nnagent) + (setq gnus-offline-news-fetch-method 'nnspool)) + ;; + (setq gnus-offline-mail-fetch-method mail-method) + (setq gnus-offline-use-miee use-miee) + + ;; Set programs. + (if (string-equal program "nil") + (progn + (setq gnus-offline-hangup-program nil) + (setq gnus-offline-dialup-program nil)) + (let ((options + (read-from-minibuffer "Dialup program options: "))) + (setq gnus-offline-dialup-program-arguments + (split-string options "[\t ]+"))) + (let ((options + (read-from-minibuffer "Hangup program options: "))) + (setq gnus-offline-hangup-program-arguments + (split-string options "[\t ]+"))) + (setq gnus-offline-hangup-program program) + (setq gnus-offline-dialup-program program)) + + ;; Set spool directory for outgoing messages. + (if use-miee + (progn + ;; Setting for MIEE with nnspool. + (let ((news-spool + (read-from-minibuffer + "News spool directory for sending: " + "/usr/spool/news.out")) + (mail-spool + (read-from-minibuffer + "Mail spool directory for sending: " + "/usr/spool/mail.out"))) + (setq gnus-offline-mail-spool-directory mail-spool) + (setq gnus-offline-news-spool-directory news-spool) + (setq gnus-offline-drafts-queue-type 'miee) + + ;; Load MIEE. + (load "miee") + ;; Set news post function for MIEE. + (setq message-send-news-function 'gnspool-request-post) + ;; Spool directory setting - MIEE. + (if (not (file-exists-p gnus-offline-mail-spool-directory)) + (make-directory gnus-offline-mail-spool-directory t)) + (setq sendmail-to-spool-directory + gnus-offline-mail-spool-directory) + (if (not (file-exists-p gnus-offline-news-spool-directory)) + (make-directory gnus-offline-news-spool-directory t)) + (setq news-spool-request-post-directory + gnus-offline-news-spool-directory))) + + ;; Set drafts type gnus-agent. + (setq gnus-offline-drafts-queue-type 'agent)) + + ;; Setting for gnus-agent. + (if (eq gnus-offline-news-fetch-method 'nnagent) + (let ((agent-directory + (read-from-minibuffer "Agent directory: " "~/News/agent"))) + (setq gnus-agent-directory agent-directory))) + + ;; Determin MTA type. + (if (string-equal mta-type "smtp") + (setq gnus-offline-MTA-type 'smtp) + (setq gnus-offline-MTA-type 'sendmail) + ) + ;; + ;; Set E-Mail Address and pop3 movemail type. + (setq i (string-to-int num-of-address)) + (setq address nil) + (while (> i 0) + (setq address + (append address + (list + (list + (concat "po:" + (read-from-minibuffer + "Email address (user@mailhost): ")) + (completing-read + "Authentification Method (TAB to completion): " + '(("pass" 1) ("apop" 2)) nil t nil))))) + (setq i (- i 1))) + + ;; Replace "hoge" -> 'hoge + (mapcar + (lambda (x) + (if (string-equal (nth 1 x) "pass") + (setcar (cdr x) 'pass) + (setcar (cdr x) 'apop))) + address) + (setq pop3-fma-spool-file-alist address) + + ;; Set movemail type. + (let ((movemail-type + (completing-read + "Select movemail type for retreave mail (TAB to completion): " + '(("exe" 1) ("lisp" 2)) + nil t nil)) + ) + (if (string-equal movemail-type "exe") + (let ((options + (read-from-minibuffer "movemail options: "))) + (setq pop3-fma-movemail-arguments (split-string options "[\t ]+")))) + (if (string-equal movemail-type "exe") + (setq pop3-fma-movemail-type 'exe) + (setq pop3-fma-movemail-type 'lisp)))) + + ;; Write to setting file. + (setq tmp-buffer (get-buffer-create "* Setting")) + (set-buffer "* Setting") + (erase-buffer) + (insert ";;\n"); + (insert ";; This file is created by gnus-ofsetup.el\n") + (insert ";; Creation date : ") + (insert (current-time-string)) + (insert "\n") + (insert ";;\n") + + ;; write Basic setting + (insert "(setq gnus-offline-news-fetch-method '") + (insert (prin1-to-string gnus-offline-news-fetch-method)) + (insert ")\n") + (insert "(setq gnus-offline-mail-fetch-method '") + (insert (prin1-to-string gnus-offline-mail-fetch-method)) + (insert ")\n") + (insert "(setq gnus-offline-use-miee ") + (insert (prin1-to-string gnus-offline-use-miee)) + (insert ")\n") + (insert "(setq gnus-offline-dialup-program ") + (insert (prin1-to-string gnus-offline-dialup-program)) + (insert ")\n") + + ;; write dialup/hangup program and options. + (if (stringp gnus-offline-dialup-program) + (progn + (insert "(setq gnus-offline-dialup-program-arguments '") + (insert (prin1-to-string gnus-offline-dialup-program-arguments)) + (insert ")\n"))) + (insert "(setq gnus-offline-hangup-program ") + (insert (prin1-to-string gnus-offline-hangup-program)) + (insert ")\n") + (if (stringp gnus-offline-hangup-program) + (progn + (insert "(setq gnus-offline-hangup-program-arguments '") + (insert (prin1-to-string gnus-offline-hangup-program-arguments)) + (insert ")\n"))) + + ;; write setting about MIEE. + (if gnus-offline-use-miee + (progn + (insert "(setq gnus-offline-mail-spool-directory ") + (insert (prin1-to-string gnus-offline-mail-spool-directory)) + (insert ")\n") + (insert "(setq gnus-offline-news-spool-directory ") + (insert (prin1-to-string gnus-offline-news-spool-directory)) + (insert ")\n") + (insert "(setq sendmail-to-spool-directory gnus-offline-mail-spool-directory)\n") + (insert "(setq news-spool-request-post-directory gnus-offline-news-spool-directory)\n") + (insert "(load \"miee\")\n") + (insert "(setq message-send-news-function '") + (insert (prin1-to-string message-send-news-function)) + (insert ")\n"))) + + ;; write setting about nnspool and gnus-agent. + (if (equal gnus-offline-news-fetch-method 'nnspool) + (insert "(message-offline-state)\n") + (insert "(setq gnus-agent-directory ") + (insert (prin1-to-string gnus-agent-directory)) + (insert ")\n")) + + ;; write setting about queue type -- MIEE or nnagent. + (insert "(setq gnus-offline-drafts-queue-type '") + (insert (prin1-to-string gnus-offline-drafts-queue-type)) + (insert ")\n") + (insert "(setq gnus-offline-MTA-type '") + (insert (prin1-to-string gnus-offline-MTA-type)) + (insert ")\n") + + ;; Offline setting for gnus-nntp-* + (insert "(setq gnus-nntp-service nil)\n") + (insert "(setq gnus-nntp-server nil)\n") + (insert "(setq nnmail-spool-file nil)\n") + + ;; Write setting about hooks. + (insert "(add-hook 'gnus-group-mode-hook 'gnus-offline-processed-by-timer t)\n") + (insert "(add-hook 'gnus-group-mode-hook 'gnus-offline-error-check t)\n") + (insert "(add-hook 'gnus-after-getting-new-news-hook 'gnus-offline-after-get-new-news)\n") + (insert "(add-hook 'gnus-after-getting-news-hook 'gnus-offline-after-get-new-news)\n") + (if (eq gnus-offline-news-fetch-method 'nnspool) + (insert "(add-hook 'after-getting-news-hook 'gnus-offline-nnspool-hangup-line)\n")) + (insert "(add-hook 'message-send-hook 'gnus-offline-message-add-header)\n") + (insert "(autoload 'gnus-offline-setup \"gnus-offline\")\n") + (insert "(add-hook 'gnus-load-hook 'gnus-offline-setup)\n") + + ;; Write setting about pop3-fma. + (insert "(require 'pop3-fma)\n") + (insert "(add-hook 'message-send-hook 'pop3-fma-message-add-header)\n") + (insert "(setq pop3-fma-spool-file-alist '") + (insert (prin1-to-string pop3-fma-spool-file-alist)) + (insert ")\n") + (insert "(setq pop3-fma-movemail-type '") + (insert (prin1-to-string pop3-fma-movemail-type)) + (insert ")\n") + (if (eq pop3-fma-movemail-type 'exe) + (progn + (insert "(setq pop3-fma-movemail-arguments '") + (insert (prin1-to-string pop3-fma-movemail-arguments)) + (insert ")\n"))) + (write-region (point-min) (point-max) gnus-offline-setting-file) + (kill-buffer "* Setting")) + ) + (load gnus-offline-setting-file)) +;; gnus-ofsetup.el Ends here. diff --git a/lisp/gnus-salt.el b/lisp/gnus-salt.el index e98762e..da62e48 100644 --- a/lisp/gnus-salt.el +++ b/lisp/gnus-salt.el @@ -702,7 +702,7 @@ Two predefined functions are available: (while (progn (forward-line -1) (forward-char col) - (= (following-char) ? )) + (eq (char-after) ? )) (delete-char 1) (insert (caddr gnus-tree-parent-child-edges))) (goto-char beg))) diff --git a/lisp/gnus-soup.el b/lisp/gnus-soup.el index 3d97829..1fdd83f 100644 --- a/lisp/gnus-soup.el +++ b/lisp/gnus-soup.el @@ -380,12 +380,12 @@ though the two last may be nil if they are missing." (push (vector (gnus-soup-field) (gnus-soup-field) (gnus-soup-field) - (and (eq (preceding-char) ?\t) + (and (eq (char-before) ?\t) (gnus-soup-field)) - (and (eq (preceding-char) ?\t) + (and (eq (char-before) ?\t) (string-to-int (gnus-soup-field)))) areas) - (when (eq (preceding-char) ?\t) + (when (eq (char-before) ?\t) (beginning-of-line 2))) (kill-buffer (current-buffer)))) areas)) @@ -403,7 +403,7 @@ file. The vector contain three strings, [prefix name encoding]." (push (vector (gnus-soup-field) (gnus-soup-field) (gnus-soup-field)) replies) - (when (eq (preceding-char) ?\t) + (when (eq (char-before) ?\t) (beginning-of-line 2))) (kill-buffer (current-buffer))) replies)) diff --git a/lisp/gnus-spec.el b/lisp/gnus-spec.el index 67c9ee9..2b06fa8 100644 --- a/lisp/gnus-spec.el +++ b/lisp/gnus-spec.el @@ -396,9 +396,9 @@ (t nil))) ;; User-defined spec -- find the spec name. - (when (= (setq spec (following-char)) ?u) + (when (eq (setq spec (char-after)) ?u) (forward-char 1) - (setq user-defined (following-char))) + (setq user-defined (char-after))) (forward-char 1) (delete-region spec-beg (point)) diff --git a/lisp/gnus-srvr.el b/lisp/gnus-srvr.el index 21abf17..955a258 100644 --- a/lisp/gnus-srvr.el +++ b/lisp/gnus-srvr.el @@ -706,7 +706,7 @@ buffer. (save-excursion (beginning-of-line) ;; If this group it killed, then we want to subscribe it. - (when (= (following-char) ?K) + (when (eq (char-after) ?K) (setq sub t)) (setq group (gnus-browse-group-name)) (when (and sub diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index 1237936..9a5aa09 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -1772,13 +1772,13 @@ newsgroup." (progn (skip-chars-forward " \t") (not - (or (= (following-char) ?=) - (= (following-char) ?x) - (= (following-char) ?j))))) + (or (eq (char-after) ?=) + (eq (char-after) ?x) + (eq (char-after) ?j))))) (progn (set group (cons min max)) ;; if group is moderated, stick in moderation table - (when (= (following-char) ?m) + (when (eq (char-after) ?m) (unless gnus-moderated-hashtb (setq gnus-moderated-hashtb (gnus-make-hashtable))) (gnus-sethash (symbol-name group) t @@ -1813,7 +1813,7 @@ newsgroup." ;; Let the Gnus agent save the active file. (when (and gnus-agent real-active) (gnus-agent-save-groups method)) - + (goto-char (point-min)) ;; We split this into to separate loops, one with the prefix ;; and one without to speed the reading up somewhat. @@ -1836,7 +1836,7 @@ newsgroup." (let (min max group) (while (not (eobp)) (condition-case () - (when (= (following-char) ?2) + (when (eq (char-after) ?2) (read cur) (read cur) (setq min (read cur) max (read cur)) @@ -2056,7 +2056,7 @@ If FORCE is non-nil, the .newsrc file is read." (unless (boundp symbol) (set symbol nil)) ;; It was a group name. - (setq subscribed (= (following-char) ?:) + (setq subscribed (eq (char-after) ?:) group (symbol-name symbol) reads nil) (if (eolp) @@ -2080,7 +2080,7 @@ If FORCE is non-nil, the .newsrc file is read." (read buf))) (widen) ;; If the next character is a dash, then this is a range. - (if (= (following-char) ?-) + (if (eq (char-after) ?-) (progn ;; We read the upper bound of the range. (forward-char 1) @@ -2102,8 +2102,8 @@ If FORCE is non-nil, the .newsrc file is read." (push num1 reads)) ;; If the next char in ?\n, then we have reached the end ;; of the line and return nil. - (/= (following-char) ?\n)) - ((= (following-char) ?\n) + (not (eq (char-after) ?\n))) + ((eq (char-after) ?\n) ;; End of line, so we end. nil) (t diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 359d8a5..d41dc57 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -2222,7 +2222,7 @@ marks of articles." (while (setq point (pop config)) (when (and (< point (point-max)) (goto-char point) - (= (following-char) ?\n)) + (eq (char-after) ?\n)) (subst-char-in-region point (1+ point) ?\n ?\r))))) ;; Various summary mode internalish functions. @@ -3027,7 +3027,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (defmacro gnus-nov-read-integer () '(prog1 - (if (= (following-char) ?\t) + (if (eq (char-after) ?\t) 0 (let ((num (ignore-errors (read buffer)))) (if (numberp num) num 0))) @@ -4439,7 +4439,6 @@ The resulting hash table is returned, or nil if no Xrefs were found." (setq ref (buffer-substring (progn - ;; (end-of-line) (search-backward ">" end t) (1+ (point))) (progn @@ -4571,7 +4570,7 @@ This is meant to be called in `gnus-article-internal-prepare-hook'." (save-restriction (nnheader-narrow-to-headers) (goto-char (point-min)) - (when (or (and (eq (downcase (following-char)) ?x) + (when (or (and (eq (downcase (char-after)) ?x) (looking-at "Xref:")) (search-forward "\nXref:" nil t)) (goto-char (1+ (match-end 0))) @@ -5197,16 +5196,13 @@ The state which existed when entering the ephemeral is reset." (gnus-summary-recenter) (gnus-summary-position-point)))) -(defun gnus-summary-preview-mime-message (arg) +(defun gnus-summary-preview-mime-message () "MIME decode and play this message." - (interactive "P") - (or gnus-show-mime - (let ((gnus-break-pages nil) - (gnus-show-mime t)) - (gnus-summary-select-article t t) - )) - (select-window (get-buffer-window gnus-article-buffer)) - ) + (interactive) + (let ((gnus-break-pages nil) + (gnus-show-mime t)) + (gnus-summary-select-article gnus-show-all-headers t)) + (select-window (get-buffer-window gnus-article-buffer))) ;;; Dead summaries. @@ -7032,6 +7028,8 @@ and `request-accept' functions." ;; Copy any marks over to the new group. (let ((marks gnus-article-mark-lists) (to-article (cdr art-group))) + (unless (gnus-group-auto-expirable-p to-newsgroup) + (setq marks (delete '(expirable . expire) marks))) ;; See whether the article is to be put in the cache. (when gnus-use-cache @@ -7792,21 +7790,21 @@ marked." (defun gnus-summary-update-mark (mark type) (let ((forward (cdr (assq type gnus-summary-mark-positions))) - (buffer-read-only nil)) + (buffer-read-only nil)) (re-search-backward "[\n\r]" (gnus-point-at-bol) 'move-to-limit) (when (looking-at "\r") (incf forward)) (when (and forward - (<= (+ forward (point)) (point-max))) + (<= (+ forward (point)) (point-max))) ;; Go to the right position on the line. (goto-char (+ forward (point))) ;; Replace the old mark with the new mark. - (subst-char-in-region (point) (1+ (point)) (following-char) mark) + (subst-char-in-region (point) (1+ (point)) (char-after) mark) ;; Optionally update the marks by some user rule. (when (eq type 'unread) - (gnus-data-set-mark - (gnus-data-find (gnus-summary-article-number)) mark) - (gnus-summary-update-line (eq mark gnus-unread-mark)))))) + (gnus-data-set-mark + (gnus-data-find (gnus-summary-article-number)) mark) + (gnus-summary-update-line (eq mark gnus-unread-mark)))))) (defun gnus-mark-article-as-read (article &optional mark) "Enter ARTICLE in the pertinent lists and remove it from others." diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index cba9137..6c3400e 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 +;; Katsumi Yamaoka ;; Keywords: mail, news, MIME ;; This file is part of GNU Emacs. diff --git a/lisp/gnus-vm.el b/lisp/gnus-vm.el index bbefaac..3e65485 100644 --- a/lisp/gnus-vm.el +++ b/lisp/gnus-vm.el @@ -92,13 +92,15 @@ save those articles instead." "Save %s in VM folder:" folder gnus-mail-save-name gnus-newsgroup-name gnus-current-headers 'gnus-newsgroup-last-mail)) - (gnus-eval-in-buffer-window gnus-original-article-buffer - (save-excursion - (save-restriction - (widen) - (let ((vm-folder (gnus-vm-make-folder))) - (vm-save-message folder) - (kill-buffer vm-folder)))))) + (save-window-excursion + (gnus-summary-select-article gnus-show-all-headers) + (gnus-eval-in-buffer-window gnus-original-article-buffer + (save-excursion + (save-restriction + (widen) + (let ((vm-folder (gnus-vm-make-folder))) + (vm-save-message folder) + (kill-buffer vm-folder))))))) (provide 'gnus-vm) diff --git a/lisp/gnus-xmas.el b/lisp/gnus-xmas.el index 41d5116..26245b3 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. @@ -56,7 +57,7 @@ automatically." (september "#bf9900" "#ffcc00")) "Color alist used for the Gnus logo.") -(defcustom gnus-xmas-logo-color-style 'moss +(defcustom gnus-xmas-logo-color-style 'sky "*Color styles used for the Gnus logo." :type '(choice (const flame) (const pine) (const moss) (const irish) (const sky) (const tin) @@ -668,8 +669,13 @@ the resulting string may be narrower than END-COLUMN. (goto-char (point-min)) (let* ((pheight (+ 20 (count-lines (point-min) (point-max)))) (wheight (window-height)) - (rest (- wheight pheight))) - (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n)))) + (rest (1- (- wheight pheight)))) + (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n))) + (goto-char (point-min)) + (insert-char ?\ ;;; + (max 0 (/ (- (window-width) (length gnus-version)) 2))) + (insert gnus-version "\n") + (put-text-property (point-min) (1- (point)) 'face 'gnus-splash-face)) (t (insert (format " %s @@ -700,8 +706,13 @@ the resulting string may be narrower than END-COLUMN. (forward-line 1) (let* ((pheight (count-lines (point-min) (point-max))) (wheight (window-height)) - (rest (- wheight pheight))) + (rest (1- (- wheight pheight)))) (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n))) + (save-excursion + (goto-char (point-min)) + (insert-char ? ;;; + (max 0 (/ (- (window-width) (length gnus-version)) 2))) + (insert gnus-version "\n")) ;; Paint it. (put-text-property (point-min) (point-max) 'face 'gnus-splash-face))) (setq modeline-buffer-identification diff --git a/lisp/mailheader.el b/lisp/mailheader.el index 5e2b097..6eb5669 100644 --- a/lisp/mailheader.el +++ b/lisp/mailheader.el @@ -60,7 +60,7 @@ that name." start end) (while (and (setq start (point)) (> (skip-chars-forward "^\0- :") 0) - (= (following-char) ?:) + (eq (char-after) ?:) (setq end (point)) (progn (forward-char) (> (skip-chars-forward " \t") 0))) diff --git a/lisp/message.el b/lisp/message.el index 212d8d0..e9171ac 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -4,7 +4,9 @@ ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko ;; Shuhei KOBAYASHI -;; Keiichi Suzuki +;; Keiichi Suzuki +;; Katsumi Yamaoka +;; Kiyokazu SUTO ;; Keywords: mail, news, MIME ;; This file is part of GNU Emacs. @@ -333,7 +335,7 @@ If t, use `message-user-organization-file'." :type 'boolean) (defcustom message-included-forward-headers - "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-\\|^Message-ID:\\|^References:\\|^Content-\\|^MIME-Version:" + "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-\\|^Message-ID:\\|^References:\\|^Content-Transfer-Encoding:\\|^Content-Type:\\|^MIME-Version:" "*Regexp matching headers to be included in forwarded messages." :group 'message-forwarding :type 'regexp) @@ -614,7 +616,6 @@ If stringp, use this; if non-nil, use no host name (user name only)." (defvar message-reply-buffer nil) (defvar message-reply-headers nil) -(defvar message-user-agent nil) ; XXX: This symbol is overloaded! See below. (defvar message-sent-message-via nil) (defvar message-checksum nil) (defvar message-send-actions nil @@ -1094,12 +1095,12 @@ The cdr of ech entry is a function for applying the face to a region.") (not paren)))) (push (buffer-substring beg (point)) elems) (setq beg (match-end 0))) - ((= (following-char) ?\") + ((eq (char-after) ?\") (setq quoted (not quoted))) - ((and (= (following-char) ?\() + ((and (eq (char-after) ?\() (not quoted)) (setq paren t)) - ((and (= (following-char) ?\)) + ((and (eq (char-after) ?\)) (not quoted)) (setq paren nil)))) (nreverse elems))))) @@ -2157,11 +2158,56 @@ the user from the mailer." (eval (car actions))))) (pop actions))) +(defsubst message-maybe-split-and-send-mail () + "Split a message if necessary, and send it via mail. +Returns nil if sending succeeded, returns any string if sending failed. +This sub function is for exclusive use of `message-send-mail'." + (let ((mime-edit-split-ignored-field-regexp + mime-edit-split-ignored-field-regexp) + (case-fold-search t) + failure) + (while (string-match "Message-ID" mime-edit-split-ignored-field-regexp) + (setq mime-edit-split-ignored-field-regexp + (concat (substring mime-edit-split-ignored-field-regexp + 0 (match-beginning 0)) + "Hey_MIME-Edit,_there_is_an_inviolable_Message_ID" + "_so_don't_rape_it!" + (substring mime-edit-split-ignored-field-regexp + (match-end 0))))) + (setq failure + (or + (catch 'message-sending-mail-failure + (mime-edit-maybe-split-and-send + (function + (lambda () + (interactive) + (save-restriction + (std11-narrow-to-header mail-header-separator) + (goto-char (point-min)) + (when (re-search-forward "^Message-ID:" nil t) + (delete-region (match-end 0) (std11-field-end)) + (insert " " (message-make-message-id)))) + (condition-case err + (funcall message-send-mail-function) + (error + (throw 'message-sending-mail-failure err)))))) + nil) + (condition-case err + (progn + (funcall message-send-mail-function) + nil) + (error err)))) + (when failure + (if (eq 'error (car failure)) + (cadr failure) + (prin1-to-string failure))))) + (defun message-send-mail (&optional arg) (require 'mail-utils) (let ((tembuf (message-generate-new-buffer-clone-locals " message temp")) (case-fold-search nil) - (news (message-news-p))) + (news (message-news-p)) + failure) (save-restriction (message-narrow-to-headers) ;; Insert some headers. @@ -2176,7 +2222,6 @@ the user from the mailer." (if (not (message-check-mail-syntax)) (progn (message "") - ;;(message "Posting not performed") nil) (unwind-protect (save-excursion @@ -2186,25 +2231,24 @@ the user from the mailer." ;; Remove some headers. (save-restriction (message-narrow-to-headers) + ;; Remove some headers. (message-remove-header message-ignored-mail-headers t)) (goto-char (point-max)) ;; require one newline at the end. - (or (= (preceding-char) ?\n) + (or (eq (char-before) ?\n) (insert ?\n)) (when (and news (or (message-fetch-field "cc") (message-fetch-field "to"))) (message-insert-courtesy-copy)) - (mime-edit-maybe-split-and-send - (function - (lambda () - (interactive) - (funcall message-send-mail-function) - ))) - (funcall message-send-mail-function)) + (setq failure (message-maybe-split-and-send-mail))) (kill-buffer tembuf)) (set-buffer message-edit-buffer) - (push 'mail message-sent-message-via)))) + (if failure + (progn + (message "Couldn't send message via mail: %s" failure) + nil) + (push 'mail message-sent-message-via))))) (defun message-send-mail-with-sendmail () "Send off the prepared buffer with sendmail." @@ -2358,6 +2402,38 @@ to find out how to use this." (error "Sending failed; " result))) (error "Sending failed; no recipients")))) +(defsubst message-maybe-split-and-send-news (method) + "Split a message if necessary, and send it via news. +Returns nil if sending succeeded, returns t if sending failed. +This sub function is for exclusive use of `message-send-news'." + (let ((mime-edit-split-ignored-field-regexp + mime-edit-split-ignored-field-regexp) + (case-fold-search t)) + (while (string-match "Message-ID" mime-edit-split-ignored-field-regexp) + (setq mime-edit-split-ignored-field-regexp + (concat (substring mime-edit-split-ignored-field-regexp + 0 (match-beginning 0)) + "Hey_MIME-Edit,_there_is_an_inviolable_Message_ID" + "_so_don't_rape_it!" + (substring mime-edit-split-ignored-field-regexp + (match-end 0))))) + (or + (catch 'message-sending-news-failure + (mime-edit-maybe-split-and-send + (function + (lambda () + (interactive) + (save-restriction + (std11-narrow-to-header mail-header-separator) + (goto-char (point-min)) + (when (re-search-forward "^Message-ID:" nil t) + (delete-region (match-end 0) (std11-field-end)) + (insert " " (message-make-message-id)))) + (unless (funcall message-send-news-function method) + (throw 'message-sending-news-failure t))))) + nil) + (not (funcall message-send-news-function method))))) + (defun message-send-news (&optional arg) (let ((tembuf (message-generate-new-buffer-clone-locals " *message temp*")) (case-fold-search nil) @@ -2381,10 +2457,7 @@ to find out how to use this." (run-hooks 'message-header-encoded-hook)) (message-cleanup-headers) (if (not (message-check-news-syntax)) - (progn - (message "") - ;;(message "Posting not performed") - nil) + nil (unwind-protect (save-excursion (set-buffer tembuf) @@ -2398,29 +2471,17 @@ to find out how to use this." (message-remove-header message-ignored-news-headers t)) (goto-char (point-max)) ;; require one newline at the end. - (or (= (preceding-char) ?\n) + (or (eq (char-before) ?\n) (insert ?\n)) - (mime-edit-maybe-split-and-send - (function - (lambda () - (interactive) - (save-restriction - (std11-narrow-to-header mail-header-separator) - (goto-char (point-min)) - (when (re-search-forward "^Message-Id:" nil t) - (delete-region (match-end 0)(std11-field-end)) - (insert (concat " " (message-make-message-id))) - )) - (funcall message-send-news-function method) - ))) - (setq result (funcall message-send-news-function method))) + (setq result (message-maybe-split-and-send-news method))) (kill-buffer tembuf)) (set-buffer message-edit-buffer) (if result - (push 'news message-sent-message-via) - (message "Couldn't send message via news: %s" - (nnheader-get-report (car method))) - nil)))) + (progn + (message "Couldn't send message via news: %s" + (nnheader-get-report (car method))) + nil) + (push 'news message-sent-message-via))))) ;; 1997-09-29 by MORIOKA Tomohiko (defun message-send-news-with-gnus (method) @@ -2780,8 +2841,8 @@ to find out how to use this." (concat "^" (regexp-quote mail-header-separator) "$")) (while (not (eobp)) (when (not (looking-at "[ \t\n]")) - (setq sum (logxor (ash sum 1) (if (natnump sum) 0 1) - (following-char)))) + (setq sum (logxor (ash sum 1) (if (natnump sum) 0 1) + (char-after)))) (forward-char 1))) sum)) @@ -3194,7 +3255,9 @@ Headers already prepared in the buffer are not modified." (progn ;; The header was found. We insert a space after the ;; colon, if there is none. - (if (/= (following-char) ? ) (insert " ") (forward-char 1)) + (if (eq (char-after) ? ) + (forward-char 1) + (insert " ")) ;; Find out whether the header is empty... (looking-at "[ \t]*$"))) ;; So we find out what value we should insert. @@ -3303,7 +3366,7 @@ Headers already prepared in the buffer are not modified." (goto-char (point-min)) (while (not (eobp)) (skip-chars-forward "^,\"" (point-max)) - (if (or (= (following-char) ?,) + (if (or (eq (char-after) ?,) (eobp)) (when (not quoted) (if (and (> (current-column) 78) @@ -3375,7 +3438,7 @@ Headers already prepared in the buffer are not modified." (search-backward ":" ) (widen) (forward-char 1) - (if (= (following-char) ? ) + (if (eq (char-after) ? ) (forward-char 1) (insert " "))) (t @@ -3577,12 +3640,12 @@ OTHER-HEADERS is an alist of header/value pairs." (Subject . ,(or subject "")))))) ;;;###autoload -(defun message-reply (&optional to-address wide) +(defun message-reply (&optional to-address wide references) "Start editing a reply to the article in the current buffer." (interactive) (let ((cur (current-buffer)) from subject date reply-to to cc - references message-id follow-to + message-id follow-to (inhibit-point-motion-hooks t) mct never-mct gnus-warning) (save-restriction @@ -3605,7 +3668,7 @@ OTHER-HEADERS is an alist of header/value pairs." cc (message-fetch-field "cc") mct (message-fetch-field "mail-copies-to") reply-to (message-fetch-field "reply-to") - references (message-fetch-field "references") + references (or references (message-fetch-field "references")) message-id (message-fetch-field "message-id" t)) ;; Remove any (buggy) Re:'s that are present and make a ;; proper one. @@ -3685,19 +3748,19 @@ OTHER-HEADERS is an alist of header/value pairs." cur))) ;;;###autoload -(defun message-wide-reply (&optional to-address) +(defun message-wide-reply (&optional to-address references) "Make a \"wide\" reply to the message in the current buffer." (interactive) - (message-reply to-address t)) + (message-reply to-address t references)) ;;;###autoload -(defun message-followup (&optional to-newsgroups) +(defun message-followup (&optional to-newsgroups references) "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 reply-to mct - references message-id follow-to + message-id follow-to (inhibit-point-motion-hooks t) (message-this-is-news t) followup-to distribution newsgroups gnus-warning posted-to) @@ -3713,7 +3776,7 @@ If TO-NEWSGROUPS, use that as the new Newsgroups line." (setq from (message-fetch-field "from") date (message-fetch-field "date") subject (or (message-fetch-field "subject") "none") - references (message-fetch-field "references") + references (or references (message-fetch-field "references")) message-id (message-fetch-field "message-id" t) followup-to (message-fetch-field "followup-to") newsgroups (message-fetch-field "newsgroups") @@ -4201,7 +4264,7 @@ which specify the range to operate on." (goto-char (min start end)) (while (< (point) end1) (or (looking-at "[_\^@- ]") - (insert (following-char) "\b")) + (insert (char-after) "\b")) (forward-char 1))))) ;;;###autoload @@ -4215,7 +4278,7 @@ which specify the range to operate on." (move-marker end1 (max start end)) (goto-char (min start end)) (while (re-search-forward "\b" end1 t) - (if (eq (following-char) (char-after (- (point) 2))) + (if (eq (char-after) (char-after (- (point) 2))) (delete-char -2)))))) (defalias 'message-exchange-point-and-mark 'exchange-point-and-mark) @@ -4396,21 +4459,6 @@ regexp varstr." (turn-on-mime-edit) (add-to-list 'buffer-file-format 'mime-message)) -;;; Miscellaneous functions - -;; stolen (and renamed) from nnheader.el -(defun message-replace-chars-in-string (string from to) - "Replace characters in STRING from FROM to TO." - (let ((string (substring string 0)) ;Copy string. - (len (length string)) - (idx 0)) - ;; Replace all occurrences of FROM with TO. - (while (< idx len) - (when (= (aref string idx) from) - (aset string idx to)) - (setq idx (1+ idx))) - string)) - (run-hooks 'message-load-hook) (provide 'message) diff --git a/lisp/nnheader.el b/lisp/nnheader.el index 43e3147..4249394 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -4,6 +4,7 @@ ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko +;; Katsumi Yamaoka ;; Keywords: mail, news, MIME ;; This file is part of GNU Emacs. @@ -272,14 +273,12 @@ on your system, you could say something like: (defmacro nnheader-nov-read-integer () '(prog1 - (if (= (following-char) ?\t) + (if (eq (char-after) ?\t) 0 (let ((num (ignore-errors (read (current-buffer))))) (if (numberp num) num 0))) (or (eobp) (forward-char 1)))) -;; (defvar nnheader-none-counter 0) - (defun nnheader-parse-nov () (let ((eol (gnus-point-at-eol))) (make-full-mail-header @@ -292,7 +291,7 @@ on your system, you could say something like: (nnheader-nov-field) ; refs (nnheader-nov-read-integer) ; chars (nnheader-nov-read-integer) ; lines - (if (= (following-char) ?\n) + (if (eq (char-after) ?\n) nil (nnheader-nov-field)) ; misc ))) @@ -387,6 +386,7 @@ the line could be found." ;; Various cruft the backends and Gnus need to communicate. (defvar nntp-server-buffer nil) +(defvar nntp-process-response nil) (defvar gnus-verbose-backends 7 "*A number that says how talkative the Gnus backends should be.") (defvar gnus-nov-is-evil nil @@ -405,6 +405,7 @@ the line could be found." (erase-buffer) (kill-all-local-variables) (setq case-fold-search t) ;Should ignore case. + (set (make-local-variable 'nntp-process-response) nil) t)) ;;; Various functions the backends use. @@ -690,7 +691,7 @@ without formatting." (or (not (numberp gnus-verbose-backends)) (<= level gnus-verbose-backends))) -(defvar nnheader-pathname-coding-system 'iso-8859-1 +(defvar nnheader-pathname-coding-system 'binary "*Coding system for pathname.") (defun nnheader-group-pathname (group dir &optional file) diff --git a/lisp/nnheaderxm.el b/lisp/nnheaderxm.el index 7c1435c..8a38564 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. diff --git a/lisp/nnmail.el b/lisp/nnmail.el index b6f3ac8..377ecff 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -453,6 +453,11 @@ parameter. It should return nil, `warn' or `delete'." (const warn) (const delete))) +(defcustom nnmail-split-header-length-limit 1024 + "Header lines longer than this limit are excluded from the split function." + :group 'nnmail + :type 'integer) + ;;; Internal variables. (defvar nnmail-split-history nil @@ -529,8 +534,7 @@ If this variable is `t', do not use password cache.") t) (file-error nil)))) -(defvar nnmail-pathname-coding-system - 'iso-8859-1 +(defvar nnmail-pathname-coding-system 'binary "*Coding system for pathname.") (defun nnmail-group-pathname (group dir &optional file) @@ -887,7 +891,7 @@ is a spool. If not using procmail, return GROUP." (when (and (or (bobp) (save-excursion (forward-line -1) - (= (following-char) ?\n))) + (eq (char-after) ?\n))) (save-excursion (forward-line 1) (while (looking-at ">From \\|From ") @@ -916,7 +920,7 @@ is a spool. If not using procmail, return GROUP." (when (and (or (bobp) (save-excursion (forward-line -1) - (= (following-char) ?\n))) + (eq (char-after) ?\n))) (save-excursion (forward-line 1) (while (looking-at ">From \\|From ") @@ -1132,10 +1136,10 @@ FUNC will be called with the group name to determine the article number." ;; existence to process. (goto-char (point-min)) (while (not (eobp)) - (end-of-line) - (if (> (current-column) 1024) - (gnus-delete-line) - (forward-line 1))) + (unless (< (move-to-column nnmail-split-header-length-limit) + nnmail-split-header-length-limit) + (delete-region (point) (progn (end-of-line) (point)))) + (forward-line 1)) ;; Allow washing. (goto-char (point-min)) (run-hooks 'nnmail-split-hook) @@ -1789,11 +1793,11 @@ If ARGS, PROMPT is used as an argument to `format'." (goto-char (point-min)) (while (re-search-forward "[^ \t=]+" nil t) (setq name (match-string 0)) - (if (not (= (following-char) ?=)) + (if (not (eq (char-after) ?=)) ;; Implied "yes". (setq value "yes") (forward-char 1) - (if (not (= (following-char) ?\")) + (if (not (eq (char-after) ?\")) (if (not (looking-at "[^ \t]")) ;; Implied "no". (setq value "no") diff --git a/lisp/nnmh.el b/lisp/nnmh.el index 8997237..462c60a 100644 --- a/lisp/nnmh.el +++ b/lisp/nnmh.el @@ -110,7 +110,6 @@ (when large (nnheader-message 5 "nnmh: Receiving headers...done")) - ;; (nnheader-fold-continuation-lines) 'headers)))) (deffoo nnmh-open-server (server &optional defs) @@ -294,7 +293,9 @@ (deffoo nnmh-request-accept-article (group &optional server last noinsert) (nnmh-possibly-change-directory group server) - (nnmail-check-syntax) + (if (and (not (equal group "queue")) + (not (equal group "draft"))) + (nnmail-check-syntax)) (when nnmail-cache-accepted-message-ids (nnmail-cache-insert (nnmail-fetch-field "message-id"))) (nnheader-init-server-buffer) diff --git a/lisp/nnsoup.el b/lisp/nnsoup.el index e764150..76160f9 100644 --- a/lisp/nnsoup.el +++ b/lisp/nnsoup.el @@ -687,7 +687,7 @@ backend for the messages.") (message-remove-header message-ignored-mail-headers t)) (goto-char (point-max)) ;; require one newline at the end. - (or (= (preceding-char) ?\n) + (or (eq (char-before) ?\n) (insert ?\n)) (let ((case-fold-search t)) ;; Change header-delimiter to be what sendmail expects. diff --git a/lisp/nnspool.el b/lisp/nnspool.el index 6914f78..1cca067 100644 --- a/lisp/nnspool.el +++ b/lisp/nnspool.el @@ -137,9 +137,13 @@ there.") (setq beg (point)) (inline (nnheader-insert-head file)) (goto-char beg) - (search-forward "\n\n" nil t) - (forward-char -1) - (insert ".\n") + (if (search-forward "\n\n" nil t) + (progn (forward-char -1) + (insert ".\n")) + (goto-char (point-max)) + (if (bolp) + (insert ".\n") + (insert "\n.\n"))) (delete-region (point) (point-max))) (and do-message diff --git a/lisp/nntp.el b/lisp/nntp.el index d7665b5..9f2be03 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -2,6 +2,7 @@ ;;; Copyright (C) 1987-90,92-97 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen +;; Katsumi Yamaoka ;; Keywords: news ;; This file is part of GNU Emacs. @@ -173,6 +174,10 @@ server there that you can connect to. See also "*Number of seconds to wait before an nntp connection times out. If this variable is nil, which is the default, no timers are set.") +(defvoo nntp-prepare-post-hook nil + "*Hook run just before posting an article. It is supposed to be used for +inserting Cancel-Lock headers, signing with Gpg, etc.") + ;;; Internal variables. (defvar nntp-record-commands nil @@ -254,13 +259,18 @@ If this variable is nil, which is the default, no timers are set.") (nnheader-report 'nntp "Server closed connection")) (t (goto-char (point-max)) - (let ((limit (point-min))) + (let ((limit (point-min)) + response) (while (not (re-search-backward wait-for limit t)) (nntp-accept-process-output process) ;; We assume that whatever we wait for is less than 1000 ;; characters long. (setq limit (max (- (point-max) 1000) (point-min))) - (goto-char (point-max)))) + (goto-char (point-max))) + (setq response (match-string 0)) + (save-current-buffer + (set-buffer nntp-server-buffer) + (setq nntp-process-response response))) (nntp-decode-text (not decode)) (unless discard (save-excursion @@ -390,7 +400,7 @@ If this variable is nil, which is the default, no timers are set.") (cond ;; A result that starts with a 2xx code is terminated by ;; a line with only a "." on it. - ((eq (following-char) ?2) + ((eq (char-after) ?2) (if (re-search-forward "\n\\.\r?\n" nil t) t nil)) @@ -724,7 +734,24 @@ If this variable is nil, which is the default, no timers are set.") (deffoo nntp-request-post (&optional server) (nntp-possibly-change-group nil server) (when (nntp-send-command "^[23].*\r?\n" "POST") - (nntp-send-buffer "^[23].*\n"))) + (let ((response (save-current-buffer + (set-buffer nntp-server-buffer) + nntp-process-response)) + server-id) + (when (and response + (string-match "^[23].*\\(<[^\t\n @<>]+@[^\t\n @<>]+>\\)" + response)) + (setq server-id (match-string 1 response)) + (narrow-to-region (goto-char (point-min)) + (if (search-forward "\n\n" nil t) + (1- (point)) + (point-max))) + (unless (mail-fetch-field "Message-ID") + (goto-char (point-min)) + (insert "Message-ID: " server-id "\n")) + (widen)) + (run-hooks 'nntp-prepare-post-hook) + (nntp-send-buffer "^[23].*\n")))) (deffoo nntp-request-type (group article) 'news) diff --git a/lisp/parse-time.el b/lisp/parse-time.el index e25abbb..f076aea 100644 --- a/lisp/parse-time.el +++ b/lisp/parse-time.el @@ -38,10 +38,8 @@ (eval-when-compile (require 'cl)) ;and ah ain't kiddin' 'bout it -(put 'parse-time-syntax 'char-table-extra-slots 0) - -(defvar parse-time-syntax (make-char-table 'parse-time-syntax)) -(defvar parse-time-digits (make-char-table 'parse-time-syntax)) +(defvar parse-time-syntax (make-vector 256 nil)) +(defvar parse-time-digits (make-vector 256 nil)) ;; Byte-compiler warnings (defvar elt) @@ -49,18 +47,18 @@ (unless (aref parse-time-digits ?0) (loop for i from ?0 to ?9 - do (set-char-table-range parse-time-digits i (- i ?0)))) + do (aset parse-time-digits i (- i ?0)))) (unless (aref parse-time-syntax ?0) (loop for i from ?0 to ?9 - do (set-char-table-range parse-time-syntax i ?0)) + do (aset parse-time-syntax i ?0)) (loop for i from ?A to ?Z - do (set-char-table-range parse-time-syntax i ?A)) + do (aset parse-time-syntax i ?A)) (loop for i from ?a to ?z - do (set-char-table-range parse-time-syntax i ?a)) - (set-char-table-range parse-time-syntax ?+ 1) - (set-char-table-range parse-time-syntax ?- -1) - (set-char-table-range parse-time-syntax ?: ?d) + do (aset parse-time-syntax i ?a)) + (aset parse-time-syntax ?+ 1) + (aset parse-time-syntax ?- -1) + (aset parse-time-syntax ?: ?d) ) (defsubst digit-char-p (char) @@ -89,7 +87,8 @@ (setq integer (+ (* integer 10) digit) index (1+ index))) (if (/= index end) - (signal 'parse-error `("not an integer" ,(substring string (or start 0) end))) + (signal 'parse-error `("not an integer" + ,(substring string (or start 0) end))) (* sign integer)))))) (defun parse-time-tokenize (string) @@ -114,24 +113,24 @@ list))) (nreverse list))) -(defvar parse-time-months '(("Jan" . 1) ("Feb" . 2) ("Mar" . 3) - ("Apr" . 4) ("May" . 5) ("Jun" . 6) - ("Jul" . 7) ("Aug" . 8) ("Sep" . 9) - ("Oct" . 10) ("Nov" . 11) ("Dec" . 12))) -(defvar parse-time-weekdays '(("Sun" . 0) ("Mon" . 1) ("Tue" . 2) - ("Wed" . 3) ("Thu" . 4) ("Fri" . 5) ("Sat" . 6))) -(defvar parse-time-zoneinfo `(("Z" 0) ("UT" 0) ("GMT" 0) - ("PST" ,(* -8 3600)) ("PDT" ,(* -7 3600) t) - ("MST" ,(* -7 3600)) ("MDT" ,(* -6 3600) t) - ("CST" ,(* -6 3600)) ("CDT" ,(* -5 3600) t) - ("EST" ,(* -5 3600)) ("EDT" ,(* -4 3600) t)) +(defvar parse-time-months '(("jan" . 1) ("feb" . 2) ("mar" . 3) + ("apr" . 4) ("may" . 5) ("jun" . 6) + ("jul" . 7) ("aug" . 8) ("sep" . 9) + ("oct" . 10) ("nov" . 11) ("dec" . 12))) +(defvar parse-time-weekdays '(("sun" . 0) ("mon" . 1) ("tue" . 2) + ("wed" . 3) ("thu" . 4) ("fri" . 5) ("sat" . 6))) +(defvar parse-time-zoneinfo `(("z" 0) ("ut" 0) ("gmt" 0) + ("pst" ,(* -8 3600)) ("pdt" ,(* -7 3600) t) + ("mst" ,(* -7 3600)) ("mdt" ,(* -6 3600) t) + ("cst" ,(* -6 3600)) ("cdt" ,(* -5 3600) t) + ("est" ,(* -5 3600)) ("edt" ,(* -4 3600) t)) "(zoneinfo seconds-off daylight-savings-time-p)") (defvar parse-time-rules `(((6) parse-time-weekdays) ((3) (1 31)) ((4) parse-time-months) - ((5) (1970 2038)) + ((5) (100 4038)) ((2 1 0) ,#'(lambda () (and (stringp elt) (= (length elt) 8) @@ -150,20 +149,34 @@ (* 60 (parse-integer elt 1 3))) (if (= (aref elt 0) ?-) -1 1)))) ((5 4 3) - ,#'(lambda () (and (stringp elt) (= (length elt) 10) (= (aref elt 4) ?-) (= (aref elt 7) ?-))) + ,#'(lambda () (and (stringp elt) + (= (length elt) 10) + (= (aref elt 4) ?-) + (= (aref elt 7) ?-))) [0 4] [5 7] [8 10]) - ((2 1) + ((2 1 0) ,#'(lambda () (and (stringp elt) (= (length elt) 5) (= (aref elt 2) ?:))) - [0 2] [3 5]) - ((5) (70 99) ,#'(lambda () (+ 1900 elt)))) + [0 2] [3 5] ,#'(lambda () 0)) + ((2 1 0) + ,#'(lambda () (and (stringp elt) + (= (length elt) 4) + (= (aref elt 1) ?:))) + [0 1] [2 4] ,#'(lambda () 0)) + ((2 1 0) + ,#'(lambda () (and (stringp elt) + (= (length elt) 7) + (= (aref elt 1) ?:))) + [0 1] [2 4] [5 7]) + ((5) (50 99) ,#'(lambda () (+ 1900 elt))) + ((5) (0 49) ,#'(lambda () (+ 2000 elt)))) "(slots predicate extractor...)") (defun parse-time-string (string) "Parse the time-string STRING into (SEC MIN HOUR DAY MON YEAR DOW DST TZ). The values are identical to those of `decode-time', but any values that are unknown are returned as nil." - (let ((time (list nil nil nil nil nil nil nil nil nil nil)) - (temp (parse-time-tokenize string))) + (let ((time (list nil nil nil nil nil nil nil nil nil)) + (temp (parse-time-tokenize (downcase string)))) (while temp (let ((elt (pop temp)) (rules parse-time-rules) @@ -173,25 +186,27 @@ unknown are returned as nil." (slots (pop rule)) (predicate (pop rule)) (val)) - (if (and (not (nth (car slots) time)) ;not already set - (setq val (cond ((and (consp predicate) - (not (eq (car predicate) 'lambda))) - (and (numberp elt) - (<= (car predicate) elt) - (<= elt (cadr predicate)) - elt)) - ((symbolp predicate) - (cdr (assoc elt (symbol-value predicate)))) - ((funcall predicate))))) - (progn - (setq exit t) - (while slots - (let ((new-val (and rule - (let ((this (pop rule))) - (if (vectorp this) - (parse-integer elt (aref this 0) (aref this 1)) - (funcall this)))))) - (rplaca (nthcdr (pop slots) time) (or new-val val)))))))))) + (when (and (not (nth (car slots) time)) ;not already set + (setq val (cond ((and (consp predicate) + (not (eq (car predicate) + 'lambda))) + (and (numberp elt) + (<= (car predicate) elt) + (<= elt (cadr predicate)) + elt)) + ((symbolp predicate) + (cdr (assoc elt + (symbol-value predicate)))) + ((funcall predicate))))) + (setq exit t) + (while slots + (let ((new-val (and rule + (let ((this (pop rule))) + (if (vectorp this) + (parse-integer + elt (aref this 0) (aref this 1)) + (funcall this)))))) + (rplaca (nthcdr (pop slots) time) (or new-val val))))))))) time)) (provide 'parse-time) diff --git a/lisp/pop3-fma.el b/lisp/pop3-fma.el index 293efe6..90db4d2 100644 --- a/lisp/pop3-fma.el +++ b/lisp/pop3-fma.el @@ -3,7 +3,7 @@ ;; Yasuo Okabe ;; Author: Tatsuya Ichikawa ;; Yasuo OKABE -;; Version: 1.16 +;; Version: 1.17 ;; Keywords: mail , gnus , pop3 ;; ;; SPECIAL THANKS @@ -92,7 +92,8 @@ ;; "Goodbye Game" ; 1.12 ;; "Love is Gamble" ; 1.13 ;; "Lonely" ; 1.14 - "Feel the wind" ; 1.16 +;; "Feel the wind" ; 1.16 + "Sadness like snow" ; 1.17 ) (defconst pop3-fma-version (format "Multiple POP3 account utiliy for Gnus v%s - \"%s\"" pop3-fma-version-number @@ -211,8 +212,8 @@ If there is any problem , please set this variable to nil(default). (substring inbox (match-end (string-match "^po:" inbox)) (- (match-end (string-match "^.*@" inbox)) 1))))) (pop3-authentication-scheme - (nth 1 (assoc inbox pop3-fma-spool-file-alist))) - (pop3-fma-movemail-type (pop3-fma-get-movemail-type inbox))) + (nth 1 (assoc inbox pop3-fma-spool-file-alist)))) +;; (pop3-fma-movemail-type (pop3-fma-get-movemail-type inbox))) (if (eq pop3-authentication-scheme 'pass) (message "Checking new mail user %s at %s using USER/PASS ..." pop3-maildrop pop3-mailhost) (message "Checking new mail user %s at %s using APOP ..." pop3-maildrop pop3-mailhost)) @@ -223,13 +224,22 @@ If there is any problem , please set this variable to nil(default). (if (and (not (memq pop3-password pop3-fma-commandline-arguments)) (not (memq (concat "po:" pop3-maildrop) pop3-fma-commandline-arguments))) (progn - (setq pop3-fma-commandline-arguments - (append - pop3-fma-movemail-arguments - (list - (concat "po:" pop3-maildrop) - crashbox - pop3-password))))) + (if (eq pop3-authentication-scheme 'apop) + (setq pop3-fma-commandline-arguments + (append + pop3-fma-movemail-arguments + (list + "-A" + (concat "po:" pop3-maildrop) + crashbox + pop3-password))) + (setq pop3-fma-commandline-arguments + (append + pop3-fma-movemail-arguments + (list + (concat "po:" pop3-maildrop) + crashbox + pop3-password)))))) (if (not (get-buffer movemail-output-buffer)) (get-buffer-create movemail-output-buffer)) (set-buffer movemail-output-buffer) diff --git a/lisp/pop3.el b/lisp/pop3.el index 3b486a4..235c4fc 100644 --- a/lisp/pop3.el +++ b/lisp/pop3.el @@ -176,22 +176,6 @@ Return the response string if optional second argument is non-nil." t) ))))) -(defun pop3-string-to-list (string &optional regexp) - "Chop up a string into a list." - (let ((list) - (regexp (or regexp " ")) - (string (if (string-match "\r" string) - (substring string 0 (match-beginning 0)) - string))) - (store-match-data nil) - (while string - (if (string-match regexp string) - (setq list (cons (substring string 0 (- (match-end 0) 1)) list) - string (substring string (match-end 0))) - (setq list (cons string list) - string nil))) - (nreverse list))) - (defvar pop3-read-passwd nil) (defun pop3-read-passwd (prompt) (if (not pop3-read-passwd) @@ -217,7 +201,8 @@ Return the response string if optional second argument is non-nil." (defun pop3-munge-message-separator (start end) "Check to see if a message separator exists. If not, generate one." - (if (not (fboundp 'message-make-date)) (autoload 'message-make-date "message")) + (if (not (fboundp 'parse-time-string)) + (autoload 'parse-time-string "parse-time")) (save-excursion (save-restriction (narrow-to-region start end) @@ -227,26 +212,18 @@ Return the response string if optional second argument is non-nil." (looking-at "BABYL OPTIONS:") ; Babyl )) (let ((from (mail-strip-quoted-names (mail-fetch-field "From"))) - (date (pop3-string-to-list (or (mail-fetch-field "Date") - (message-make-date)))) + (date (mail-fetch-field "Date")) (From_)) ;; sample date formats I have seen ;; Date: Tue, 9 Jul 1996 09:04:21 -0400 (EDT) ;; Date: 08 Jul 1996 23:22:24 -0400 ;; should be ;; Tue Jul 9 09:04:21 1996 - (setq date - (cond ((string-match "[A-Z]" (nth 0 date)) - (format "%s %s %s %s %s" - (nth 0 date) (nth 2 date) (nth 1 date) - (nth 4 date) (nth 3 date))) - (t - ;; this really needs to be better but I don't feel - ;; like writing a date to day converter. - (format "Sun %s %s %s %s" - (nth 1 date) (nth 0 date) - (nth 3 date) (nth 2 date))) - )) + (setq date (format-time-string + "%a %b %e %T %Y" + (if date + (apply 'encode-time (parse-time-string date)) + (current-time)))) (setq From_ (format "\nFrom %s %s\n" from date)) (while (string-match "," From_) (setq From_ (concat (substring From_ 0 (match-beginning 0)) @@ -287,8 +264,8 @@ Return the response string if optional second argument is non-nil." "Return the number of messages in the maildrop and the maildrop's size." (pop3-send-command process "STAT") (let ((response (pop3-read-response process t))) - (list (string-to-int (nth 1 (pop3-string-to-list response))) - (string-to-int (nth 2 (pop3-string-to-list response)))) + (list (string-to-int (nth 1 (split-string response))) + (string-to-int (nth 2 (split-string response)))) )) (defun pop3-list (process &optional msg) @@ -350,7 +327,7 @@ This function currently does nothing.") "Return highest accessed message-id number for the session." (pop3-send-command process "LAST") (let ((response (pop3-read-response process t))) - (string-to-int (nth 1 (pop3-string-to-list response))) + (string-to-int (nth 1 (split-string response))) )) (defun pop3-rset (process) diff --git a/lisp/smiley.el b/lisp/smiley.el index e6c13f7..87ea5e0 100644 --- a/lisp/smiley.el +++ b/lisp/smiley.el @@ -294,7 +294,7 @@ Mouse button3 - menu")) (save-excursion (goto-char start) (when (and (re-search-backward "[()]" nil t) - (= (following-char) ?\() + (eq (char-after) ?\() (goto-char end) (or (not (re-search-forward "[()]" nil t)) (= (char-after (1- (point))) ?\())) diff --git a/texi/gnus-ja.texi b/texi/gnus-ja.texi index ad2cba7..12cf1d0 100644 --- a/texi/gnus-ja.texi +++ b/texi/gnus-ja.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename gnus-ja -@settitle Semi-gnus 6.9.1 Manual +@settitle Semi-gnus 6.10 Manual @synindex fn cp @synindex vr cp @synindex pg cp @@ -345,7 +345,7 @@ into another language, under the above conditions for modified versions. @tex @titlepage -@title Semi-gnus 6.9.1 Manual +@title Semi-gnus 6.10 Manual @author by Lars Magne Ingebrigtsen @author by members of Semi-gnus mailing-list @@ -399,7 +399,7 @@ Semi-gnus $B$O!"Bg$-$J3($,F~$C$F$$$?$j$5$^$6$^$J7A<0$rMQ$$$?$j$7$F$$$k$A$g$C(B $B$J8@8l7w$r:9JL$7$^$;$s!#$"$"!"%/%j%s%4%s$NJ}$O(B Unicode Next Generation$B$r(B $B$*BT$A$/$@$5$$!#(B -$B$3$N@bL@=q$O(B Semi-gnus 6.9.1 $B$KBP1~$7$^$9!#(B +$B$3$N@bL@=q$O(B Semi-gnus 6.10 $B$KBP1~$7$^$9!#(B @end ifinfo @@ -18126,7 +18126,7 @@ Gnus $B$OH"$+$i=P$7$F$9$0$K(B @emph{$BHs>o$K(B} $B$h$/F0:n$7$^$9(B---$B2? @item @kbd{M-x gnus-version} $B$r;n$7$F2<$5$$!#$b$7!"(B -@samp{Semi-gnus 6.9.1 (based on Gnus 5.6.45; for SEMI 1.11, FLIM 1.12)} +@samp{Semi-gnus 6.10 (based on Gnus 5.6.45; for SEMI 1.12, FLIM 1.12)} $B$N$h$&$J$b$N$,=P$F$-$?$J$i!"@5$7$$%U%!%$%k$,FI$_9~$^$l$F$$$^$9!#(B $B$b$7!"(B@samp{NNTP 3.x} $B$d(B @samp{nntp flee} $B$N$h$&$J$b$N$,=P$F$-$?$H$-$O!"(B $B$=$3$K$"$k$$$/$D$+$N8E$$(B @file{.el} $B%U%!%$%k$,FI$_9~$^$l$F$$$^$9!#$=$l$i(B diff --git a/texi/gnus.texi b/texi/gnus.texi index 932f108..822ba87 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename gnus -@settitle Semi-gnus 6.9.1 Manual +@settitle Semi-gnus 6.10 Manual @synindex fn cp @synindex vr cp @synindex pg cp @@ -318,7 +318,7 @@ into another language, under the above conditions for modified versions. @tex @titlepage -@title Semi-gnus 6.9.1 Manual +@title Semi-gnus 6.10 Manual @author by Lars Magne Ingebrigtsen @page @@ -361,7 +361,7 @@ internationalization/localization and multiscript features based on MULE API. So Semi-gnus does not discriminate various language communities. Oh, if you are a Klingon, please wait Unicode Next Generation. -This manual corresponds to Semi-gnus 6.9.1. +This manual corresponds to Semi-gnus 6.10. @end ifinfo