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