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

   1 ;;; gnus-ofsetup.el --- Setup advisor for Offline reading for Mail/News.
   2 ;;;
   3 ;;; $Id: gnus-ofsetup.el,v 1.1.2.18 1999-05-13 02:36:22 yamaoka Exp $
   4 ;;;
   5 ;;; Copyright (C) 1998 Tatsuya Ichikawa
   6 ;;; Author: Tatsuya Ichikawa <t-ichi@po.shiojiri.ne.jp>
   7 ;;;
   8 ;;; This file is part of Semi-gnus.
   9 ;;;
  10 ;;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;;; it under the terms of the GNU General Public License as published by
  12 ;;; the Free Software Foundation; either version 2, or (at your option)
  13 ;;; any later version.
  14
  15 ;;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  18 ;;; GNU General Public License for more details.
  19
  20 ;;; You should have received a copy of the GNU General Public License
  21 ;;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;;; Boston, MA 02111-1307, USA.
  24 ;;;
  25 ;;;; Commentary:
  26 ;;; How to use.
  27 ;;;
  28 ;;;      M-x load[RET]gnus-ofsetup
  29 ;;;      M-x gnus-setup-for-offline
  30 ;;;
  31
  32 ;;; Code:
  33
  34 (defvar gnus-offline-setting-file "~/.gnus-offline.el")
  35 (defvar gnus-offline-use-miee nil)
  36 (defvar gnus-offline-news-fetch-method nil)
  37 (defvar gnus-offline-mail-fetch-method nil)
  38 (defvar gnus-offline-hangup-program nil)
  39 (defvar gnus-offline-dialup-program nil)
  40 (defvar pop3-fma-spool-file-alist nil)
  41 (defvar pop3-fma-movemail-type nil)
  42 (defvar pop3-fma-movemail-arguments nil)
  43 (defvar use-miee nil)
  44 (defvar address nil)
  45 (defvar mail-source nil)
  46 (defvar options nil)
  47
  48 ;;; To silence byte compiler
  49 (and
  50  (fboundp 'eval-when-compile)
  51  (eval-when-compile
  52    (save-excursion
  53      (beginning-of-defun)
  54      (eval-region (point-min) (point)))
  55    (let (case-fold-search)
  56      (mapcar
  57       (function
  58        (lambda (symbol)
  59          (unless (boundp symbol)
  60            (make-local-variable symbol)
  61            (eval (list 'setq symbol nil)))))
  62       '(:group
  63         :prefix :type
  64         sendmail-to-spool-directory
  65         news-spool-request-post-directory
  66         nnspool-version
  67         nnagent-version
  68         msspool-news-server
  69         msspool-news-service
  70         gnspool-get-news
  71         mail-spool-send
  72         news-spool-post
  73         gnus-agent-handle-level
  74         ))
  75      (make-local-variable 'byte-compile-warnings)
  76      (setq byte-compile-warnings nil))))
  77
  78 (defun gnus-setup-for-offline ()
  79   "*Set up Gnus for offline environment."
  80   (interactive)
  81
  82   (if (not (file-exists-p gnus-offline-setting-file))
  83       (progn
  84         (let ((news-method
  85                (completing-read
  86                 "Method for offline News reading (TAB to completion): "
  87                 '(("gnus-agent" 1) ("nnspool" 2))
  88                 nil t nil))
  89               (mail-method 'nnmail)
  90               (program
  91                (read-file-name "Dialup/Hangup program(type nil or null string you do not use): "))
  92               (mta-type
  93                (completing-read
  94                 "Select MTA type for sending mail (TAB to completion): "
  95                 '(("smtp" 1) ("sendmail" 2))
  96                 nil t nil))
  97               (num-of-address
  98                (read-from-minibuffer "How many e-mail address do you have: "))
  99               )
 100           (if (string-equal news-method "nnspool")
 101               (setq use-miee t)
 102             (setq use-miee (y-or-n-p "Use MIEE post/send message ")))
 103           ;;
 104           ;; Set variables.
 105           (if (string-equal news-method "gnus-agent")
 106               (setq gnus-offline-news-fetch-method 'nnagent)
 107             (setq gnus-offline-news-fetch-method 'nnspool))
 108           ;;
 109           (setq gnus-offline-mail-fetch-method mail-method)
 110           (setq gnus-offline-use-miee use-miee)
 111
 112           ;; Set programs.
 113           (if (or (string-equal program "nil")
 114                   (string-equal program ""))
 115               (progn
 116                 (setq gnus-offline-hangup-program nil)
 117                 (setq gnus-offline-dialup-program nil))
 118             (let ((options
 119                    (read-from-minibuffer "Dialup program options: ")))
 120               (setq gnus-offline-dialup-program-arguments
 121                     (split-string options "[\t ]+")))
 122             (let ((options
 123                    (read-from-minibuffer "Hangup program options: ")))
 124               (setq gnus-offline-hangup-program-arguments
 125                     (split-string options "[\t ]+")))
 126             (setq gnus-offline-hangup-program program)
 127             (setq gnus-offline-dialup-program program))
 128
 129             ;; Set spool directory for outgoing messages.
 130           (if use-miee
 131               (progn
 132                 ;; Setting for MIEE with nnspool.
 133                 (let ((news-spool
 134                        (read-from-minibuffer
 135                         "News spool directory for sending: "
 136                         "/usr/spool/news.out"))
 137                       (mail-spool
 138                        (read-from-minibuffer
 139                         "Mail spool directory for sending: "
 140                         "/usr/spool/mail.out")))
 141                   (setq gnus-offline-mail-spool-directory mail-spool)
 142                   (setq gnus-offline-news-spool-directory news-spool)
 143                   (setq gnus-offline-drafts-queue-type 'miee)
 144
 145                   ;; Load MIEE.
 146                   (load "miee")
 147                   ;; Set news post function for MIEE.
 148                   (setq message-send-news-function 'gnspool-request-post)
 149                   ;; Spool directory setting - MIEE.
 150                   (if (not (file-exists-p gnus-offline-mail-spool-directory))
 151                       (make-directory gnus-offline-mail-spool-directory t))
 152                   (setq sendmail-to-spool-directory
 153                         gnus-offline-mail-spool-directory)
 154                   (if (not (file-exists-p gnus-offline-news-spool-directory))
 155                       (make-directory gnus-offline-news-spool-directory t))
 156                   (setq news-spool-request-post-directory
 157                         gnus-offline-news-spool-directory)))
 158
 159             ;; Set drafts type gnus-agent.
 160             (setq gnus-offline-drafts-queue-type 'agent))
 161
 162           ;; Setting for gnus-agent.
 163           (if (eq gnus-offline-news-fetch-method 'nnagent)
 164               (let ((agent-directory
 165                      (read-from-minibuffer "Agent directory: " "~/News/agent")))
 166                 (setq gnus-agent-directory agent-directory)))
 167
 168           ;; Determin MTA type.
 169           (if (string-equal mta-type "smtp")
 170               (setq gnus-offline-MTA-type 'smtp)
 171             (setq gnus-offline-MTA-type 'sendmail)
 172             )
 173           ;;
 174           ;; Set E-Mail Address and pop3 movemail type.
 175           (setq i (string-to-int num-of-address))
 176           (setq address nil)
 177           (if (not (locate-library "mail-source"))
 178               (progn
 179                 (while (> i 0)
 180                   (setq address
 181                         (append address
 182                                 (list
 183                                  (list
 184                                   (concat "po:"
 185                                           (read-from-minibuffer
 186                                            "Email address (user@mailhost): "))
 187                                   (completing-read
 188                                    "Authentification Method (TAB to completion): "
 189                                    '(("pass" 1) ("apop" 2)) nil t nil)))))
 190                   (setq i (- i 1)))
 191                 ;; Replace "hoge" -> 'hoge
 192                 (mapcar
 193                  (lambda (x)
 194                    (if (string-equal (nth 1 x) "pass")
 195                        (setcar (cdr x) 'pass)
 196                      (setcar (cdr x) 'apop)))
 197                  address)
 198                 (setq pop3-fma-spool-file-alist address)
 199                 ;; Set movemail type.
 200                 (let ((movemail-type
 201                        (completing-read
 202                         "Select movemail type for retreave mail (TAB to completion): "
 203                         '(("exe" 1) ("lisp" 2))
 204                         nil t nil))
 205                       )
 206                   (if (string-equal movemail-type "exe")
 207                       (let ((options
 208                              (read-from-minibuffer "movemail options: ")))
 209                         (setq pop3-fma-movemail-arguments (split-string options "[\t ]+"))))
 210                   (if (string-equal movemail-type "exe")
 211                       (setq pop3-fma-movemail-type 'exe)
 212                     (setq pop3-fma-movemail-type 'lisp))))
 213             ;;
 214             ;; Use mail-source.el
 215             (setq mail-source nil)
 216             (while (> i 0)
 217               (let ((user (read-from-minibuffer "Mail Account name : "))
 218                     (server (read-from-minibuffer "Mail server : "))
 219                     (auth (completing-read
 220                           "Authentification Method (TAB to completion): "
 221                           '(("password") ("apop")) nil t nil))
 222                     (islisp (y-or-n-p "Do you use pop3.el to fetch mail? "))
 223                     source)
 224                 (if (not islisp)
 225                     (let ((prog (read-file-name "movemail program name: "
 226                                                 exec-directory "movemail"))
 227                           (args (read-from-minibuffer "movemail options: "
 228                                                       "-pf")))
 229                       (setq source (list 'pop
 230                                          :user user
 231                                          :server server
 232                                          :program (format "%s %s %s %s %s"
 233                                                           prog
 234                                                           args
 235                                                           "po:%u"
 236                                                           "%t"
 237                                                           "%p"))))
 238                   (setq source (list 'pop
 239                                      :user user
 240                                      :server server)))
 241                 (setq mail-source
 242                       (nconc mail-source
 243                              (list
 244                               (if (string-equal "apop" auth)
 245                                   (nconc source '(:authentication apop))
 246                                 source)))))
 247               (setq i (1- i)))
 248             (setq gnus-offline-mail-source mail-source)))
 249
 250         (setq save-passwd
 251               (y-or-n-p "Do you save password information to newsrc file? "))
 252
 253         ;; Write to setting file.
 254         (setq tmp-buffer (get-buffer-create "* Setting"))
 255         (set-buffer "* Setting")
 256         (erase-buffer)
 257         (insert ";;\n");
 258         (insert ";; This file is created by gnus-ofsetup.el\n")
 259         (insert ";; Creation date : ")
 260         (insert (current-time-string))
 261         (insert "\n")
 262         (insert ";;\n")
 263
 264         ;; write Basic setting
 265         (insert "(setq gnus-offline-news-fetch-method '")
 266         (insert (prin1-to-string gnus-offline-news-fetch-method))
 267         (insert ")\n")
 268         (insert "(setq gnus-offline-mail-fetch-method '")
 269         (insert (prin1-to-string gnus-offline-mail-fetch-method))
 270         (insert ")\n")
 271         (insert "(setq gnus-offline-use-miee ")
 272         (insert (prin1-to-string gnus-offline-use-miee))
 273         (insert ")\n")
 274         (insert "(setq gnus-offline-dialup-program ")
 275         (insert (prin1-to-string gnus-offline-dialup-program))
 276         (insert ")\n")
 277
 278         ;; write dialup/hangup program and options.
 279         (if (stringp gnus-offline-dialup-program)
 280             (progn
 281               (insert "(setq gnus-offline-dialup-program-arguments '")
 282               (insert (prin1-to-string gnus-offline-dialup-program-arguments))
 283               (insert ")\n")))
 284         (insert "(setq gnus-offline-hangup-program ")
 285         (insert (prin1-to-string gnus-offline-hangup-program))
 286         (insert ")\n")
 287         (if (stringp gnus-offline-hangup-program)
 288             (progn
 289               (insert "(setq gnus-offline-hangup-program-arguments '")
 290               (insert (prin1-to-string gnus-offline-hangup-program-arguments))
 291               (insert ")\n")))
 292
 293         ;; write setting about MIEE.
 294         (if gnus-offline-use-miee
 295             (progn
 296               (insert "(setq gnus-offline-mail-spool-directory ")
 297               (insert (prin1-to-string gnus-offline-mail-spool-directory))
 298               (insert ")\n")
 299               (insert "(setq gnus-offline-news-spool-directory ")
 300               (insert (prin1-to-string gnus-offline-news-spool-directory))
 301               (insert ")\n")
 302               (insert "(setq sendmail-to-spool-directory gnus-offline-mail-spool-directory)\n")
 303               (insert "(setq news-spool-request-post-directory gnus-offline-news-spool-directory)\n")
 304               (insert "(load \"miee\")\n")
 305               (insert "(setq message-send-news-function '")
 306               (insert (prin1-to-string message-send-news-function))
 307               (insert ")\n")))
 308
 309         ;; write setting about nnspool and gnus-agent.
 310         (if (equal gnus-offline-news-fetch-method 'nnspool)
 311             (insert "(message-offline-state)\n")
 312           (insert "(setq gnus-agent-directory ")
 313           (insert (prin1-to-string gnus-agent-directory))
 314           (insert ")\n"))
 315
 316         ;; write setting about queue type -- MIEE or nnagent.
 317         (insert "(setq gnus-offline-drafts-queue-type '")
 318         (insert (prin1-to-string gnus-offline-drafts-queue-type))
 319         (insert ")\n")
 320         (insert "(setq gnus-offline-MTA-type '")
 321         (insert (prin1-to-string gnus-offline-MTA-type))
 322         (insert ")\n")
 323
 324         ;; Offline setting for gnus-nntp-*
 325         (insert "(setq gnus-nntp-service nil)\n")
 326         (insert "(setq gnus-nntp-server nil)\n")
 327
 328         ;; Write setting about hooks.
 329         (insert "(add-hook 'gnus-group-mode-hook 'gnus-offline-processed-by-timer t)\n")
 330         (insert "(add-hook 'gnus-group-mode-hook 'gnus-offline-error-check t)\n")
 331         (insert "(add-hook 'gnus-after-getting-new-news-hook 'gnus-offline-after-get-new-news)\n")
 332         (insert "(add-hook 'gnus-after-getting-news-hook 'gnus-offline-after-get-new-news)\n")
 333         (if (eq gnus-offline-news-fetch-method 'nnspool)
 334             (progn
 335               (insert "(add-hook 'after-getting-news-hook 'gnus-offline-nnspool-hangup-line)\n")
 336               (insert "(add-hook 'gnus-before-startup-hook (lambda () (setq nnmail-spool-file nil)))\n")))
 337         (insert "(add-hook 'message-send-hook 'gnus-offline-message-add-header)\n")
 338         (insert "(autoload 'gnus-offline-setup \"gnus-offline\")\n")
 339         (insert "(add-hook 'gnus-load-hook 'gnus-offline-setup)\n")
 340
 341         (if (not (locate-library "mail-source"))
 342             (progn
 343               ;; Write setting about pop3-fma.
 344               (insert "(require 'pop3-fma)\n")
 345               (insert "(add-hook 'message-send-hook 'pop3-fma-message-add-header)\n")
 346               (insert "(setq pop3-fma-spool-file-alist '")
 347               (insert (prin1-to-string pop3-fma-spool-file-alist))
 348               (insert ")\n")
 349               (insert "(setq pop3-fma-movemail-type '")
 350               (insert (prin1-to-string pop3-fma-movemail-type))
 351               (insert ")\n")
 352               (if save-passwd
 353                   (insert "(add-hook 'gnus-setup-news-hook \n    (lambda ()\n        (setq pop3-fma-save-password-information t)\n        (add-to-list 'gnus-variable-list 'pop3-fma-password)))\n"))
 354               (if (eq pop3-fma-movemail-type 'exe)
 355                   (progn
 356                     (insert "(setq pop3-fma-movemail-arguments '")
 357                     (insert (prin1-to-string pop3-fma-movemail-arguments))
 358                     (insert ")\n"))))
 359           ;; Write stting about mail-source.el
 360           (insert "(setq gnus-offline-mail-source '")
 361           (insert (prin1-to-string gnus-offline-mail-source))
 362           (insert ")\n")
 363           (insert "(setq nnmail-spool-file gnus-offline-mail-source)\n")
 364           (insert "(require 'read-passwd)\n")
 365           (insert "(setq mail-source-read-passwd 'read-pw-read-passwd)\n")
 366           (insert "(add-hook 'gnus-setup-news-hook 'read-pw-set-mail-source-passwd-cache)\n")
 367           (if save-passwd
 368               (insert "(add-hook 'gnus-setup-news-hook \n    (lambda ()\n        (add-to-list 'gnus-variable-list 'mail-source-password-cache)))\n"))
 369           )
 370         (write-region (point-min) (point-max) gnus-offline-setting-file)
 371         (kill-buffer "* Setting"))
 372     )
 373   (load gnus-offline-setting-file))
 374 ;; gnus-ofsetup.el Ends here.