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