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