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