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