git.chise.org Git - elisp/gnus.git-/blob - lisp/gnus-offline.el

   1 ;;; gnus-offline.el --- To process mail & news at offline environment.
   2
   3 ;;; Copyright (C) 1998 Tatsuya Ichikawa
   4 ;;;                    Yukihiro Ito
   5 ;;; Author: Tatsuya Ichikawa <t-ichi@po.shiojiri.ne.jp>
   6 ;;;         Yukihiro Ito <ito@rs.civil.tohoku.ac.jp>
   7 ;;;         Hidekazu Nakamura <u90121@uis-inf.co.jp>
   8
   9 ;;; Version: 1.54
  10 ;;; Keywords: news , mail , offline , gnus
  11 ;;;
  12 ;;; SPECIAL THANKS
  13 ;;;    Keiichi Suzuki <kei-suzu@mail.wbs.or.jp>
  14 ;;;    KORIYAMA Naohiro <kory@ba2.so-net.or.jp>
  15 ;;;    Katsumi Yamaoka <yamaoka@jpl.org>
  16
  17 ;;; This file is part of Semi-gnus.
  18 ;;;
  19 ;;; GNU Emacs is free software; you can redistribute it and/or modify
  20 ;;; it under the terms of the GNU General Public License as published by
  21 ;;; the Free Software Foundation; either version 2, or (at your option)
  22 ;;; any later version.
  23
  24 ;;; GNU Emacs is distributed in the hope that it will be useful,
  25 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  26 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  27 ;;; GNU General Public License for more details.
  28
  29 ;;; You should have received a copy of the GNU General Public License
  30 ;;; along with GNU Emacs; see the file COPYING.  If not, write to the
  31 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  32 ;;; Boston, MA 02111-1307, USA.
  33 ;;;
  34 ;;;; Commentary:
  35 ;;; Note.
  36 ;;;   This file works only with after version of Emacs 19.30.
  37 ;;;   This file needs miee.el and SEMI.
  38 ;;;   If you set gnus-offline-drafts-queue-type to 'agent , you don't need
  39 ;;;   miee.el
  40 ;;;   You must use Semi-gnus 6.X.X.
  41 ;;;
  42 ;;; How to use.
  43 ;;; put following code in you .emacs , after the setting of Gnus.
  44 ;;;
  45 ;;;  (setq gnus-offline-connect-program "/dir/program.exe")
  46 ;;;  (setq gnus-offline-connect-program-arguments '("-a" "-b"))
  47 ;;;  (setq gnus-offline-hangup-program "/dir/program")
  48 ;;;  (setq gnus-offline-hangup-program-arguments '("-c" "-d"))
  49 ;;;  (setq gnus-offline-mail-spool-directory "your-send-mail-spool-directory")
  50 ;;;  (setq gnus-offline-news-spool-directory "your-send-news-spool-directory")
  51 ;;;  (autoload 'gnus-offline-setup "gnus-offline")
  52 ;;;  (add-hook 'gnus-load-hook 'gnus-offline-setup)
  53 ;;;
  54 ;;; If you use gnus-agent as souper , put gnus-agent setup code in you .gnus.el
  55 ;;;
  56 ;;; If you use nnspool as souper , put following code in your .emacs before
  57 ;;; gnus-offline setting.
  58 ;;;
  59 ;;;  (load "miee")
  60 ;;;  (message-offline-state)
  61 ;;;
  62 ;;; Then , put hang.exe in exec-path directory.
  63 ;;;
  64 ;;; In Gnus group buffer , type g to get all news and mail.
  65 ;;; Then send mail and news in spool directory.
  66 ;;;
  67 ;;; Variables.
  68 ;;;  gnus-offline-connect-program     ... Dialup program name.
  69 ;;;  gnus-offline-connect-program-arguments
  70 ;;;                                   ... List of dialup program arguments.
  71 ;;;  gnus-offline-hangup-program      ... Program name that used hanup line.
  72 ;;;  gnus-offline-hangup-program-arguments
  73 ;;;                                   ... List of hangup program arguments.
  74 ;;;  gnus-offline-mail-spool-directory... spool directory sending mail.
  75 ;;;  gnus-offline-news-spool-directory... spool directory sending news.
  76 ;;;  gnus-offline-mail-treat-environ  ... toggle sending mail online/offline.
  77 ;;;  gnus-offline-articles-to-fetch   ... toggle fetch articles.
  78 ;;;                                        both->mail->news->both...
  79 ;;;  gnus-offline-load-hook           ... hook before gnus-offline load.
  80 ;;;  gnus-offline-before-online-hook  ... hook before all online jobs.
  81 ;;;  gnus-offline-after-online-hook   ... hook after all online jobs.
  82 ;;;  gnus-offline-interval-time       ... Interval time to do all online jobs.
  83 ;;;                                        (minutes)
  84 ;;;  gnus-offline-MTA-type            ... Type of MTA.
  85 ;;;                                        'smtp     ... Use smtp.el.
  86 ;;;                                        'sendmail ... Use sendmail.el.
  87 ;;;  gnus-offline-drafts-queue-type   ... Method type queuing message to spool.
  88 ;;;                                        'miee means queue message to spool
  89 ;;;                                         using miee.el.
  90 ;;;                                        'agent means queue message to spool
  91 ;;;                                         using gnus-agent.el.
  92
  93 ;;; Code:
  94
  95 (eval '(run-hooks 'gnus-offline-load-hook))
  96
  97 (require 'cl)
  98 (require 'custom)
  99 (require 'pop3-fma)
 100
 101 (unless (and (condition-case ()
 102                  (require 'custom)
 103                (file-error nil))
 104              (fboundp 'defgroup)
 105              (fboundp 'defcustom))
 106   (require 'backquote)
 107   (defmacro defgroup (&rest args))
 108   (defmacro defcustom (symbol value &optional doc &rest args)
 109     (` (defvar (, symbol) (, value) (, doc))))
 110   )
 111 (defgroup gnus-offline nil
 112   "Offline backend utility for Gnus."
 113   :prefix "gnus-offline-"
 114   :group 'mail
 115   :group 'news)
 116
 117 (defconst gnus-offline-version-number "1.54")
 118 (defconst gnus-offline-codename
 119 ;;  "You may be right"          ; 1.40
 120 ;;  "Chilstie Lee"              ; 1.45
 121 ;;  "Uptown Girl"               ; 1.46
 122 ;;  "Easy money"                ; 1.47
 123 ;;  "An Innocent man"           ; 1.48
 124 ;;  "Tell her about it"         ; 1.50
 125 ;;  "This night"                ; 1.51
 126 ;;  "Movin'out"                 ; 1.52
 127 ;;  "Longest night"             ; 1.53
 128   "Back in the U.S.S.R"         ; 1.54
 129 ;;  "Running on ice"
 130 ;;  "This is the time"
 131 ;;  "A matter of trust"
 132 ;;  "Modern Woman"
 133 ;;  "Code of silence"
 134   )
 135
 136 (defconst gnus-offline-version (format "Gnus offline backend utiliy v%s"
 137                                        gnus-offline-version-number))
 138
 139 (defcustom gnus-offline-connect-program nil
 140   "*Program name to dial-up dialup network.
 141 If nil , use auto-dialup if required to connect the Internet."
 142   :group 'gnus-offline
 143   :type 'string)
 144
 145 (defcustom gnus-offline-connect-program-arguments nil
 146   "*Program arguments of gnus-offline-connect-program."
 147   :group 'gnus-offline
 148   :type '(repeat (string :tag "Argument")))
 149
 150 (defcustom gnus-offline-hangup-program nil
 151   "*Program name to hang-up dialup network."
 152   :group 'gnus-offline
 153   :type 'string)
 154
 155 (defcustom gnus-offline-hangup-program-arguments nil
 156   "*Program arguments of gnus-offline-hangup-program."
 157   :group 'gnus-offline
 158   :type '(repeat (string :tag "Argument")))
 159
 160 (defcustom gnus-offline-auto-hangup t
 161   "*Whether dialup-network automatically hang up when all online jobs has done."
 162   :group 'gnus-offline
 163   :type 'boolean)
 164
 165 (defcustom gnus-offline-mail-spool-directory "~/News/mail.out"
 166   "*Spool directory sending mail."
 167   :group 'gnus-offline
 168   :type 'directory)
 169
 170 (defcustom gnus-offline-news-spool-directory "~/News/news.out"
 171   "*Spool directory sending news."
 172   :group 'gnus-offline
 173   :type 'directory)
 174
 175 (defcustom gnus-offline-load-hook nil
 176   "*Hook to be run after the gnus-offline package has been loaded."
 177   :group 'gnus-offline
 178   :type 'hook)
 179
 180 (defcustom gnus-offline-before-online-hook nil
 181   "*Hook to be run before all online jobs."
 182   :group 'gnus-offline
 183   :type 'hook)
 184
 185 (defcustom gnus-offline-after-online-hook nil
 186   "*Hook to be run after all online jobs."
 187   :group 'gnus-offline
 188   :type 'hook)
 189
 190 (defcustom gnus-offline-mail-treat-environ 'offline
 191   "*If online , gnus-offline send all mail under online environ.
 192 If offline , gnus-offline send all mail temporary to spool dir."
 193   :group 'gnus-offline
 194   :type '(choice (const offline)
 195                  (const online)))
 196
 197 (defcustom gnus-offline-articles-to-fetch 'both
 198   "*If both , gnus-offline fetch mail and news articles.
 199 If mail , gnus-offline only fetch mail articles.
 200  If news , gnus-offline only fetch news articles."
 201   :group 'gnus-offline
 202   :type '(choice (const both)
 203                  (const mail)
 204                  (const news)))
 205
 206 (defcustom gnus-offline-interval-time 0
 207   "*Interval time(minutes) to do online jobs.
 208 If set to 0 , timer call is disabled."
 209   :group 'gnus-offline
 210   :type 'integer)
 211
 212 (defcustom gnus-offline-mail-group-level 1
 213   "*Group level for mail group."
 214   :group 'gnus-offline
 215   :type 'integer)
 216
 217 (defcustom gnus-offline-MTA-type 'smtp
 218   "*Type of MTA program.
 219 smtp means use smtp.el.
 220  sendmail means use sendmail.el."
 221   :group 'gnus-offline
 222   :type '(choice (const smtp)
 223                  (const sendmail)))
 224
 225 (defcustom gnus-offline-drafts-queue-type 'agent
 226   "*Type of to queue drafts method.
 227 'miee means drafts are queued and sent by miee.el.
 228 'agent means drafts are queued and sent by gnus-agent.el"
 229   :group 'gnus-offline
 230   :type '(choice (const miee)
 231                  (const agent)))
 232
 233 (defcustom gnus-offline-after-empting-spool-hook nil
 234   "*Hook to be run before empting spool."
 235   :group 'gnus-offline
 236   :type 'hook)
 237
 238 (defcustom gnus-offline-before-empting-spool-hook nil
 239   "*Hook to be run after empting spool."
 240   :group 'gnus-offline
 241   :type 'hook)
 242
 243 (defcustom gnus-offline-dialup-function 'gnus-offline-connect-server
 244   "*Function to dialup."
 245   :group 'gnus-offline
 246   :type 'function)
 247
 248 (defcustom gnus-offline-hangup-function 'gnus-offline-hangup-line
 249   "*Function to hangup."
 250   :group 'gnus-offline
 251   :type 'function)
 252
 253 ;;; Internal variables.
 254 (defvar gnus-offline-connected nil
 255   "*If value is t , dialup line is connected status.
 256 If value is nil , dialup line is disconnected status.")
 257
 258 (defvar gnus-offline-news-fetch-method nil
 259   "*Method to fetch news articles.")
 260
 261 (defvar gnus-offline-mail-fetch-method nil
 262   "*Method to fetch mail articles.")
 263
 264 (defvar gnus-offline-header-string
 265   (format "%s - \"%s\""
 266           gnus-offline-version
 267           gnus-offline-codename)
 268   "*Header string for gnus-offline.")
 269
 270 (defvar gnus-offline-auto-hangup-indicator "Hup"
 271   "*Indicator whether auto hang up is enabled.")
 272
 273 (defvar gnus-offline-stored-group-level nil
 274   "*Mail Group level before changing.")
 275
 276 (defvar gnus-offline-movemail-arguments nil
 277   "*All command line arguments of exec-directory/movemail.")
 278
 279 ;;; Temporary variable:
 280 (defvar string)
 281 (defvar hdr)
 282 (defvar str)
 283 (defvar ver)
 284 (defvar passwd)
 285 (defvar num)
 286 (defvar gnus-offline-map (make-sparse-keymap))
 287
 288 ;;; To silence byte compiler
 289 (and
 290  (fboundp 'eval-when-compile)
 291  (eval-when-compile
 292    (save-excursion
 293      (beginning-of-defun)
 294      (eval-region (point-min) (point)))
 295    (let (case-fold-search)
 296      (mapcar
 297       (function
 298        (lambda (symbol)
 299          (unless (boundp symbol)
 300            (make-local-variable symbol)
 301            (eval (list 'setq symbol nil)))))
 302       '(:group
 303         :prefix :type
 304         sendmail-to-spool-directory
 305         news-spool-request-post-directory
 306         nnspool-version
 307         nnagent-version
 308         msspool-news-server
 309         msspool-news-service
 310         gnspool-get-news
 311         mail-spool-send
 312         news-spool-post
 313         gnus-agent-handle-level
 314         ))
 315      (make-local-variable 'byte-compile-warnings)
 316      (setq byte-compile-warnings nil))))
 317
 318 (autoload 'message-offline-state "miee"
 319   "Set current status to offline state" t)
 320 ;;
 321 ;; mode-line control
 322 (if (not (member 'gnus-offline-auto-hangup-indicator mode-line-format))
 323     (progn
 324       (delete "-%-" mode-line-format)
 325       (setq-default mode-line-format
 326                     (append mode-line-format
 327                             (list "--" 'gnus-offline-auto-hangup-indicator
 328                                   "-%-")))))
 329 (put 'gnus-offline-set-unplugged-state 'menu-enable 'gnus-offline-connected)
 330 (add-hook 'gnus-startup-hook 'gnus-offline-setup)
 331 ;;; Functions
 332 ;;
 333 ;; Setting up...
 334 ;;
 335 (defun gnus-offline-setup ()
 336   "*Initialize gnus-offline function"
 337   (if (eq system-type 'windows-nt)
 338       (define-process-argument-editing "/hang\\.exe\\'"
 339         (lambda (x) (general-process-argument-editing-function
 340                      x nil t t nil t t))))
 341   ;; Initialize Internal Variable
 342   (gnus-offline-initialize-variables)
 343
 344   ;; Disable fetch mail when startup.
 345   (gnus-offline-disable-fetch-mail)
 346
 347   ;; To transfer Mail/News function.
 348   (cond ((eq gnus-offline-mail-treat-environ 'offline)
 349          ;; send mail under online environ.
 350          (gnus-offline-set-offline-sendmail-function))
 351         ((eq gnus-offline-mail-treat-environ 'online)
 352          ;; send mail under offline environ.
 353          (gnus-offline-set-online-sendmail-function)))
 354
 355   ;; always treat news under offline environ.
 356   (gnus-offline-set-offline-post-news-function)
 357
 358   ;; Spool directory setting - Miee
 359   (if (eq gnus-offline-drafts-queue-type 'miee)
 360       (progn
 361         (if (not (file-exists-p gnus-offline-mail-spool-directory))
 362             (make-directory gnus-offline-mail-spool-directory t))
 363         (setq sendmail-to-spool-directory gnus-offline-mail-spool-directory)
 364         (if (not (file-exists-p gnus-offline-news-spool-directory))
 365             (make-directory gnus-offline-news-spool-directory t))
 366         (setq news-spool-request-post-directory gnus-offline-news-spool-directory)))
 367
 368   ;; When startup ... state is offline.
 369   (setq gnus-nntp-service nil
 370         gnus-nntp-server nil)
 371
 372   ;; Setup needed Hooks
 373   (gnus-offline-setup-needed-hooks))
 374 ;;
 375 ;;
 376 (defun gnus-offline-initialize-variables ()
 377   "*Initialize gnus-offline internal variable."
 378   (if (featurep 'nnmail)
 379       (setq gnus-offline-mail-fetch-method 'nnmail))
 380   (if (featurep 'gnus-agent)
 381       (setq gnus-offline-news-fetch-method 'nnagent))
 382   (if (featurep 'nnspool)
 383       (setq gnus-offline-news-fetch-method 'nnspool))
 384   (if (eq gnus-offline-drafts-queue-type 'miee)
 385       (load "miee"))
 386   (gnus-offline-define-menu-and-key))
 387 ;;
 388 ;;
 389 (defun gnus-offline-set-offline-sendmail-function ()
 390   "*Initialize sendmail-function when unplugged status."
 391   (if (eq gnus-offline-drafts-queue-type 'miee)
 392       (setq message-send-mail-function 'sendmail-to-spool-in-gnspool-format)
 393     (setq message-send-mail-function 'gnus-agent-send-mail)))
 394 ;;
 395 (defun gnus-offline-set-online-sendmail-function ()
 396   "*Initialize sendmail-function when plugged status."
 397   (if (eq gnus-offline-MTA-type 'smtp)
 398       (setq message-send-mail-function 'message-send-mail-with-smtp)
 399     (setq message-send-mail-function 'message-send-mail-with-sendmail)))
 400 ;;
 401 (defun gnus-offline-set-offline-post-news-function ()
 402   "*Initialize sendnews-function when unplugged status."
 403   (if (eq gnus-offline-drafts-queue-type 'miee)
 404       (setq message-send-news-function 'gnspool-request-post)))
 405 ;;
 406 (defun gnus-offline-set-online-post-news-function ()
 407   "*Initialize sendnews-function when plugged status."
 408   (setq message-send-news-function 'message-send-news-with-gnus))
 409 ;;
 410 (defun gnus-offline-setup-needed-hooks ()
 411   "*Initialize needed hooks for gnus-offline."
 412   (add-hook 'gnus-group-mode-hook 'gnus-offline-processed-by-timer)
 413   (add-hook 'gnus-after-getting-new-news-hook 'gnus-offline-after-get-new-news)
 414   (add-hook 'gnus-after-getting-news-hook 'gnus-offline-after-get-new-news)
 415   (if (eq gnus-offline-news-fetch-method 'nnspool)
 416       (add-hook 'after-getting-news-hook 'gnus-offline-nnspool-hangup-line))
 417   (add-hook 'mime-edit-translate-hook 'gnus-offline-message-add-header)
 418   (if (featurep 'pop3-fma)
 419       (add-hook 'mime-edit-translate-hook 'pop3-fma-message-add-header)))
 420 ;;
 421 ;; Get new news jobs. (gnus-agent and nnspool)
 422 ;;
 423 (defun gnus-offline-gnus-get-new-news (&optional arg)
 424   "*Override function \"gnus-grou-get-new-news\"."
 425   (interactive "P")
 426   (run-hooks 'gnus-offline-before-online-hook)
 427   (if (functionp gnus-offline-dialup-function)
 428       (funcall gnus-offline-dialup-function))
 429   (gnus-offline-get-new-news-function)
 430   (gnus-group-get-new-news arg))
 431
 432 ;;
 433 ;; dialup...
 434 ;;
 435 (defun gnus-offline-connect-server ()
 436   "*Dialup function."
 437   ;; Dialup if gnus-offline-connect-program is specified
 438   (if (stringp gnus-offline-connect-program)
 439       (progn
 440         (message "Dialing ...")
 441         (apply 'call-process gnus-offline-connect-program nil nil nil
 442                gnus-offline-connect-program-arguments)
 443         (sleep-for 1)
 444         (message "Dialing ... done."))))
 445
 446 ;;
 447 ;; Jobs before get new news , send mail and post news.
 448 ;;
 449 (defun gnus-offline-get-new-news-function ()
 450   "*Prepare to get new news/mail."
 451   ;; Set mail group level
 452   (if (eq gnus-offline-articles-to-fetch 'mail)
 453       (gnus-offline-set-mail-group-level gnus-offline-mail-group-level))
 454
 455   ;; Re initialize internal variable...if failed.
 456   (if (or (not gnus-offline-mail-fetch-method)
 457           (not gnus-offline-news-fetch-method))
 458       (gnus-offline-initialize-variables))
 459
 460   ;; Set to online environ.
 461   (setq gnus-offline-connected t)
 462
 463   ;; Set send mail/news functions to online functions.
 464   (gnus-offline-set-online-sendmail-function)
 465   (gnus-offline-set-online-post-news-function)
 466   (message "Set to online status.")
 467
 468   ;; fetch only news
 469   (if (eq gnus-offline-articles-to-fetch 'news)
 470       (gnus-offline-disable-fetch-mail))
 471
 472   ;; fetch both mail and news. or Only mail.
 473   (gnus-offline-enable-fetch-news)
 474   (if (memq gnus-offline-articles-to-fetch '(both mail))
 475       (gnus-offline-enable-fetch-mail))
 476
 477   ;; fetch only mail for gnus-agent
 478   (if (and (eq gnus-offline-news-fetch-method 'nnagent)
 479            (eq gnus-offline-articles-to-fetch 'mail))
 480           (setq gnus-agent-handle-level gnus-offline-mail-group-level)))
 481
 482 ;;
 483 ;; Change mail group level to handle only mail.
 484 ;;
 485 (defun gnus-offline-set-mail-group-level (level)
 486   "*Set nnm* group level."
 487   (switch-to-buffer gnus-group-buffer)
 488   (goto-char (point-min))
 489
 490   ;; Save current level
 491   (if (not gnus-offline-stored-group-level)
 492       (while (re-search-forward " nnm" nil t)
 493         (setq gnus-offline-stored-group-level
 494               (append gnus-offline-stored-group-level
 495                       (list (gnus-group-group-level)))))
 496     (forward-line 1)
 497     (beginning-of-line))
 498   ;;
 499   (goto-char (point-min))
 500   (while (re-search-forward " nnm" nil t)
 501     (gnus-group-set-current-level 1 level)
 502     (forward-line 1)
 503     (beginning-of-line))
 504   t)
 505 ;;
 506 ;; Restore mail group level
 507 ;;
 508 (defun gnus-offline-restore-mail-group-level ()
 509   "*Restore nnm* group level."
 510   (switch-to-buffer gnus-group-buffer)
 511   (goto-char (point-min))
 512   (setq num 0)
 513   (while (re-search-forward " nnm" nil t)
 514     (gnus-group-set-current-level 1 (nth num gnus-offline-stored-group-level))
 515     (forward-line 1)
 516     (setq num (+ num 1))
 517     (beginning-of-line)))
 518 ;;
 519 ;; Jobs after getting new news.
 520 ;;
 521 (defun gnus-offline-after-get-new-news ()
 522   "*After getting news and mail jobs."
 523   (if (memq gnus-offline-articles-to-fetch '(both mail))
 524       (progn
 525         ;; Mail/both
 526         ;; send mail/news in spool
 527         (gnus-offline-empting-spool)
 528         (if (eq gnus-offline-articles-to-fetch 'mail)
 529             (progn
 530               ;; Send only mail and hang up...
 531               (if (and gnus-offline-connected
 532                        gnus-offline-auto-hangup)
 533                   (gnus-offline-set-unplugged-state))
 534               ;; Disable fetch mail.
 535               (gnus-offline-disable-fetch-mail)
 536               (gnus-offline-after-jobs-done)))))
 537
 538   ;; News/Both
 539   (if (memq gnus-offline-articles-to-fetch '(both news))
 540       (progn
 541         (if gnus-offline-connected
 542             (cond ((eq gnus-offline-news-fetch-method 'nnagent)
 543                    ;; Get New News (gnus-agent)
 544                    (gnus-agent-toggle-plugged t)
 545
 546                    ;; fetch articles
 547                    (gnus-agent-fetch-session)
 548
 549                    ;; Hang Up line. then set to offline status.
 550                    (if (and gnus-offline-connected
 551                             gnus-offline-auto-hangup)
 552                        (gnus-offline-set-unplugged-state))
 553
 554                    ;; All online jobs has done.
 555                    (gnus-offline-after-jobs-done))
 556                   (t
 557                    (if (eq gnus-offline-news-fetch-method 'nnspool)
 558                        ;; Get New News (nnspool)
 559                        (gnspool-get-news))))))))
 560 ;;
 561 ;; Disable fetch mail
 562 ;;
 563 (defun gnus-offline-disable-fetch-mail ()
 564   "*Set do not fetch mail."
 565   (if (eq gnus-offline-mail-fetch-method 'nnmail)
 566       (setq nnmail-spool-file nil)))
 567 ;;
 568 ;; Enable fetch mail
 569 ;;
 570 (defun gnus-offline-enable-fetch-mail ()
 571   "*Set to fetch mail."
 572   (if (eq gnus-offline-mail-fetch-method 'nnmail)
 573       (progn
 574         (setq gnus-offline-mail-fetch-method 'nnmail)
 575         (setq nnmail-movemail-program 'pop3-fma-movemail)
 576         (setq nnmail-spool-file (append
 577                                  pop3-fma-local-spool-file-alist
 578                                  (mapcar
 579                                   (lambda (spool)
 580                                     (car spool))
 581                                   pop3-fma-spool-file-alist))))))
 582 ;;
 583 ;; Enable fetch news
 584 ;;
 585 (defun gnus-offline-enable-fetch-news ()
 586   "*Set to fetch news."
 587   (if (eq gnus-offline-news-fetch-method 'nnagent)
 588       (progn
 589         (setq gnus-agent-handle-level gnus-level-subscribed)
 590         (gnus-agent-toggle-plugged t))))
 591 \f
 592 ;;
 593 ;; Add your custom header.
 594 ;;
 595 (defun gnus-offline-add-custom-header (header string)
 596   "*Add X-Gnus-Offline-Backend header to Mail/News message."
 597   (let ((delimline
 598          (progn (goto-char (point-min))
 599                 (re-search-forward
 600                  (concat "^" (regexp-quote mail-header-separator) "\n"))
 601                 (point-marker))))
 602     (goto-char (point-min))
 603     (or (re-search-forward (concat "^" header) delimline t)
 604         (progn
 605           (goto-char delimline)
 606           (forward-line -1)
 607           (beginning-of-line)
 608           (setq hdr (concat header " "))
 609           (setq str (concat hdr string))
 610           (setq hdr (concat str "\n"))
 611           (insert-string hdr)))))
 612 ;;
 613 ;; Add X-Offline-Backend header.
 614 ;;
 615 (defun gnus-offline-message-add-header ()
 616   "*Add X-Gnus-Offline-Backend header to Mail/News message."
 617   (if (eq gnus-offline-mail-treat-environ 'offline)
 618       (progn
 619         (if (eq gnus-offline-news-fetch-method 'nnagent)
 620             (setq ver nnagent-version)
 621           (setq ver nnspool-version))
 622         (setq str (format "\n                        with %s" ver)
 623               string (concat gnus-offline-header-string str))
 624         (gnus-offline-add-custom-header "X-Gnus-Offline-Backend:" string))))
 625
 626 \f
 627 ;;
 628 ;; Toggle plugged/unplugged
 629 ;;
 630 (defun gnus-offline-toggle-plugged (plugged)
 631   "*Override function \"Jj\" - gnus-agent-toggle-plugged."
 632   (interactive (list (not gnus-offline-connected)))
 633   (if plugged
 634       (progn
 635         (setq gnus-offline-connected plugged)
 636         (gnus-agent-toggle-plugged plugged)
 637         ;; Set send mail/news function to offline functions.
 638         (gnus-offline-set-online-sendmail-function)
 639         (gnus-offline-set-online-post-news-function))
 640     ;; Set to offline status
 641     (gnus-offline-set-unplugged-state)))
 642 ;;
 643 ;; Function of hang up line.
 644 ;;
 645 (defun gnus-offline-set-unplugged-state ()
 646   "*Set to unplugged state."
 647   (interactive)
 648   ;; Hang Up Line.
 649   (if (functionp gnus-offline-hangup-function)
 650       (funcall gnus-offline-hangup-function))
 651   (setq gnus-offline-connected nil)
 652   (if (eq gnus-offline-news-fetch-method 'nnagent)
 653       (gnus-agent-toggle-plugged nil))
 654
 655   ;; Set send mail/news function to offline functions.
 656   (gnus-offline-set-offline-sendmail-function)
 657   (gnus-offline-set-offline-post-news-function)
 658   ;;
 659   (setenv "MAILHOST" nil))
 660 ;;
 661 ;; Hangup line function
 662 ;;
 663 (defun gnus-offline-hangup-line ()
 664   "*Hangup line function."
 665   (message "Hang up line ... ")
 666   (if (stringp gnus-offline-hangup-program)
 667       (apply 'start-process "hup" nil gnus-offline-hangup-program
 668              gnus-offline-hangup-program-arguments))
 669   (message "Hang up line ... done."))
 670 ;;
 671 ;; Hang Up line routine whe using nnspool
 672 ;;
 673 (defun gnus-offline-nnspool-hangup-line ()
 674   (if (and gnus-offline-connected
 675            gnus-offline-auto-hangup)
 676       (gnus-offline-set-unplugged-state))
 677   (gnus-offline-after-jobs-done))
 678 ;;
 679 ;; Function of all jobs has done.
 680 ;;
 681 (defun gnus-offline-after-jobs-done ()
 682   "*Jobs after all online jobs."
 683   (run-hooks 'gnus-offline-after-online-hook)
 684   (if (eq gnus-offline-articles-to-fetch 'mail)
 685       (gnus-offline-restore-mail-group-level))
 686   (if (eq gnus-offline-news-fetch-method 'nnagent)
 687       (gnus-offline-agent-expire))
 688   (ding)
 689   (message "All online jobs have done."))
 690
 691 \f
 692 ;;
 693 ;; Toggle auto hang up
 694 ;;
 695 (defun gnus-offline-toggle-auto-hangup ()
 696   "*Toggle auto hangup flag."
 697   (interactive)
 698   (setq string "Auto hang up logic")
 699   (if gnus-offline-auto-hangup
 700       (progn
 701         (setq gnus-offline-auto-hangup nil
 702               gnus-offline-auto-hangup-indicator "Con"
 703               str "disabled."))
 704     (setq gnus-offline-auto-hangup t
 705           gnus-offline-auto-hangup-indicator "Hup"
 706           str "enabled."))
 707   (message (format "%s %s" string str)))
 708 ;;
 709 ;; Toggle offline/online to send mail.
 710 ;;
 711 (defun gnus-offline-toggle-on/off-send-mail ()
 712   "*Toggel online/offline sendmail."
 713   (interactive)
 714   (if (eq gnus-offline-mail-treat-environ 'offline)
 715       (progn
 716         ;; Sending mail under online environ.
 717         (gnus-offline-set-online-sendmail-function)
 718         (setq gnus-offline-mail-treat-environ 'online)
 719         (message "Sending mail immidiately."))
 720     ;; Sending mail under offline environ.
 721     (gnus-offline-set-offline-sendmail-function)
 722     (setq gnus-offline-mail-treat-environ 'offline)
 723     (message "Sending mail temporary to spool directory.")))
 724 ;;
 725 ;; Toggle articles to fetch ... both -> mail -> news -> both
 726 ;;
 727 (defun gnus-offline-toggle-articles-to-fetch ()
 728   "*Set articles to fetch... both(Mail/News) -> mail only -> News only -> both"
 729   (interactive)
 730   (setq string "Articles fetch from server.")
 731   (cond ((eq gnus-offline-articles-to-fetch 'both)
 732          (setq gnus-offline-articles-to-fetch 'mail
 733                str "Only Mail"))
 734         ((eq gnus-offline-articles-to-fetch 'mail)
 735            (setq gnus-offline-articles-to-fetch 'news
 736                  str "Only News"))
 737         (t
 738          (setq gnus-offline-articles-to-fetch 'both
 739                str "Mail/News both")))
 740   (message (format "%s %s" string str)))
 741 ;;
 742 ;; Toggle movemail program pop3.el -> movemail -> pop3.el
 743 ;;
 744 (defun gnus-offline-toggle-movemail-program ()
 745   "*Toggle movemail program movemail -> pop3.el -> movemail ->..."
 746   (interactive)
 747   (setq string "Set nnmail-movemail-program")
 748   (cond ((eq pop3-fma-movemail-type 'lisp)
 749          (setq pop3-fma-movemail-type 'exe
 750                str "to movemail"))
 751         (t
 752          (setq pop3-fma-movemail-type 'lisp
 753                str "to pop3.el")))
 754   (message (format "%s %s" string str)))
 755 ;;
 756 ;; Send mail and Post news using Miee or gnus-agent.
 757 ;;
 758 (defun gnus-offline-empting-spool ()
 759   "*Send all drafts on queue."
 760   (run-hooks 'gnus-offline-before-empting-spool-hook)
 761   (if (eq gnus-offline-drafts-queue-type 'miee)
 762       ;; Send queued message by miee.el.
 763       (progn
 764         (if (eq gnus-offline-mail-treat-environ 'offline)
 765             (progn
 766               (message "Sending mails in spool ...")
 767               ;; Using miee to send mail.
 768               (mail-spool-send)
 769               (message "Sending mails in spool ... done.")))
 770         (message "Posting news in spool ...")
 771         ;; Using miee to post news.
 772         (if (and (not (stringp msspool-news-server))
 773                  (not msspool-news-service))
 774             (progn
 775               (setq msspool-news-server (nth 1 gnus-select-method))
 776               (setq msspool-news-service 119)))
 777         (news-spool-post)
 778         (message "Posting news in spool ... done."))
 779     ;; Send queued message by gnus-agent
 780     (message "Sending messages in spool ...")
 781     (gnus-group-send-drafts)
 782     (message "Sending messages in spool ... done."))
 783   ;;
 784   (run-hooks 'gnus-offline-after-empting-spool-hook))
 785 ;;
 786 ;; Set interval time
 787 ;;
 788 (defun gnus-offline-set-interval-time ()
 789   "*Set interval time for gnus-daemon."
 790   (interactive)
 791   (setq gnus-offline-interval-time
 792         (string-to-int (read-from-minibuffer
 793                         (format "Interval time (now %s minutes) : "
 794                                 gnus-offline-interval-time)
 795                         nil)))
 796   (if (< gnus-offline-interval-time 2)
 797       (progn
 798         (message "Retrieving message logic by timer is disabled.")
 799         (setq gnus-offline-interval-time 0))
 800     (message (format "Interval time set to %d minutes" gnus-offline-interval-time)))
 801   (gnus-offline-processed-by-timer))
 802 ;;
 803 ;; Expire articles using gnus-agent.
 804 ;;
 805 (defun gnus-offline-agent-expire ()
 806   "*Expire expirable article on News group."
 807   (interactive)
 808   (gnus-agent-expire))
 809 ;;
 810 ;; Menu.
 811 ;;
 812 (defun gnus-offline-define-menu-and-key ()
 813   "*Set key and menu."
 814   (if (eq gnus-offline-drafts-queue-type 'miee)
 815       (add-hook 'gnus-group-mode-hook 'gnus-offline-define-menu-on-miee)
 816     (add-hook 'gnus-group-mode-hook 'gnus-offline-define-menu-on-agent))
 817   (add-hook 'gnus-group-mode-hook
 818             '(lambda ()
 819                (local-set-key "\C-coh" 'gnus-offline-set-unplugged-state)
 820                (local-set-key "\C-com" 'gnus-offline-toggle-movemail-program)
 821                (local-set-key "\C-cof" 'gnus-offline-toggle-articles-to-fetch)
 822                (local-set-key "\C-coo" 'gnus-offline-toggle-on/off-send-mail)
 823                (local-set-key "\C-cox" 'gnus-offline-toggle-auto-hangup)
 824                (local-set-key "\C-cos" 'gnus-offline-set-interval-time)
 825                (substitute-key-definition
 826                 'gnus-group-get-new-news 'gnus-offline-gnus-get-new-news
 827                 gnus-group-mode-map)
 828                (if (eq gnus-offline-news-fetch-method 'nnagent)
 829                    (progn
 830                      (substitute-key-definition
 831                       'gnus-agent-toggle-plugged 'gnus-offline-toggle-plugged
 832                       gnus-agent-group-mode-map)
 833                      (local-set-key "\C-coe" 'gnus-offline-agent-expire)))))
 834   (if (eq gnus-offline-news-fetch-method 'nnagent)
 835       (add-hook 'gnus-summary-mode-hook
 836                 '(lambda ()
 837                    (substitute-key-definition
 838                     'gnus-agent-toggle-plugged 'gnus-offline-toggle-plugged
 839                     gnus-agent-summary-mode-map)))))
 840
 841 (defun gnus-offline-define-menu-on-miee ()
 842   "*Set menu bar on MIEE menu."
 843   (global-set-key
 844    [menu-bar
 845     miee
 846     gnus-offline-hup-separator]
 847    '("--"))
 848
 849   (global-set-key
 850    [menu-bar
 851     miee
 852     gnus-offline]
 853    (cons "Gnus Offline Utility"
 854          (make-sparse-keymap "Gnus Offline Utiliry")))
 855
 856   (if (featurep 'pop3-fma)
 857       (global-set-key
 858        [menu-bar
 859         miee
 860         gnus-offline
 861         gnus-offline-toggle-movemail-program]
 862        '("Toggle movemail program" .
 863          gnus-offline-toggle-movemail-program)))
 864
 865   (global-set-key
 866    [menu-bar
 867     miee
 868     gnus-offline
 869     gnus-offline-toggle-articles-to-fetch]
 870    '("Toggle articles to fetch" .
 871      gnus-offline-toggle-articles-to-fetch))
 872
 873   (global-set-key
 874    [menu-bar
 875     miee
 876     gnus-offline
 877     gnus-offline-toggle-on/off-send-mail]
 878    '("Toggle online/offline send mail" .
 879      gnus-offline-toggle-on/off-send-mail))
 880
 881   (global-set-key
 882    [menu-bar
 883     miee
 884     gnus-offline
 885     gnus-offline-toggle-auto-hangup]
 886    '("Toggle auto hang up" . gnus-offline-toggle-auto-hangup))
 887
 888   (global-set-key
 889    [menu-bar
 890     miee
 891     gnus-offline
 892     gnus-offline-expire-separator]
 893    '("--"))
 894
 895   (if (eq gnus-offline-news-fetch-method 'nnagent)
 896       (global-set-key
 897        [menu-bar
 898         miee
 899         gnus-offline
 900         gnus-offline-agent-expire]
 901        '("Expire articles" . gnus-offline-agent-expire)))
 902
 903   (global-set-key
 904    [menu-bar
 905     miee
 906     gnus-offline
 907     gnus-offline-set-interval-time]
 908    '("Set interval time." . gnus-offline-set-interval-time))
 909
 910   (global-set-key
 911    [menu-bar
 912     miee
 913     gnus-offline
 914     gnus-offline-hup-separator]
 915    '("--"))
 916
 917   (global-set-key
 918    [menu-bar
 919     miee
 920     gnus-offline
 921     gnus-offline-set-unplugged-state]
 922    '("Hang Up Line." . gnus-offline-set-unplugged-state)))
 923 ;;
 924 ;; define menu without miee.
 925 ;;
 926 (defun gnus-offline-define-menu-on-agent ()
 927   "*Set menu bar on OFFLINE menu."
 928   (define-key-after
 929     (lookup-key global-map [menu-bar])
 930     [offline]
 931     (cons "Offline" (make-sparse-keymap "Offline"))
 932     'help)               ;; Actually this adds before "Help".
 933
 934   (if (featurep 'pop3-fma)
 935       (global-set-key
 936        [menu-bar
 937         offline
 938         gnus-offline-toggle-movemail-program]
 939        '("Toggle movemail program" . gnus-offline-toggle-movemail-program)))
 940
 941   (global-set-key
 942    [menu-bar
 943     offline
 944     gnus-offline-toggle-articles-to-fetch]
 945    '("Toggle articles to fetch" . gnus-offline-toggle-articles-to-fetch))
 946
 947   (global-set-key
 948    [menu-bar
 949     offline
 950     gnus-offline-toggle-on/off-send-mail]
 951    '("Toggle online/offline send mail" . gnus-offline-toggle-on/off-send-mail))
 952
 953   (global-set-key
 954    [menu-bar
 955     offline
 956     gnus-offline-toggle-auto-hangup]
 957    '("Toggle auto hang up" . gnus-offline-toggle-auto-hangup))
 958
 959   (global-set-key
 960    [menu-bar
 961     offline
 962     gnus-offline-separator]
 963    '("--"))
 964
 965   (if (eq gnus-offline-news-fetch-method 'nnagent)
 966       (progn
 967         (global-set-key
 968          [menu-bar
 969           offline
 970           gnus-offline-agent-expire]
 971          '("Expire articles" . gnus-offline-agent-expire))))
 972
 973   (global-set-key
 974    [menu-bar
 975     offline
 976     gnus-offline-set-interval-time]
 977    '("Set interval time." . gnus-offline-set-interval-time))
 978
 979   (global-set-key
 980    [menu-bar
 981     offline
 982     gnus-offline-hup-separator]
 983    '("--"))
 984
 985   (global-set-key
 986    [menu-bar
 987     offline
 988     gnus-offline-set-unplugged-state]
 989    '("Hang Up Line." . gnus-offline-set-unplugged-state)))
 990 \f
 991 ;;
 992 ;; Timer Function
 993 (defun gnus-offline-processed-by-timer ()
 994   "*Set timer interval."
 995   (if (and (> gnus-offline-interval-time 0)
 996            (not gnus-offline-connected))
 997       ;; Timer call
 998       (gnus-demon-add-handler 'gnus-offline-gnus-get-new-news
 999                               gnus-offline-interval-time
1000                               gnus-offline-interval-time))
1001   (if (= gnus-offline-interval-time 0)
1002       (gnus-demon-remove-handler 'gnus-offline-gnus-get-new-news t)))
1003 ;;
1004 ;;
1005 (provide 'gnus-offline)
1006 ;;; gnus-offline.el ends here