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