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

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