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

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