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