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