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