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 ;;; Copyright (C) 1998 Tatsuya Ichikawa
   4 ;;; Author: Tatsuya Ichikawa <t-ichi@po.shiojiri.ne.jp>
   5 ;;; Author: Keiichi Suzuki <keiichi@nanap.org>
   6 ;;;
   7 ;;; This file is part of Nana-gnus.
   8 ;;;
   9 ;;; GNU Emacs is free software; you can redistribute it and/or modify
  10 ;;; it under the terms of the GNU General Public License as published by
  11 ;;; the Free Software Foundation; either version 2, or (at your option)
  12 ;;; any later version.
  13
  14 ;;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  17 ;;; GNU General Public License for more details.
  18
  19 ;;; You should have received a copy of the GNU General Public License
  20 ;;; along with GNU Emacs; see the file COPYING.  If not, write to the
  21 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22 ;;; Boston, MA 02111-1307, USA.
  23 ;;;
  24 ;;;; Commentary:
  25 ;;; How to use.
  26 ;;;
  27 ;;;      M-x load-library[RET]gnus-ofsetup[RET]
  28 ;;;      M-x gnus-setup-for-offline[RET]
  29 ;;;
  30
  31 ;;; Code:
  32
  33 (eval-when-compile
  34   (require 'poe))
  35
  36 (defvar gnus-offline-setting-file "~/.nana-gnus-offline.el")
  37
  38 (defun gnus-ofsetup-read-from-minibuffer (format &rest args)
  39   (let ((server
  40          (read-from-minibuffer
  41           (apply 'format
  42                  (concat format
  43                          " (if you are finished, input null string.) : ")
  44                  args))))
  45     (unless (string-match "^[ \t]*$" server)
  46       server)))
  47
  48 (defun gnus-ofsetup-completing-read-symbol (msg &rest syms)
  49   (intern
  50    (completing-read (concat msg " (TAB to completion): ")
  51                     (mapcar
  52                      (lambda (sym)
  53                        (list (symbol-name sym)))
  54                      syms)
  55                     nil t nil)))
  56
  57 (defun gnus-ofsetup-read-pop-account (server)
  58   (let ((account (gnus-ofsetup-read-from-minibuffer
  59                   "Mail account at \"%s\"" server)))
  60     (when account
  61       (let ((auth (gnus-ofsetup-completing-read-symbol
  62                    "Authentification Method"
  63                    'pass 'apop)))
  64         (list (concat account "@" server) :auth-scheme auth)))))
  65
  66 (defun gnus-setup-for-offline ()
  67   "*Set up Gnus for offline environment."
  68   (interactive)
  69   (unless (file-exists-p gnus-offline-setting-file)
  70     (let (movemail-option
  71           news-fetch-method mail-fetch-method agent-directory drafts-queue-type
  72           news-spool-directory mail-spool-directory send-news-function
  73           sendmail-to-spool-directory news-spool-request-post-directory
  74           MTA-type dialup-program dialup-program-arguments hangup-program
  75           hangup-program-arguments movemail-program
  76           movemail-program-apop-option spool-file save-passwd)
  77       (setq news-fetch-method
  78             (gnus-ofsetup-completing-read-symbol
  79              "Method for offline News reading"
  80              'nnagent 'nnspool))
  81       (when (eq news-fetch-method 'nnagent)
  82         (setq agent-directory
  83               (read-from-minibuffer "Agent directory: " "~/News/agent")))
  84       (setq drafts-queue-type
  85             (cond
  86              ((or (eq news-fetch-method 'nnspool)
  87                   (y-or-n-p "Use MIEE post/send message "))
  88               ;; Setting for MIEE with nnspool.
  89               (setq news-spool-directory
  90                     (read-from-minibuffer
  91                      "News spool directory for sending: "
  92                      "/usr/spool/news.out"))
  93               (setq mail-spool-directory
  94                     (read-from-minibuffer
  95                      "Mail spool directory for sending: "
  96                      "/usr/spool/mail.out"))
  97               ;; Set news post function for MIEE.
  98               (setq send-news-function 'gnspool-request-post)
  99               ;; Spool directory setting - MIEE.
 100               (unless (file-exists-p mail-spool-directory)
 101                 (make-directory mail-spool-directory t))
 102               (setq sendmail-to-spool-directory mail-spool-directory)
 103               (unless (file-exists-p news-spool-directory)
 104                 (make-directory news-spool-directory t))
 105               (setq news-spool-request-post-directory news-spool-directory)
 106               'miee)
 107              (t
 108               'agent)))
 109       (setq mail-fetch-method 'nnmail)
 110       (setq MTA-type (gnus-ofsetup-completing-read-symbol
 111                       "Select MTA type for sending mail"
 112                       'smtp 'sendmail))
 113       (setq dialup-program
 114             (read-file-name
 115              "Dialup program (if you do not use it, input null string): "
 116              nil nil t))
 117       (if (string-match "^[ \t]*$" dialup-program)
 118           (setq dialup-program nil)
 119         (setq dialup-program-arguments
 120               (split-string
 121                (read-from-minibuffer "Dialup program options: ")
 122                "[\t ]+")))
 123       (setq hangup-program
 124             (read-file-name
 125              "Hangup program (if you do not use it, input null string): "
 126              (and dialup-program
 127                   (file-name-directory dialup-program))
 128              dialup-program
 129              t))
 130       (if (string-match "^[ \t]*$" hangup-program)
 131           (setq hangup-program nil)
 132         (setq hangup-program-arguments
 133               (split-string
 134                (read-from-minibuffer "Hangup program options: ")
 135                "[\t ]+")))
 136
 137       ;; Set `movemail' type.
 138       (setq movemail-program
 139             (if (y-or-n-p "Do you use pop3.el to fetch mail? ")
 140                 'nnmail-pop3-movemail
 141               (read-file-name "movemail program name: "
 142                               exec-directory "movemail")))
 143       (when (stringp movemail-program)
 144         (setq movemail-option (read-from-minibuffer "movemail options: " "-f"))
 145         (setq movemail-program-apop-option
 146               (read-from-minibuffer "movemail options for APOP: ")))
 147
 148       ;; Set E-Mail Addresses.
 149       (setq spool-file nil)
 150       (let (server spool)
 151         (while (setq server (gnus-ofsetup-read-from-minibuffer "POP server"))
 152           (while (setq spool (gnus-ofsetup-read-pop-account server))
 153             (setq spool-file (cons spool spool-file)))))
 154
 155       (while (not save-passwd)
 156         (setq save-passwd
 157               (gnus-ofsetup-completing-read-symbol
 158                "How long do you save password"
 159                'never 'exit-emacs 'permanence))
 160         (if (and (eq save-passwd 'permanence)
 161                  (not (y-or-n-p
 162                        "Your password will be saved to newsrc file. OK? ")))
 163             (setq save-passwd nil)))
 164
 165       ;; Write to setting file.
 166       (save-excursion
 167         (set-buffer (get-buffer-create "* Setting"))
 168         (erase-buffer)
 169         (insert ";;\n");
 170         (insert ";; This file is created by gnus-ofsetup.el\n")
 171         (insert ";; Creation date : " (current-time-string) "\n")
 172         (insert ";;\n")
 173
 174         ;; write Basic setting
 175         (insert "(setq gnus-offline-news-fetch-method '"
 176                 (prin1-to-string news-fetch-method) ")\n")
 177         (insert "(setq gnus-offline-mail-fetch-method '"
 178                 (prin1-to-string mail-fetch-method) ")\n")
 179
 180         ;; write dialup/hangup program and options.
 181         (insert "(setq gnus-offline-dialup-program "
 182                 (prin1-to-string dialup-program) ")\n")
 183         (when (stringp dialup-program)
 184           (insert "(setq gnus-offline-dialup-program-arguments '"
 185                   (prin1-to-string dialup-program-arguments) ")\n"))
 186         (insert "(setq gnus-offline-hangup-program "
 187                 (prin1-to-string hangup-program) ")\n")
 188         (when (stringp hangup-program)
 189           (insert "(setq gnus-offline-hangup-program-arguments '"
 190                   (prin1-to-string hangup-program-arguments)
 191                   ")\n"))
 192
 193         ;; write setting about MIEE.
 194         (when (eq drafts-queue-type 'miee)
 195           (insert "(setq gnus-offline-mail-spool-directory "
 196                   (prin1-to-string mail-spool-directory) ")\n")
 197           (insert "(setq gnus-offline-news-spool-directory "
 198                   (prin1-to-string news-spool-directory) ")\n")
 199           (insert "(setq sendmail-to-spool-directory\n"
 200                   "gnus-offline-mail-spool-directory)\n")
 201           (insert "(setq news-spool-request-post-directory\n"
 202                   "gnus-offline-news-spool-directory)\n")
 203           (insert "(load \"miee\")\n")
 204           (insert "(setq message-send-news-function '"
 205                   (prin1-to-string send-news-function) ")\n"))
 206
 207         ;; write setting about nnspool and gnus-agent.
 208         (if (equal news-fetch-method 'nnspool)
 209             (insert "(message-offline-state)\n")
 210           (insert "(setq gnus-agent-directory "
 211                   (prin1-to-string agent-directory) ")\n"))
 212
 213         ;; write setting about queue type -- MIEE or nnagent.
 214         (insert "(setq gnus-offline-drafts-queue-type '"
 215                 (prin1-to-string drafts-queue-type) ")\n")
 216         (insert "(setq gnus-offline-MTA-type '"
 217                 (prin1-to-string MTA-type) ")\n")
 218
 219         ;; Offline setting for gnus-nntp-*
 220         (insert "(setq gnus-nntp-service nil)\n")
 221         (insert "(setq gnus-nntp-server nil)\n")
 222
 223         ;; Write setting about hooks.
 224         (insert "(add-hook 'gnus-group-mode-hook 'gnus-offline-processed-by-timer t)\n")
 225         (insert "(add-hook 'gnus-group-mode-hook 'gnus-offline-error-check t)\n")
 226         (insert "(add-hook 'gnus-after-getting-new-news-hook 'gnus-offline-after-get-new-news)\n")
 227         (insert "(add-hook 'gnus-after-getting-news-hook 'gnus-offline-after-get-new-news)\n")
 228         (when (eq news-fetch-method 'nnspool)
 229           (insert "(add-hook 'gnus-after-getting-news-hook 'gnus-offline-nnspool-hangup-line)\n")
 230           (insert "(add-hook 'gnus-before-startup-hook (lambda () (setq nnmail-spool-file nil)))\n"))
 231         (insert "(add-hook 'message-send-hook 'gnus-offline-message-add-header)\n")
 232         (insert "(autoload 'gnus-offline-setup \"gnus-offline\")\n")
 233         (insert "(add-hook 'gnus-load-hook 'gnus-offline-setup)\n")
 234
 235         ;; Write stting about nnmail.el
 236         (insert "(setq nnmail-movemail-program '"
 237                 (prin1-to-string movemail-program) ")\n")
 238         (when (stringp movemail-program)
 239           (insert "(setenv \"MOVEMAIL\""
 240                   (prin1-to-string movemail-option) ")\n")
 241           (insert "(setq nnmail-movemail-program-apop-option '"
 242                   (prin1-to-string movemail-program-apop-option) ")\n"))
 243         (insert "(setq gnus-offline-mail-source '"
 244                 (prin1-to-string spool-file) ")\n")
 245         (insert
 246          (cond
 247           ((eq save-passwd 'never)
 248            "(setq nnmail-pop-password-required nil)\n")
 249           ((eq save-passwd 'exit-emacs)
 250            "(setq nnmail-pop-password-required t)\n")
 251           ((eq save-passwd 'permanence)
 252            "(setq nnmail-pop-password-required t)
 253 (add-hook 'gnus-setup-news-hook
 254           (lambda ()
 255             (add-to-list 'gnus-variable-list 'nnmail-internal-password-cache)))\n")))
 256         (write-region (point-min) (point-max) gnus-offline-setting-file))
 257       (kill-buffer "* Setting")))
 258   (load gnus-offline-setting-file))
 259
 260 ;; gnus-ofsetup.el Ends here.