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