git.chise.org Git - elisp/gnus.git-/blob - lisp/gnus-offline.el

   1 ;;; gnus-offline.el --- To process mail & news at offline environment.
   2 ;;; $Id: gnus-offline.el,v 1.1.2.5.2.36.4.5 1999-09-03 15:42:54 czkmt Exp $
   3
   4 ;;; Copyright (C) 1998 Tatsuya Ichikawa
   5 ;;;                    Yukihiro Ito
   6 ;;; Author: Tatsuya Ichikawa <t-ichi@po.shiojiri.ne.jp>
   7 ;;;         Yukihiro Ito <ito@rs.civil.tohoku.ac.jp>
   8 ;;;         Hidekazu Nakamura <u90121@uis-inf.co.jp>
   9 ;;;         Tsukamoto Tetsuo <czkmt@remus.dti.ne.jp>
  10
  11 ;;; Version: 2.20
  12 ;;; Keywords: news , mail , offline , gnus
  13 ;;;
  14 ;;; SPECIAL THANKS
  15 ;;;    Keiichi Suzuki <kei-suzu@mail.wbs.or.jp>
  16 ;;;    KORIYAMA Naohiro <kory@ba2.so-net.or.jp>
  17 ;;;    Katsumi Yamaoka <yamaoka@jpl.org>
  18
  19 ;;; This file is part of Semi-gnus.
  20 ;;;
  21 ;;; GNU Emacs is free software; you can redistribute it and/or modify
  22 ;;; it under the terms of the GNU General Public License as published by
  23 ;;; the Free Software Foundation; either version 2, or (at your option)
  24 ;;; any later version.
  25
  26 ;;; GNU Emacs is distributed in the hope that it will be useful,
  27 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  28 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  29 ;;; GNU General Public License for more details.
  30
  31 ;;; You should have received a copy of the GNU General Public License
  32 ;;; along with GNU Emacs; see the file COPYING.  If not, write to the
  33 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  34 ;;; Boston, MA 02111-1307, USA.
  35 ;;;
  36 ;;;; Commentary:
  37 ;;; Note.
  38 ;;;   This file works only with after version of Emacs 19.30.
  39 ;;;   This file needs miee.el and SEMI.
  40 ;;;   If you set gnus-offline-drafts-queue-type to 'agent , you don't need
  41 ;;;   miee.el
  42 ;;;   You must use T-gnus 6.12.0 or later.
  43 ;;;
  44 ;;; How to use.
  45 ;;;
  46 ;;; Add following code at the end in your .emacs
  47 ;;;
  48 ;;;    (load "gnus-ofsetup")
  49 ;;;    (gnus-setup-for-offline)
  50 ;;;
  51 ;;; If you use gnus-agent as souper , put gnus-agent setup code in you .gnus.el
  52 ;;;
  53 ;;; If you use nnspool as souper , put following code in your .emacs before
  54 ;;; gnus-offline setting.
  55 ;;;
  56 ;;; Then , put hang.exe in exec-path directory.
  57 ;;;
  58 ;;; In Gnus group buffer , type g to get all news and mail.
  59 ;;; Then send mail and news in spool directory.
  60 ;;;
  61 ;;; Variables.
  62 ;;;  gnus-offline-dialup-program-arguments
  63 ;;;                                   ... List of dialup program arguments.
  64 ;;;  gnus-offline-hangup-program-arguments
  65 ;;;                                   ... List of hangup program arguments.
  66 ;;;  gnus-offline-mail-treat-environ  ... toggle sending mail online/offline.
  67 ;;;  gnus-offline-articles-to-fetch   ... toggle fetch articles.
  68 ;;;                                        both->mail->news->both...
  69 ;;;  gnus-offline-load-hook           ... hook before gnus-offline load.
  70 ;;;  gnus-offline-before-online-hook  ... hook before all online jobs.
  71 ;;;  gnus-offline-after-online-hook   ... hook after all online jobs.
  72 ;;;  gnus-offline-interval-time       ... Interval time to do all online jobs.
  73 ;;;                                        (minutes)
  74 ;;;  gnus-offline-dialup-function     ... Function to diualup.
  75 ;;;  gnus-offline-hangup-function     ... Function to hangup.
  76
  77 ;;; Code:
  78
  79 (eval '(run-hooks 'gnus-offline-load-hook))
  80
  81 (require 'cl)
  82 (require 'custom)
  83 (require 'easymenu)
  84 (provide 'gnus-offline)
  85
  86 (defgroup gnus-offline nil
  87   "Offline backend utility for Gnus."
  88   :prefix "gnus-offline-"
  89   :group 'gnus
  90   :group 'mail
  91   :group 'news)
  92
  93 (defconst gnus-offline-version-number "2.20")
  94 (defconst gnus-offline-codename
  95 ;;  "Beta5"                     ; Beta
  96 ;;  "This is the time"          ; 2.00
  97 ;;  "A matter of trust"
  98 ;;  "Modern Woman"
  99 ;;  "Ahhhhhhh!!"                ; 2.10b1
 100   "Cup of life"                 ; 2.20
 101 ;;  "Code of silence"
 102   )
 103
 104 (defconst gnus-offline-version (format "Gnus offline backend utiliy v%s"
 105                                        gnus-offline-version-number))
 106
 107 (eval-when-compile
 108   (mapc
 109    #'(lambda (symbol)
 110        (unless (boundp symbol)
 111          (make-local-variable symbol)
 112          (eval (list 'setq symbol nil))))
 113    '(nnagent-version
 114      nnspool-version
 115      msspool-news-server
 116      msspool-news-service
 117      miee-popup-menu
 118      gnus-group-toolbar))
 119   (mapc
 120    #'(lambda (symbol)
 121        (unless (fboundp symbol)
 122          (defalias symbol 'ignore)))
 123    '(general-process-argument-editing-function
 124      define-process-argument-editing
 125      gnspool-get-news
 126      mail-spool-send
 127      news-spool-post)))
 128
 129 (put 'gnus-offline-set-unplugged-state 'menu-enable 'gnus-offline-connected)
 130 (if (eq system-type 'windows-nt)
 131     (define-process-argument-editing "/hang\\.exe\\'"
 132       (lambda (x)
 133         (general-process-argument-editing-function
 134          x nil t t nil t t))))
 135
 136 (defcustom gnus-offline-auto-hangup t
 137   "*Whether dialup-network automatically hang up when all online jobs has done."
 138   :group 'gnus-offline
 139   :type 'boolean)
 140
 141 (defcustom gnus-offline-load-hook nil
 142   "*Hook to be run after the gnus-offline package has been loaded."
 143   :group 'gnus-offline
 144   :type 'hook)
 145
 146 (defcustom gnus-offline-before-online-hook nil
 147   "*Hook to be run before all online jobs."
 148   :group 'gnus-offline
 149   :type 'hook)
 150
 151 (defcustom gnus-offline-after-online-hook nil
 152   "*Hook to be run after all online jobs."
 153   :group 'gnus-offline
 154   :type 'hook)
 155
 156 (defcustom gnus-offline-mail-treat-environ 'offline
 157   "*If online , gnus-offline send all mail under online environ.
 158 If offline , gnus-offline send all mail temporary to spool dir."
 159   :group 'gnus-offline
 160   :type '(choice (const offline)
 161                  (const online)))
 162
 163 (defcustom gnus-offline-articles-to-fetch 'both
 164   "*If both , gnus-offline fetch mail and news articles.
 165 If mail , gnus-offline only fetch mail articles.
 166  If news , gnus-offline only fetch news articles."
 167   :group 'gnus-offline
 168   :type '(choice (const both)
 169                  (const mail)
 170                  (const news)))
 171
 172 (defcustom gnus-offline-mail-group-level 1
 173   "*Group level for mail group."
 174   :group 'gnus-offline
 175   :type 'integer)
 176
 177 (defcustom gnus-offline-after-empting-spool-hook nil
 178   "*Hook to be run before empting spool."
 179   :group 'gnus-offline
 180   :type 'hook)
 181
 182 (defcustom gnus-offline-before-empting-spool-hook nil
 183   "*Hook to be run after empting spool."
 184   :group 'gnus-offline
 185   :type 'hook)
 186
 187 (defcustom gnus-offline-dialup-function 'gnus-offline-connect-server
 188   "*Function to dialup."
 189   :group 'gnus-offline
 190   :type 'function)
 191
 192 (defcustom gnus-offline-hangup-function 'gnus-offline-hangup-line
 193   "*Function to hangup."
 194   :group 'gnus-offline
 195   :type 'function)
 196
 197 (defcustom gnus-offline-agent-automatic-expire t
 198   "*Non-nil means expire articles on every session."
 199   :group 'gnus-offline
 200   :type 'boolean)
 201
 202 ;; These variables should be customized using `gnus-offline-customize',
 203 ;; not by `customize'.
 204
 205 (defvar gnus-offline-dialup-program nil
 206   "*Program name for dialup.")
 207
 208 (defvar gnus-offline-hangup-program nil
 209   "*Program name for hangup.")
 210
 211 (defvar gnus-offline-dialup-program-arguments nil
 212   "*Program arguments of gnus-offline-dialup-program.")
 213
 214 (defvar gnus-offline-hangup-program-arguments nil
 215   "*Program arguments of gnus-offline-hangup-program.")
 216
 217 (defvar gnus-offline-interval-time 0
 218   "*Interval time(minutes) to do online jobs.
 219 If set to 0 , timer call is disabled.")
 220
 221 (defvar gnus-offline-drafts-queue-type 'agent
 222   "*Queuing function used for draft messages.")
 223
 224 (defvar gnus-offline-MTA-type 'smtp
 225   "*Type of MTA, sendmail or smtp.el.")
 226
 227 ;;; Internal variables.
 228 (defvar gnus-offline-connected nil
 229   "*If value is t , dialup line is connected status.
 230 If value is nil , dialup line is disconnected status.")
 231
 232 (defvar gnus-offline-news-fetch-method nil
 233   "*Method to fetch news articles.")
 234
 235 (defvar gnus-offline-mail-fetch-method nil
 236   "*Method to fetch mail articles.")
 237
 238 (defvar gnus-offline-header-string
 239   (format "%s - \"%s\""
 240           gnus-offline-version
 241           gnus-offline-codename)
 242   "*Header string for gnus-offline.")
 243
 244 (defvar gnus-offline-stored-group-level nil
 245   "*Mail Group level before changing.")
 246
 247 (defvar gnus-offline-mail-source nil
 248   "*mail-sources save variable.")
 249
 250 (defvar gnus-offline-lang)
 251
 252 (defvar gnus-offline-resource-en
 253   '((error-check-1
 254      . "WARNING!!: gnus-agent.el or nnagent.el is not loaded.
 255 Please check your .emacs or .gnus.el to work gnus-agent fine.")
 256     (error-check-2 ."WARNING!!: nnspool.el is not loaded.
 257 Please check your .emacs or .gnus.el to work nnspool fine.")
 258     (connect-server-1 . "Dialing ...")
 259     (connect-server-2 . "Dialing ... done.")
 260     (get-new-news-function-1 . "Set to online status.")
 261     (hangup-line-1 . "Hang up line ... ")
 262     (hangup-line-2 . "Hang up line ... done.")
 263     (after-jobs-done-1 . "All online jobs has done.")
 264     (toggle-auto-hangup-1 . "Auto hang up logic")
 265     (toggle-auto-hangup-2 . "disabled.")
 266     (toggle-auto-hangup-3 . "enabled.")
 267     (toggle-on/off-send-mail-1 . "Sending mail immidiately.")
 268     (toggle-on/off-send-mail-2 . "Sending mail temporary to spool directory.")
 269     (toggle-articles-to-fetch-1 . "Articles fetch from server.")
 270     (toggle-articles-to-fetch-2 . "Only Mail")
 271     (toggle-articles-to-fetch-3 . "Only News")
 272     (toggle-articles-to-fetch-4 . "Mail/News both")
 273     (empting-spool-1 . "Sending mails in spool ...")
 274     (empting-spool-2 . "Sending mails in spool ... done.")
 275     (empting-spool-3 . "Posting news in spool ...")
 276     (empting-spool-4 . "Posting news in spool ... done.")
 277     (empting-spool-5 . "Sending messages in spool ...")
 278     (empting-spool-6 . "Sending messages in spool ... done.")
 279     (interval-time-1 . "Interval time (now %d minutes) : ")
 280     (interval-time-2 . "Retrieving message logic by timer is disabled.")
 281     (interval-time-3 . "Interval time set to %d minutes")))
 282
 283 (defvar gnus-offline-resource-ja
 284   '((error-check-1
 285      . "\e$B7Y9p\e(B!!: gnus-agent.el \e$B$^$?$O\e(B nnagent.el \e$B$,%m!<%I$5$l$F$$$^$;$s!#\e(B
 286 .emacs \e$B$^$?$O\e(B .gnus.el \e$B$N\e(B gnus-agent \e$B$N@_Dj$r@5$7$/$7$F$/$@$5$$!#\e(B")
 287     (error-check-2 ."\e$B7Y9p\e(B!!: nnspool.el \e$B$,%m!<%I$5$l$F$$$^$;$s!#\e(B
 288 .emacs \e$B$^$?$O\e(B .gnus.el \e$B$N\e(B nnspool \e$B$N@_Dj$r@5$7$/$7$F$/$@$5$$!#\e(B")
 289     (connect-server-1 . "\e$B%@%$%d%k$7$F$$$^$9\e(B...")
 290     (connect-server-2 . "\e$B%@%$%d%k$7$F$$$^$9\e(B...\e$B40N;!#\e(B")
 291     (get-new-news-function-1 . "\e$B%*%s%i%$%s>uBV$G$9!#\e(B")
 292     (hangup-line-1 . "\e$B@ZCG$7$F$$$^$9\e(B...")
 293     (hangup-line-2 . "\e$B@ZCG$7$F$$$^$9\e(B...\e$B40N;!#\e(B")
 294     (after-jobs-done-1 . "\e$BA4$F$N%*%s%i%$%s=hM}$r40N;$7$^$7$?!#\e(B")
 295     (toggle-auto-hangup-1 . "\e$B<+F0@ZCG5!G=$r\e(B ")
 296     (toggle-auto-hangup-2 . "\e$B%*%U\e(B \e$B$K$7$^$7$?!#\e(B")
 297     (toggle-auto-hangup-3 . "\e$B%*%s\e(B \e$B$K$7$^$7$?!#\e(B")
 298     (toggle-on/off-send-mail-1 . "\e$B%a!<%k$rD>@\Aw?.$7$^$9!#\e(B")
 299     (toggle-on/off-send-mail-2 . "\e$B%a!<%k$O%-%e!<$KAw$i$l$^$9!#\e(B")
 300     (toggle-articles-to-fetch-1 . "\e$B<u?.$9$k%a%C%;!<%8$O\e(B... ")
 301     (toggle-articles-to-fetch-2 . "\e$B%a!<%k$N$_$G$9!#\e(B")
 302     (toggle-articles-to-fetch-3 . "\e$B%K%e!<%9$N$_$G$9!#\e(B")
 303     (toggle-articles-to-fetch-4 . "\e$B%a!<%k$H%K%e!<%9$NN>J}$G$9!#\e(B")
 304     (empting-spool-1 . "\e$B%-%e!<$N%a!<%k$rAw?.Cf\e(B...")
 305     (empting-spool-2 . "\e$B%-%e!<$N%a!<%k$rAw?.Cf\e(B... \e$B40N;!#\e(B")
 306     (empting-spool-3 . "\e$B%-%e!<$N%K%e!<%95-;v$rAw?.Cf\e(B...")
 307     (empting-spool-4 . "\e$B%-%e!<$N%K%e!<%95-;v$rAw?.Cf\e(B... \e$B40N;!#\e(B")
 308     (empting-spool-5 . "\e$B%-%e!<$N%a%C%;!<%8$rAw?.Cf\e(B...")
 309     (empting-spool-6 . "\e$B%-%e!<$N%a%C%;!<%8$rAw?.Cf\e(B... \e$B40N;!#\e(B")
 310     (interval-time-1 . "\e$BAw<u?.%8%g%V$N4V3V\e(B (\e$B8=:_$N@_Dj$O\e(B %d \e$BJ,$G$9\e(B) : ")
 311     (interval-time-2 . "\e$B<+F0Aw<u?.5!G=$r\e(B \e$B%*%U\e(B \e$B$K$7$^$7$?!#\e(B")
 312     (interval-time-3 . "\e$B<+F0Aw<u?.$N4V3V$r\e(B %d \e$BJ,$K@_Dj$7$^$7$?!#\e(B")))
 313
 314 (defvar gnus-offline-resource-ja_complete gnus-offline-resource-ja)
 315
 316 ;;; Functions
 317
 318 (defun gnus-offline-get-message (symbol &optional lang)
 319   (setq lang (or lang gnus-offline-lang))
 320   (or
 321    (cdr (assq symbol (symbol-value
 322                       (intern (format "gnus-offline-resource-%s" lang)))))
 323    (cdr (assq symbol gnus-offline-resource-en))))
 324
 325 ;;
 326 ;; Setting up...
 327 ;;
 328 (defun gnus-offline-setup ()
 329   "*Initialize gnus-offline function"
 330
 331   ;; Menu and keymap
 332   (gnus-offline-define-menu-and-key)
 333
 334   ;; To transfer Mail/News function.
 335   (cond ((eq gnus-offline-mail-treat-environ 'offline)
 336          ;; send mail under offline environ.
 337          (gnus-offline-set-offline-sendmail-function))
 338         ((eq gnus-offline-mail-treat-environ 'online)
 339          ;; send mail under offline environ.
 340          (gnus-offline-set-online-sendmail-function))))
 341
 342 ;;
 343 ;; Setting Error check.
 344 (defun gnus-offline-error-check ()
 345   ;; Check gnus-agent and nnspool setting.
 346   (let ((buffer " *Offline Error*"))
 347     (cond ((eq gnus-offline-news-fetch-method 'nnagent)
 348            ;; nnagent and gnus-agent loaded ??
 349            (unless (and (featurep 'gnus-agent)
 350                         (featurep 'nnagent))
 351              (set-buffer (gnus-get-buffer-create buffer))
 352              (erase-buffer)
 353              (insert (gnus-offline-get-message 'error-check-1))
 354              (pop-to-buffer buffer)))
 355
 356           ((eq gnus-offline-news-fetch-method 'nnspool)
 357            (unless (featurep 'nnspool)
 358              (set-buffer (gnus-get-buffer-create buffer))
 359              (erase-buffer)
 360              (insert (gnus-offline-get-message 'error-check-2))
 361              (pop-to-buffer buffer)))
 362           (t
 363            nil))))
 364 ;;
 365 ;;
 366 (defun gnus-offline-set-offline-sendmail-function ()
 367   "*Initialize sendmail-function when unplugged status."
 368   (cond ((eq gnus-offline-drafts-queue-type 'miee)
 369          (if (eq gnus-offline-news-fetch-method 'nnagent)
 370              (setq gnus-agent-send-mail-function
 371                    'sendmail-to-spool-in-gnspool-format))
 372          (setq message-send-mail-function 'sendmail-to-spool-in-gnspool-format))
 373         (t
 374          (setq gnus-agent-send-mail-function
 375                (gnus-offline-set-online-sendmail-function)
 376                message-send-mail-function 'gnus-agent-send-mail))))
 377 ;;
 378 (defun gnus-offline-set-online-sendmail-function ()
 379   "*Initialize sendmail-function when plugged status."
 380   (if (eq gnus-offline-MTA-type 'smtp)
 381       (setq message-send-mail-function 'message-send-mail-with-smtp)
 382     (setq message-send-mail-function 'message-send-mail-with-sendmail)))
 383 ;;
 384 (defun gnus-offline-set-offline-post-news-function ()
 385   "*Initialize sendnews-function when unplugged status."
 386   (if (eq gnus-offline-drafts-queue-type 'miee)
 387       (setq message-send-news-function 'gnspool-request-post)))
 388 ;;
 389 (defun gnus-offline-set-online-post-news-function ()
 390   "*Initialize sendnews-function when plugged status."
 391   (setq message-send-news-function 'message-send-news-with-gnus))
 392 ;;
 393 ;; Get new news jobs. (gnus-agent and nnspool)
 394 ;;
 395 (defun gnus-offline-gnus-get-new-news (&optional arg)
 396   "*Override function \"gnus-group-get-new-news\"."
 397   (interactive "P")
 398   (run-hooks 'gnus-offline-before-online-hook)
 399   (if (functionp gnus-offline-dialup-function)
 400       (funcall gnus-offline-dialup-function))
 401   (gnus-offline-get-new-news-function)
 402   (gnus-group-get-new-news arg))
 403
 404 ;;
 405 ;; dialup...
 406 ;;
 407 (defun gnus-offline-connect-server ()
 408   "*Dialup function."
 409   ;; Dialup if gnus-offline-dialup-program is specified
 410   (if (stringp gnus-offline-dialup-program)
 411       (progn
 412         (message (gnus-offline-get-message 'connect-server-1))
 413         (apply 'call-process gnus-offline-dialup-program nil nil nil
 414                gnus-offline-dialup-program-arguments)
 415         (sleep-for 1)
 416         (message (gnus-offline-get-message 'connect-server-2)))))
 417
 418 ;;
 419 ;; Jobs before get new news , send mail and post news.
 420 ;;
 421 (defun gnus-offline-get-new-news-function ()
 422   "*Prepare to get new news/mail."
 423   ;; Set mail group level
 424   (if (eq gnus-offline-articles-to-fetch 'mail)
 425       (gnus-offline-set-mail-group-level gnus-offline-mail-group-level))
 426
 427   ;; Set to online environ.
 428   (setq gnus-offline-connected t)
 429
 430   ;; Set send mail/news functions to online functions.
 431   (gnus-offline-set-online-sendmail-function)
 432   (gnus-offline-set-online-post-news-function)
 433   (message (gnus-offline-get-message 'get-new-news-function-1))
 434
 435   ;; fetch only news
 436   (if (eq gnus-offline-articles-to-fetch 'news)
 437       (gnus-offline-disable-fetch-mail))
 438
 439   ;; fetch both mail and news. or Only mail.
 440   (gnus-offline-enable-fetch-news)
 441   (if (memq gnus-offline-articles-to-fetch '(both mail))
 442       (gnus-offline-enable-fetch-mail))
 443
 444   ;; fetch only mail for gnus-agent
 445   (if (and (eq gnus-offline-news-fetch-method 'nnagent)
 446            (eq gnus-offline-articles-to-fetch 'mail))
 447           (setq gnus-agent-handle-level gnus-offline-mail-group-level)))
 448
 449 ;;
 450 ;; Change mail group level to handle only mail.
 451 ;;
 452 (defun gnus-offline-set-mail-group-level (level)
 453   "*Set nnm* group level."
 454   (switch-to-buffer gnus-group-buffer)
 455   (goto-char (point-min))
 456
 457   ;; Save current level
 458   (if (not gnus-offline-stored-group-level)
 459       (while (re-search-forward " nnm" nil t)
 460         (setq gnus-offline-stored-group-level
 461               (append gnus-offline-stored-group-level
 462                       (list (gnus-group-group-level)))))
 463     (forward-line 1)
 464     (beginning-of-line))
 465   ;;
 466   (goto-char (point-min))
 467   (while (re-search-forward " nnm" nil t)
 468     (gnus-group-set-current-level 1 level)
 469     (forward-line 1)
 470     (beginning-of-line))
 471   t)
 472 ;;
 473 ;; Restore mail group level
 474 ;;
 475 (defun gnus-offline-restore-mail-group-level ()
 476   "*Restore nnm* group level."
 477   (switch-to-buffer gnus-group-buffer)
 478   (goto-char (point-min))
 479   (let ((num 0))
 480     (while (re-search-forward " nnm" nil t)
 481       (gnus-group-set-current-level 1 (nth num gnus-offline-stored-group-level))
 482       (forward-line 1)
 483       (setq num (+ num 1))
 484       (beginning-of-line))))
 485 ;;
 486 ;; Jobs after getting new news.
 487 ;;
 488 (defun gnus-offline-after-get-new-news ()
 489   "*After getting news and mail jobs."
 490   (if (memq gnus-offline-articles-to-fetch '(both mail))
 491       (progn
 492         ;; Mail/both
 493         ;; send mail/news in spool
 494         (gnus-offline-empting-spool)
 495         (if (eq gnus-offline-articles-to-fetch 'mail)
 496             (progn
 497               ;; Send only mail and hang up...
 498               (if (and gnus-offline-connected
 499                        gnus-offline-auto-hangup)
 500                   (gnus-offline-set-unplugged-state))
 501               ;; Disable fetch mail.
 502               (gnus-offline-disable-fetch-mail)
 503               (gnus-offline-after-jobs-done)))))
 504
 505   ;; News/Both
 506   (if (memq gnus-offline-articles-to-fetch '(both news))
 507       (progn
 508         (if gnus-offline-connected
 509             (cond ((eq gnus-offline-news-fetch-method 'nnagent)
 510                    ;; Get New News (gnus-agent)
 511                    (gnus-agent-toggle-plugged t)
 512
 513                    ;; fetch articles
 514                    (gnus-agent-fetch-session)
 515
 516                    ;; Hang Up line. then set to offline status.
 517                    (if (and gnus-offline-connected
 518                             gnus-offline-auto-hangup)
 519                        (gnus-offline-set-unplugged-state))
 520
 521                    ;; All online jobs has done.
 522                    (gnus-offline-after-jobs-done))
 523                   (t
 524                    (if (eq gnus-offline-news-fetch-method 'nnspool)
 525                        ;; Get New News (nnspool)
 526                        (gnspool-get-news))))))))
 527 ;;
 528 ;; Disable fetch mail
 529 ;;
 530 (defun gnus-offline-disable-fetch-mail ()
 531   "*Set do not fetch mail."
 532   (setq mail-sources nil
 533         nnmail-spool-file nil))
 534 ;;
 535 ;; Enable fetch mail
 536 ;;
 537 (defun gnus-offline-enable-fetch-mail ()
 538   "*Set to fetch mail."
 539   (setq gnus-offline-mail-fetch-method 'nnmail)
 540   (setq mail-sources gnus-offline-mail-source))
 541 ;;
 542 ;; Enable fetch news
 543 ;;
 544 (defun gnus-offline-enable-fetch-news ()
 545   "*Set to fetch news."
 546   (if (eq gnus-offline-news-fetch-method 'nnagent)
 547       (progn
 548         (setq gnus-agent-handle-level gnus-level-subscribed)
 549         (gnus-agent-toggle-plugged t))))
 550 \f
 551 ;;
 552 ;; Add your custom header.
 553 ;;
 554 (defun gnus-offline-add-custom-header (header string)
 555   "*Add X-Gnus-Offline-Backend header to Mail/News message."
 556   (let ((delimline
 557          (progn (goto-char (point-min))
 558                 (re-search-forward
 559                  (concat "^" (regexp-quote mail-header-separator) "\n"))
 560                 (point-marker)))
 561         hdr str)
 562     (goto-char (point-min))
 563     (unless (re-search-forward (concat "^" header) delimline t)
 564       (goto-char delimline)
 565       (forward-line -1)
 566       (beginning-of-line)
 567       (setq hdr (concat header " "))
 568       (setq str (concat hdr string))
 569       (setq hdr (concat str "\n"))
 570       (insert-string hdr))))
 571 ;;
 572 ;; Add X-Offline-Backend header.
 573 ;;
 574 (defun gnus-offline-message-add-header ()
 575   "*Add X-Gnus-Offline-Backend header to Mail/News message."
 576   (when (eq gnus-offline-mail-treat-environ 'offline)
 577     (let* ((ver (if (eq gnus-offline-news-fetch-method 'nnagent)
 578                     nnagent-version
 579                   nnspool-version))
 580            (str (format "\n                        with %s" ver)))
 581     (gnus-offline-add-custom-header
 582      "X-Gnus-Offline-Backend:" (concat gnus-offline-header-string str)))))
 583
 584 \f
 585 ;;
 586 ;; Toggle plugged/unplugged
 587 ;;
 588 (defun gnus-offline-toggle-plugged (plugged)
 589   "*Override function \"Jj\" - gnus-agent-toggle-plugged."
 590   (interactive (list (not gnus-offline-connected)))
 591   (if plugged
 592       (progn
 593         (setq gnus-offline-connected plugged)
 594         (gnus-agent-toggle-plugged plugged)
 595         ;; Set send mail/news function to offline functions.
 596         (gnus-offline-set-online-sendmail-function)
 597         (gnus-offline-set-online-post-news-function))
 598     ;; Set to offline status
 599     (gnus-offline-set-unplugged-state)))
 600 ;;
 601 ;; Function of hang up line.
 602 ;;
 603 (defun gnus-offline-set-unplugged-state ()
 604   "*Set to unplugged state."
 605   (interactive)
 606   ;; Hang Up Line.
 607   (if (functionp gnus-offline-hangup-function)
 608       (funcall gnus-offline-hangup-function))
 609   (setq gnus-offline-connected nil)
 610   (if (eq gnus-offline-news-fetch-method 'nnagent)
 611       (gnus-agent-toggle-plugged nil))
 612
 613   ;; Set send mail/news function to offline functions.
 614   (gnus-offline-set-offline-sendmail-function)
 615   (gnus-offline-set-offline-post-news-function)
 616   ;;
 617   (setenv "MAILHOST" nil))
 618 ;;
 619 ;; Hangup line function
 620 ;;
 621 (defun gnus-offline-hangup-line ()
 622   "*Hangup line function."
 623   (message (gnus-offline-get-message 'hangup-line-1))
 624   (if (stringp gnus-offline-hangup-program)
 625       (apply 'start-process "hup" nil gnus-offline-hangup-program
 626              gnus-offline-hangup-program-arguments))
 627   (message (gnus-offline-get-message 'hangup-line-2)))
 628 ;;
 629 ;; Hang Up line routine whe using nnspool
 630 ;;
 631 (defun gnus-offline-nnspool-hangup-line ()
 632   (if (and gnus-offline-connected
 633            gnus-offline-auto-hangup)
 634       (gnus-offline-set-unplugged-state))
 635   (gnus-offline-after-jobs-done))
 636 ;;
 637 ;; Function of all jobs has done.
 638 ;;
 639 (defun gnus-offline-after-jobs-done ()
 640   "*Jobs after all online jobs."
 641   (run-hooks 'gnus-offline-after-online-hook)
 642   (if (eq gnus-offline-articles-to-fetch 'mail)
 643       (gnus-offline-restore-mail-group-level))
 644   (if (eq gnus-offline-news-fetch-method 'nnagent)
 645       (gnus-offline-agent-expire))
 646   (if (and (featurep 'xemacs)
 647            (fboundp 'play-sound-file))
 648       (ding nil 'drum)
 649     (ding))
 650   (gnus-group-save-newsrc)
 651   (message (gnus-offline-get-message 'after-jobs-done-1)))
 652
 653 \f
 654 ;;
 655 ;; Toggle auto hang up
 656 ;;
 657 (defun gnus-offline-toggle-auto-hangup ()
 658   "*Toggle auto hangup flag."
 659   (interactive)
 660   (let ((string (gnus-offline-get-message 'toggle-auto-hangup-1)) str)
 661     (if gnus-offline-auto-hangup
 662         (progn
 663           (setq gnus-offline-auto-hangup nil
 664                 str (gnus-offline-get-message 'toggle-auto-hangup-2)))
 665       (setq gnus-offline-auto-hangup t
 666             str (gnus-offline-get-message 'toggle-auto-hangup-3)))
 667     (message (format "%s %s" string str))))
 668 ;;
 669 ;; Toggle offline/online to send mail.
 670 ;;
 671 (defun gnus-offline-toggle-on/off-send-mail ()
 672   "*Toggel online/offline sendmail."
 673   (interactive)
 674   (if (eq gnus-offline-mail-treat-environ 'offline)
 675       (progn
 676         ;; Sending mail under online environ.
 677         (gnus-offline-set-online-sendmail-function)
 678         (setq gnus-offline-mail-treat-environ 'online)
 679         (message (gnus-offline-get-message 'toggle-on/off-send-mail-1)))
 680     ;; Sending mail under offline environ.
 681     (gnus-offline-set-offline-sendmail-function)
 682     (setq gnus-offline-mail-treat-environ 'offline)
 683     (message (gnus-offline-get-message 'toggle-on/off-send-mail-2))))
 684 ;;
 685 ;; Toggle articles to fetch ... both -> mail -> news -> both
 686 ;;
 687 (defun gnus-offline-toggle-articles-to-fetch ()
 688   "*Set articles to fetch... both(Mail/News) -> mail only -> News only -> both"
 689   (interactive)
 690   (let ((string (gnus-offline-get-message 'toggle-articles-to-fetch-1))
 691         str)
 692     (cond ((eq gnus-offline-articles-to-fetch 'both)
 693            (setq gnus-offline-articles-to-fetch 'mail
 694                  str (gnus-offline-get-message 'toggle-articles-to-fetch-2)))
 695           ((eq gnus-offline-articles-to-fetch 'mail)
 696            (setq gnus-offline-articles-to-fetch 'news
 697                  str (gnus-offline-get-message 'toggle-articles-to-fetch-3)))
 698           (t
 699            (setq gnus-offline-articles-to-fetch 'both
 700                  str (gnus-offline-get-message 'toggle-articles-to-fetch-4))))
 701     (message (format "%s %s" string str))))
 702 ;;
 703 ;; Send mail and Post news using Miee or gnus-agent.
 704 ;;
 705 (defun gnus-offline-empting-spool ()
 706   "*Send all drafts on queue."
 707   (run-hooks 'gnus-offline-before-empting-spool-hook)
 708   (if (eq gnus-offline-drafts-queue-type 'miee)
 709       ;; Send queued message by miee.el.
 710       (progn
 711         (if (eq gnus-offline-mail-treat-environ 'offline)
 712             (progn
 713               (message (gnus-offline-get-message 'empting-spool-1))
 714               ;; Using miee to send mail.
 715               (mail-spool-send)
 716               (message (gnus-offline-get-message 'empting-spool-2))))
 717         (message (gnus-offline-get-message 'empting-spool-3))
 718         ;; Using miee to post news.
 719         (if (and (not (stringp msspool-news-server))
 720                  (not msspool-news-service))
 721             (progn
 722               (setq msspool-news-server (nth 1 gnus-select-method))
 723               (setq msspool-news-service 119)))
 724         (news-spool-post)
 725         (message (gnus-offline-get-message 'empting-spool-4)))
 726     ;; Send queued message by gnus-agent
 727     (message (gnus-offline-get-message 'empting-spool-5))
 728     (gnus-group-send-drafts)
 729     (message (gnus-offline-get-message 'empting-spool-6)))
 730   ;;
 731   (run-hooks 'gnus-offline-after-empting-spool-hook))
 732 ;;
 733 ;; Set interval time
 734 ;;
 735 (defun gnus-offline-set-interval-time ()
 736   "*Set interval time for gnus-daemon."
 737   (interactive)
 738   (setq gnus-offline-interval-time
 739         (string-to-int (read-from-minibuffer
 740                         (format (gnus-offline-get-message 'interval-time-1)
 741                                 gnus-offline-interval-time)
 742                         nil)))
 743   (if (< gnus-offline-interval-time 2)
 744       (progn
 745         (message (gnus-offline-get-message 'interval-time-2))
 746         (setq gnus-offline-interval-time 0))
 747     (message
 748      (format (gnus-offline-get-message 'interval-time-3)
 749              gnus-offline-interval-time)))
 750   (gnus-offline-processed-by-timer))
 751 ;;
 752 ;; Expire articles using gnus-agent.
 753 ;;
 754 (defun gnus-offline-agent-expire ()
 755   "*Expire expirable article on News group."
 756   (interactive)
 757   (when gnus-offline-agent-automatic-expire
 758     (let ((gnus-agent-expire-all (if (eq 0 gnus-agent-expire-days)
 759                                      nil
 760                                    gnus-agent-expire-all)))
 761       (gnus-agent-expire))))
 762 ;;
 763 ;; Menu.
 764 ;;
 765 (defun gnus-offline-define-menu-and-key ()
 766   "*Set key and menu."
 767   (if (eq gnus-offline-drafts-queue-type 'miee)
 768       (if (featurep 'xemacs)
 769           (add-hook 'gnus-group-mode-hook 'gnus-offline-define-menu-on-miee)
 770         (gnus-offline-define-menu-on-miee))
 771     (add-hook 'gnus-group-mode-hook 'gnus-offline-define-menu-on-agent))
 772   (add-hook 'gnus-group-mode-hook
 773             '(lambda ()
 774                (local-set-key "\C-coh" 'gnus-offline-set-unplugged-state)
 775                (local-set-key "\C-cof" 'gnus-offline-toggle-articles-to-fetch)
 776                (local-set-key "\C-coo" 'gnus-offline-toggle-on/off-send-mail)
 777                (local-set-key "\C-cox" 'gnus-offline-toggle-auto-hangup)
 778                (local-set-key "\C-cos" 'gnus-offline-set-interval-time)
 779                (substitute-key-definition
 780                 'gnus-group-get-new-news 'gnus-offline-gnus-get-new-news
 781                 gnus-group-mode-map)
 782                (if (eq gnus-offline-news-fetch-method 'nnagent)
 783                    (progn
 784                      (substitute-key-definition
 785                       'gnus-agent-toggle-plugged 'gnus-offline-toggle-plugged
 786                       gnus-agent-group-mode-map)
 787                      (local-set-key "\C-coe" 'gnus-offline-agent-expire)))
 788                (or (featurep 'xemacs)
 789                    (define-key gnus-group-mode-map
 790                      (if (eq system-type 'windows-nt) [S-mouse-2] [mouse-3])
 791                      'gnus-offline-popup-menu))))
 792   (if (eq gnus-offline-news-fetch-method 'nnagent)
 793       (add-hook 'gnus-summary-mode-hook
 794                 '(lambda ()
 795                    (substitute-key-definition
 796                     'gnus-agent-toggle-plugged 'gnus-offline-toggle-plugged
 797                     gnus-agent-summary-mode-map))))
 798   (if (featurep 'xemacs)
 799       ;; Overwrite the toolbar spec for gnus-group-mode.
 800       (add-hook 'gnus-startup-hook
 801                 (lambda ()
 802                   (catch 'tag
 803                     (mapc (lambda (but)
 804                             (when (eq 'gnus-group-get-new-news (aref but 1))
 805                               (aset but 1 'gnus-offline-gnus-get-new-news)
 806                               (throw 'tag nil)))
 807                           gnus-group-toolbar))))))
 808 ;;
 809 ;;
 810 (defun gnus-offline-define-menu-on-miee ()
 811   "*Set and change menu bar on MIEE menu."
 812   (let ((menu
 813          (if (string= gnus-offline-lang "ja_complete")
 814              (easy-menu-change
 815               nil
 816               "Miee"
 817               '(
 818                 ["Spool \e$B$K$"$k5-;v$NAw?.\e(B" news-spool-post t]
 819                 ["Spool \e$B$K$"$k\e(B Mail \e$B$NAw?.\e(B" mail-spool-send t]
 820                 "----"
 821                 ["Offline \e$B>uBV$X\e(B" message-offline-state
 822                  (not message-offline-state)]
 823                 ["Online \e$B>uBV$X\e(B" message-online-state message-offline-state]
 824                 "----"
 825                 ("Gnus Offline"
 826                  ["\e$B<hF@5-;v<oN`$NJQ99\e(B" gnus-offline-toggle-articles-to-fetch t]
 827                  ["Mail \e$BAw?.J}K!\e(B(On/Off)\e$B$N@ZBX$(\e(B"
 828                   gnus-offline-toggle-on/off-send-mail t]
 829                  ["\e$B<+F0@ZCG$N@ZBX$(\e(B" gnus-offline-toggle-auto-hangup t]
 830                  "----"
 831                  ["\e$B<hF@:Q5-;v$r>C$9\e(B" gnus-offline-agent-expire
 832                   (eq gnus-offline-news-fetch-method 'nnagent)]
 833                  ["\e$B5-;v<hF@4V3V;~4V$N@_Dj\e(B" gnus-offline-set-interval-time t]
 834                  "----"
 835                  ["\e$B2s@~$N@ZCG\e(B" gnus-offline-set-unplugged-state
 836                   gnus-offline-connected]
 837                  "----"
 838                  ["\e$B%W%m%Q%F%#\e(B..." gnus-ofsetup-customize t])
 839                 ))
 840            (easy-menu-change
 841             nil
 842             "Miee"
 843             '(
 844               ["Post news in spool" news-spool-post t]
 845               ["Send mails in spool" mail-spool-send t]
 846               "----"
 847               ["Message Offline" message-offline-state
 848                (not message-offline-state)]
 849               ["Message Online" message-online-state message-offline-state]
 850               "----"
 851               ("Gnus Offline"
 852                ["Toggle articles to fetch"
 853                 gnus-offline-toggle-articles-to-fetch t]
 854                ["Toggle online/offline send mail"
 855                 gnus-offline-toggle-on/off-send-mail t]
 856                ["Toggle auto hangup" gnus-offline-toggle-auto-hangup t]
 857                "----"
 858                ["Expire articles" gnus-offline-agent-expire
 859                 (eq gnus-offline-news-fetch-method 'nnagent)]
 860                ["Set interval time" gnus-offline-set-interval-time t]
 861                "----"
 862                ["Hang up Line." gnus-offline-set-unplugged-state
 863                 gnus-offline-connected]
 864                "----"
 865                ["Customize options..." gnus-ofsetup-customize t]
 866                ))))))
 867     (and (featurep 'xemacs)
 868          (easy-menu-add menu))))
 869 ;;
 870 ;; define menu without miee.
 871 ;;
 872 (defun gnus-offline-define-menu-on-agent ()
 873   "*Set menu bar on OFFLINE menu."
 874   (easy-menu-define
 875    gnus-offline-menu-on-agent
 876    gnus-group-mode-map
 877    "Gnus offline Menu"
 878    (if (string= gnus-offline-lang "ja_complete")
 879        '("Offline"
 880          ["\e$B<hF@5-;v<oN`$NJQ99\e(B" gnus-offline-toggle-articles-to-fetch t]
 881          ["Mail \e$BAw?.J}K!\e(B(On/Off)\e$B$N@ZBX$(\e(B" gnus-offline-toggle-on/off-send-mail
 882           t]
 883          ["\e$B<+F0@ZCG$N@ZBX$(\e(B" gnus-offline-toggle-auto-hangup t]
 884          "----"
 885          ["\e$B<hF@:Q5-;v$r>C$9\e(B" gnus-offline-agent-expire
 886           (eq gnus-offline-news-fetch-method 'nnagent)]
 887          ["\e$B5-;v<hF@4V3V;~4V$N@_Dj\e(B" gnus-offline-set-interval-time t]
 888          "----"
 889          ["\e$B2s@~$N@ZCG\e(B" gnus-offline-set-unplugged-state gnus-offline-connected]
 890          "----"
 891          ["\e$B%W%m%Q%F%#\e(B..." gnus-ofsetup-customize t])
 892      '("Offline"
 893        ["Toggle articles to fetch" gnus-offline-toggle-articles-to-fetch t]
 894        ["Toggle online/offline send mail" gnus-offline-toggle-on/off-send-mail
 895         t]
 896        ["Toggle auto hangup" gnus-offline-toggle-auto-hangup t]
 897        "----"
 898        ["Expire articles" gnus-offline-agent-expire
 899         (eq gnus-offline-news-fetch-method 'nnagent)]
 900        ["Set interval time" gnus-offline-set-interval-time t]
 901        "----"
 902        ["Hang up Line." gnus-offline-set-unplugged-state gnus-offline-connected]
 903        "----"
 904        ["Customize options..." gnus-ofsetup-customize t])))
 905   (and (featurep 'xemacs)
 906        (easy-menu-add gnus-offline-menu-on-agent)))
 907 ;;
 908 ;; Popup menu within the group buffer (under Emacs).
 909 ;;
 910 (defvar gnus-offline-popup-menu nil)
 911 (defun gnus-offline-popup-menu (event)
 912   "Popup menu for Gnus offline."
 913   (interactive "e")
 914   (unless gnus-offline-popup-menu
 915     (setq gnus-offline-popup-menu
 916           (let ((menu
 917                  (if (boundp 'miee-popup-menu)
 918                      (or (assq 'keymap
 919                                 (assq 'Miee (assq 'menu-bar global-map)))
 920                          miee-popup-menu)
 921                    (symbol-value 'gnus-offline-menu-on-agent))))
 922             (if (string< emacs-version "20")
 923                 (append (list 'keymap
 924                               (if (boundp 'miee-popup-menu)
 925                                   '(nil "Miee")
 926                                 '(nil "Offline"))
 927                               '(nil "")
 928                               '(nil ""))
 929                         (cdr menu))
 930               menu))))
 931   (let* ((pop (x-popup-menu t gnus-offline-popup-menu))
 932          (func (and pop (lookup-key gnus-offline-popup-menu
 933                                     (apply 'vector pop)))))
 934     (and pop func (funcall func))))
 935 \f
 936 ;;
 937 ;; Timer Function
 938 (defun gnus-offline-processed-by-timer ()
 939   "*Set timer interval."
 940   (if (and (> gnus-offline-interval-time 0)
 941            (not gnus-offline-connected))
 942       ;; Timer call
 943       (gnus-demon-add-handler 'gnus-offline-gnus-get-new-news
 944                               gnus-offline-interval-time
 945                               gnus-offline-interval-time))
 946   (if (= gnus-offline-interval-time 0)
 947       (gnus-demon-remove-handler 'gnus-offline-gnus-get-new-news t)))
 948 ;;
 949 ;;
 950 ;;; gnus-offline.el ends here