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