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