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