-This package contains Semi-gnus 6.9.
+This package contains Semi-gnus 6.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)
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)
;; Copyright (C) 1997,98 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; Katsumi Yamaoka <yamaoka@jpl.org>
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
(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)
: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.
(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
(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))))))
"\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)
(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
(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)
(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)
;;;
(defun gnus-article-header-presentation-method (entity situation)
- (mime-insert-decoded-header entity)
+ (mime-insert-header entity)
)
(set-alist 'mime-header-presentation-method-alist
#'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)
(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
;;;
: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))
(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))
(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)
(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))
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
;; Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
+;; Katsumi Yamaoka <yamaoka@jpl.org>
+;; Kiyokazu SUTO <suto@merry.xmath.ous.ac.jp>
;; Keywords: mail, news, MIME
;; This file is part of GNU Emacs.
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
Thank you for your help in stamping out bugs.
"
-
gnus-product-name
(if (string= gnus-product-name "Semi-gnus")
""
(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)
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)
(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
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))))))
\f
-;; Dummy to avoid byte-compile warning.
-;;(defvar nnspool-rejected-article-hook)
-;;(defvar xemacs-codename)
-
(defun gnus-extended-version ()
"Stringified gnus version."
(interactive)
(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)))))
(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))))
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)
(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)
--- /dev/null
+;;; 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 <t-ichi@po.shiojiri.ne.jp>
+;;; Yukihiro Ito <ito@rs.civil.tohoku.ac.jp>
+;;; Hidekazu Nakamura <u90121@uis-inf.co.jp>
+;;; Tsukamoto Tetsuo <czkmt@remus.dti.ne.jp>
+
+;;; Version: 2.02
+;;; Keywords: news , mail , offline , gnus
+;;;
+;;; SPECIAL THANKS
+;;; Keiichi Suzuki <kei-suzu@mail.wbs.or.jp>
+;;; KORIYAMA Naohiro <kory@ba2.so-net.or.jp>
+;;; Katsumi Yamaoka <yamaoka@jpl.org>
+
+;;; 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))))
+\f
+;;
+;; 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))))
+
+\f
+;;
+;; 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."))
+
+\f
+;;
+;; 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 \e$B$K$"$k5-;v$NAw?.\e(B" news-spool-post t]
+ ["Spool \e$B$K$"$k\e(B Mail \e$B$NAw?.\e(B" mail-spool-send t]
+ "----"
+ ["Offline \e$B>uBV$X\e(B" message-offline-state (not message-offline-state)]
+ ["Online \e$B>uBV$X\e(B" message-online-state message-offline-state]
+ "----"
+ ("Gnus Offline"
+ ["movemail \e$B$N@ZBX$(\e(B" gnus-offline-toggle-movemail-program t]
+ ["\e$B<hF@5-;v<oN`$NJQ99\e(B" gnus-offline-toggle-articles-to-fetch t]
+ ["Mail \e$BAw?.J}K!\e(B(On/Off)\e$B$N@ZBX$(\e(B" gnus-offline-toggle-on/off-send-mail t]
+ ["\e$B<+F0@ZCG$N@ZBX$(\e(B" gnus-offline-toggle-auto-hangup t]
+ "----"
+ ["\e$B<hF@:Q5-;v$r>C$9\e(B" gnus-offline-agent-expire (eq gnus-offline-news-fetch-method 'nnagent)]
+ ["\e$B5-;v<hF@4V3V;~4V$N@_Dj\e(B" gnus-offline-set-interval-time t]
+ "----"
+ ["\e$B2s@~$N@ZCG\e(B" gnus-offline-set-unplugged-state gnus-offline-connected])
+ ))
+ (easy-menu-change
+ nil
+ "Miee"
+ '(
+ ["Post news in spool" news-spool-post t]
+ ["Send mails in spool" mail-spool-send t]
+ "----"
+ ["Message Offline" message-offline-state (not message-offline-state)]
+ ["Message Online" message-online-state message-offline-state]
+ "----"
+ ("Gnus Offline"
+ ["Toggle movemail program" gnus-offline-toggle-movemail-program t]
+ ["Toggle articles to fetch" gnus-offline-toggle-articles-to-fetch t]
+ ["Toggle online/offline send mail" gnus-offline-toggle-on/off-send-mail t]
+ ["Toggle auto hangup" gnus-offline-toggle-auto-hangup t]
+ "----"
+ ["Expire articles" gnus-offline-agent-expire (eq gnus-offline-news-fetch-method 'nnagent)]
+ ["Set interval time" gnus-offline-set-interval-time t]
+ "----"
+ ["Hang up Line." gnus-offline-set-unplugged-state gnus-offline-connected]
+ ))))))
+ (and (featurep 'xemacs)
+ (easy-menu-add menu))))
+;;
+;; define menu without miee.
+;;
+(defun gnus-offline-define-menu-on-agent ()
+ "*Set menu bar on OFFLINE menu."
+ (easy-menu-define
+ gnus-offline-menu-on-agent
+ gnus-group-mode-map
+ "Gnus offline Menu"
+ (if (featurep 'meadow)
+ '("Offline"
+ ["movemail \e$B$N@ZBX$(\e(B" gnus-offline-toggle-movemail-program t]
+ ["\e$B<hF@5-;v<oN`$NJQ99\e(B" gnus-offline-toggle-articles-to-fetch t]
+ ["Mail \e$BAw?.J}K!\e(B(On/Off)\e$B$N@ZBX$(\e(B" gnus-offline-toggle-on/off-send-mail t]
+ ["\e$B<+F0@ZCG$N@ZBX$(\e(B" gnus-offline-toggle-auto-hangup t]
+ "----"
+ ["\e$B<hF@:Q5-;v$r>C$9\e(B" gnus-offline-agent-expire (eq gnus-offline-news-fetch-method 'nnagent)]
+ ["\e$B5-;v<hF@4V3V;~4V$N@_Dj\e(B" gnus-offline-set-interval-time t]
+ "----"
+ ["\e$B2s@~$N@ZCG\e(B" gnus-offline-set-unplugged-state gnus-offline-connected])
+ '("Offline"
+ ["Toggle movemail program" gnus-offline-toggle-movemail-program t]
+ ["Toggle articles to fetch" gnus-offline-toggle-articles-to-fetch t]
+ ["Toggle online/offline send mail" gnus-offline-toggle-on/off-send-mail t]
+ ["Toggle auto hangup" gnus-offline-toggle-auto-hangup t]
+ "----"
+ ["Expire articles" gnus-offline-agent-expire (eq gnus-offline-news-fetch-method 'nnagent)]
+ ["Set interval time" gnus-offline-set-interval-time t]
+ "----"
+ ["Hang up Line." gnus-offline-set-unplugged-state gnus-offline-connected])))
+ (and (featurep 'xemacs)
+ (easy-menu-add gnus-offline-menu-on-agent)))
+;;
+;; Popup menu within the group buffer (under Emacs).
+;;
+(defun gnus-offline-popup-menu (event)
+ "Popup menu for Gnus offline."
+ (interactive "e")
+ (let* ((menu (if (boundp 'miee-popup-menu)
+ (or (assoc 'keymap
+ (assoc 'Miee (assoc 'menu-bar global-map)))
+ miee-popup-menu)
+ gnus-offline-menu-on-agent))
+ (pop (x-popup-menu t menu))
+ (func (and pop (lookup-key menu (apply 'vector pop)))))
+ (and pop func (funcall func))))
+\f
+;;
+;; Timer Function
+(defun gnus-offline-processed-by-timer ()
+ "*Set timer interval."
+ (if (and (> 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
--- /dev/null
+;;; 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 <t-ichi@po.shiojiri.ne.jp>
+;;;
+;;; 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.
(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)))
(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))
(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))
(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))
(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
(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
;; 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.
(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))
(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)
(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)
(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
(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.
(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)))
(setq ref
(buffer-substring
(progn
- ;; (end-of-line)
(search-backward ">" end t)
(1+ (point)))
(progn
(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)))
(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.
;; 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
(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."
;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; Katsumi Yamaoka <yamaoka@jpl.org>
;; Keywords: mail, news, MIME
;; This file is part of GNU Emacs.
"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)
;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; Katsumi Yamaoka <yamaoka@jpl.org>
;; Keywords: news
;; This file is part of GNU Emacs.
(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)
(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
(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
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)))
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
;; Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
-;; Keiichi Suzuki <kei-suzu@mail.wbs.ne.jp>
+;; Keiichi Suzuki <kei-suzu@mail.wbs.ne.jp>
+;; Katsumi Yamaoka <yamaoka@jpl.org>
+;; Kiyokazu SUTO <suto@merry.xmath.ous.ac.jp>
;; Keywords: mail, news, MIME
;; This file is part of GNU Emacs.
: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)
(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
(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)))))
(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.
(if (not (message-check-mail-syntax))
(progn
(message "")
- ;;(message "Posting not performed")
nil)
(unwind-protect
(save-excursion
;; 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."
(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)
(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)
(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)
(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))
(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.
(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)
(search-backward ":" )
(widen)
(forward-char 1)
- (if (= (following-char) ? )
+ (if (eq (char-after) ? )
(forward-char 1)
(insert " ")))
(t
(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
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.
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)
(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")
(goto-char (min start end))
(while (< (point) end1)
(or (looking-at "[_\^@- ]")
- (insert (following-char) "\b"))
+ (insert (char-after) "\b"))
(forward-char 1)))))
;;;###autoload
(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)
(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)
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Katsumi Yamaoka <yamaoka@jpl.org>
;; Keywords: mail, news, MIME
;; This file is part of GNU Emacs.
(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
(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
)))
;; 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
(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.
(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)
;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; Katsumi Yamaoka <yamaoka@jpl.org>
;; Keywords: news
;; This file is part of GNU Emacs.
(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
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)
(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 ")
(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 ")
;; 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)
(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")
(when large
(nnheader-message 5 "nnmh: Receiving headers...done"))
- ;; (nnheader-fold-continuation-lines)
'headers))))
(deffoo nnmh-open-server (server &optional defs)
(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)
(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.
(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
;;; Copyright (C) 1987-90,92-97 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; Katsumi Yamaoka <yamaoka@jpl.org>
;; Keywords: news
;; This file is part of GNU Emacs.
"*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
(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
(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))
(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)
(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)
(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)
(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)
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)
(* 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)
(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)
;; Yasuo Okabe
;; Author: Tatsuya Ichikawa <t-ichi@po.shiojiri.ne.jp>
;; Yasuo OKABE <okabe@kuis.kyoto-u.ac.jp>
-;; Version: 1.16
+;; Version: 1.17
;; Keywords: mail , gnus , pop3
;;
;; SPECIAL THANKS
;; "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
(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))
(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)
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)
(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)
(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))
"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)
"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)
(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))) ?\()))
\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
@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
\e$B$J8@8l7w$r:9JL$7$^$;$s!#$"$"!"%/%j%s%4%s$NJ}$O\e(B Unicode Next Generation\e$B$r\e(B
\e$B$*BT$A$/$@$5$$!#\e(B
-\e$B$3$N@bL@=q$O\e(B Semi-gnus 6.9.1 \e$B$KBP1~$7$^$9!#\e(B
+\e$B$3$N@bL@=q$O\e(B Semi-gnus 6.10 \e$B$KBP1~$7$^$9!#\e(B
@end ifinfo
@item
@kbd{M-x gnus-version} \e$B$r;n$7$F2<$5$$!#$b$7!"\e(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)}
\e$B$N$h$&$J$b$N$,=P$F$-$?$J$i!"@5$7$$%U%!%$%k$,FI$_9~$^$l$F$$$^$9!#\e(B
\e$B$b$7!"\e(B@samp{NNTP 3.x} \e$B$d\e(B @samp{nntp flee} \e$B$N$h$&$J$b$N$,=P$F$-$?$H$-$O!"\e(B
\e$B$=$3$K$"$k$$$/$D$+$N8E$$\e(B @file{.el} \e$B%U%!%$%k$,FI$_9~$^$l$F$$$^$9!#$=$l$i\e(B
\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
@tex
@titlepage
-@title Semi-gnus 6.9.1 Manual
+@title Semi-gnus 6.10 Manual
@author by Lars Magne Ingebrigtsen
@page
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
projects / elisp / gnus.git- / commitdiff