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