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.19.4.2 1999-08-16 10:10:38 czkmt 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 (eval-when-compile
  35   (require 'poe)
  36   (make-local-variable 'byte-compile-warnings)
  37   (setq byte-compile-warnings nil))
  38
  39 (defvar gnus-offline-setting-file "~/.gnus-offline.el")
  40
  41 (defun gnus-ofsetup-completing-read-symbol (msg &rest syms)
  42   (intern
  43    (completing-read (concat msg " (TAB to completion): ")
  44                     (mapcar
  45                      (lambda (sym)
  46                        (list (symbol-name sym)))
  47                      syms)
  48                     nil t nil)))
  49
  50 (defun gnus-setup-for-offline ()
  51   "*Set up Gnus for offline environment."
  52   (interactive)
  53   (unless (file-exists-p gnus-offline-setting-file)
  54     (let (news-method
  55           mail-method agent-directory drafts-queue-type news-spool mail-spool
  56           send-news-function use-miee MTA-type dialup-program
  57           dialup-program-arguments hangup-program hangup-program-arguments
  58           sendmail-to-spool-directory news-spool-request-post-directory
  59           address mail-source spool-file save-passwd)
  60       (setq news-method
  61             (gnus-ofsetup-completing-read-symbol
  62              "Method for offline News reading"
  63              'nnagent 'nnspool))
  64       ;; Setting for gnus-agent.
  65       (if (eq news-method 'nnagent)
  66           (setq agent-directory
  67                 (read-from-minibuffer "Agent directory: " "~/News/agent")))
  68       (setq mail-method 'nnmail)
  69       (setq dialup-program
  70             (read-file-name
  71              "Dialup program (or null string if you do not use): "
  72              nil nil t))
  73       (if (string-match "^[ \t]*$" dialup-program)
  74           (setq dialup-program nil)
  75         (setq dialup-program-arguments
  76               (delete "" (split-string
  77                           (read-from-minibuffer "Dialup program options: ")
  78                           "[\t ]+"))))
  79       (setq hangup-program
  80             (read-file-name
  81              "Hangup program (or null string if you do not use): "
  82              nil nil t))
  83       (if (string-match "^[ \t]*$" hangup-program)
  84           (setq hangup-program nil)
  85         (setq hangup-program-arguments
  86               (delete "" (split-string
  87                           (read-from-minibuffer "Hangup program options: ")
  88                           "[\t ]+"))))
  89       (setq MTA-type (gnus-ofsetup-completing-read-symbol
  90                       "Select MTA type for sending mail"
  91                       'smtp 'sendmail))
  92       (if (eq news-method 'nnspool)
  93           (setq use-miee t)
  94         (setq use-miee (y-or-n-p "Use MIEE post/send message ")))
  95       (if use-miee
  96           (progn
  97             ;; Setting for MIEE.
  98             (setq news-spool
  99                   (read-from-minibuffer
 100                    "News spool directory for sending: "
 101                    "/usr/spool/news.out"))
 102             (setq mail-spool
 103                   (read-from-minibuffer
 104                    "Mail spool directory for sending: "
 105                    "/usr/spool/mail.out"))
 106             (setq drafts-queue-type 'miee)
 107             (gnus-ofsetup-prepare-for-miee))
 108         ;; Set drafts type gnus-agent.
 109         (setq drafts-queue-type 'agent))
 110       ;; Set E-Mail Address and pop3 movemail type.
 111       (setq num-of-address
 112             (read-from-minibuffer "How many e-mail address do you have: "))
 113       (setq i (string-to-int num-of-address))
 114       (while (> i 0)
 115         (let ((user (read-from-minibuffer "Mail Account name : "))
 116               (server (read-from-minibuffer "Mail server : "))
 117               (auth (completing-read
 118                      "Authentification Method (TAB to completion): "
 119                      '(("password") ("apop")) nil t nil))
 120               (islisp (y-or-n-p "Do you use pop3.el to fetch mail? "))
 121               source)
 122           (if (not islisp)
 123               (let ((prog (read-file-name "movemail program name: "
 124                                           exec-directory "movemail"))
 125                     (args (read-from-minibuffer "movemail options: "
 126                                                 "-pf")))
 127                 (setq source (list 'pop
 128                                    :user user
 129                                    :server server
 130                                    :program (format "%s %s %s %s %s"
 131                                                     prog
 132                                                     args
 133                                                     "po:%u"
 134                                                     "%t"
 135                                                     "%p"))))
 136             (setq source (list 'pop
 137                                :user user
 138                                :server server)))
 139           (setq mail-source
 140                 (nconc mail-source
 141                        (list
 142                         (if (string-equal "apop" auth)
 143                             (nconc source '(:authentication apop))
 144                           source)))))
 145         (setq i (1- i)))
 146       (setq save-passwd
 147             (y-or-n-p "Do you save password information to newsrc file? "))
 148       ;;
 149       (gnus-ofsetup-update-setting-file)))
 150   (load gnus-offline-setting-file))
 151
 152 (defun gnus-ofsetup-prepare-for-miee ()
 153   ;; Spool directory setting - MIEE.
 154   (setq mail-spool (or mail-spool "/usr/spool/mail.out"))
 155   (setq news-spool (or news-spool "/usr/spool/news.out"))
 156   (condition-case nil
 157       (progn
 158         (if (not (file-exists-p mail-spool))
 159             (make-directory mail-spool t))
 160         (if (not (file-exists-p news-spool))
 161             (make-directory news-spool t)))
 162     (error
 163      (error "Making directories failed. Set mail/news spool directories properly."))))
 164
 165 (defun gnus-ofsetup-update-setting-file ()
 166   ;; Write to setting file.
 167   (save-excursion
 168     (set-buffer (get-buffer-create "* Setting"))
 169     (erase-buffer)
 170     (insert ";;\n")
 171     (insert ";; This file is created by gnus-ofsetup.el\n")
 172     (insert ";; Creation date : " (current-time-string) "\n")
 173     (insert ";;\n")
 174
 175     ;; write Basic setting
 176     (insert "(setq gnus-offline-news-fetch-method '"
 177             (prin1-to-string news-method) ")\n")
 178     (insert "(setq gnus-offline-mail-fetch-method '"
 179             (prin1-to-string mail-method) ")\n")
 180
 181     ;; write dialup/hangup program and options.
 182     (insert "(setq gnus-offline-dialup-program "
 183             (prin1-to-string dialup-program) ")\n")
 184     (if (stringp dialup-program)
 185         (insert "(setq gnus-offline-dialup-program-arguments '"
 186                 (prin1-to-string dialup-program-arguments) ")\n"))
 187     (insert "(setq gnus-offline-hangup-program "
 188             (prin1-to-string hangup-program) ")\n")
 189     (if (stringp hangup-program)
 190         (insert "(setq gnus-offline-hangup-program-arguments '"
 191                 (prin1-to-string hangup-program-arguments) ")\n"))
 192
 193     (if (boundp 'interval)
 194           (insert "(setq gnus-offline-interval-time "
 195                   (prin1-to-string interval) ")\n"))
 196
 197     ;; write setting about MIEE.
 198     (when use-miee
 199       (insert "(setq sendmail-to-spool-directory "
 200               (prin1-to-string mail-spool) ")\n")
 201       (insert "(setq news-spool-request-post-directory "
 202               (prin1-to-string news-spool) ")\n")
 203       (insert "(if (not (boundp 'miee-version))
 204     (load \"miee\"))\n")
 205       (insert "(setq message-send-news-function 'gnspool-request-post)\n"))
 206
 207     ;; write setting about nnspool and gnus-agent.
 208     (if (eq news-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-method 'nnspool)
 229       (insert "(add-hook '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 mail-source.el
 236     (insert "(setq gnus-offline-mail-source '"
 237             (prin1-to-string mail-source) ")\n")
 238     (insert "(setq nnmail-spool-file gnus-offline-mail-source)\n")
 239     (insert "(require 'read-passwd)\n")
 240     (insert "(setq mail-source-read-passwd 'read-pw-read-passwd)\n")
 241     (insert "(add-hook 'gnus-setup-news-hook 'read-pw-set-mail-source-passwd-cache)\n")
 242     (if save-passwd
 243         (insert "(add-hook 'gnus-setup-news-hook
 244           (lambda ()
 245             (add-to-list 'gnus-variable-list 'mail-source-password-cache)))\n"))
 246
 247     ;;
 248     (write-region (point-min) (point-max) gnus-offline-setting-file))
 249   (kill-buffer "* Setting"))
 250
 251
 252 ;;; Suppport for customizing gnus-ofsetup parameters.
 253
 254 (autoload 'gnus-custom-mode "gnus-cus" nil t)
 255
 256 (defun gnus-ofsetup-find-parameters ()
 257   "Return the each current value of gnus-offline parameters."
 258   `((news-method
 259      (choice :tag "News Method" :value ,gnus-offline-news-fetch-method
 260              (const :tag "Gnus Agent" nnagent)
 261              (const :tag "nnspool"    nnspool)) "\
 262 Method to fetch news articles.")
 263
 264     (dialup-program
 265      (choice :tag "Dialup Program" :value ,gnus-offline-dialup-program
 266              (string :tag "Use Program..")
 267              (const :tag "Don't auto-dial." nil)) "\
 268 Program which does dial.")
 269
 270     (dialup-program-arguments
 271      (repeat :tag "Dialup Program Arguments"
 272              :value ,gnus-offline-dialup-program-arguments
 273              (string :tag "Argument"))"\
 274 Program arguments of gnus-offline-dialup-program.")
 275
 276     (hangup-program
 277      (choice :tag "Hangup Program" :value ,gnus-offline-hangup-program
 278              (string :tag "Use Program..")
 279              (const :tag "Don't auto-hangup." nil)) "\
 280 Program which does hangup.")
 281
 282     (hangup-program-arguments
 283      (repeat :tag "Hangup Program Arguments"
 284              :value ,gnus-offline-hangup-program-arguments
 285              (string :tag "Argument")) "\
 286 Program arguments of gnus-offline-hangup-program.")
 287
 288     (interval
 289      (integer :tag "Interval between Jobs"
 290               :value ,gnus-offline-interval-time) "\
 291 Interval time(minutes) to do online jobs.
 292 If set to 0 , timer call is disabled.")
 293
 294     (drafts-queue-type
 295      (choice :tag "Drafts Queue Type" :value ,gnus-offline-drafts-queue-type
 296              (const :tag "Gnus Draft for queuing."    agent)
 297              (const :tag "I prefer MIEE for queuing." miee)) "\
 298 Type of queue used for draft messages.
 299
 300 If the select method for news is nnspool, you must choose MIEE.
 301 MIEE is another library for offline messaging. It isn't part of
 302 Semi-gnus. If you want to know about MIEE, see README-offline.{en,ja}.")
 303
 304     (mail-spool
 305      (directory :tag "Mail Spool Directory for MIEE"
 306                 :value ,(cond ((and (boundp 'sendmail-to-spool-directory)
 307                                     sendmail-to-spool-directory)
 308                                sendmail-to-spool-directory)
 309                               (t "/usr/spool/mail.out"))))
 310
 311     (news-spool
 312      (directory :tag "News Spool Directory for MIEE"
 313                 :value ,(cond ((and (boundp 'news-spool-request-post-directory)
 314                                     news-spool-request-post-directory)
 315                                news-spool-request-post-directory)
 316                               (t "/usr/spool/news.out"))))
 317
 318     (MTA-type
 319      (choice :tag "MTA Type" :value ,gnus-offline-MTA-type
 320              (const :tag "Use smtp.el"  smtp)
 321              (const :tag "Use sendmail" sendmail)) "\
 322 Type of MTA used for sending mail.")
 323
 324     (save-passwd
 325      (choice :tag "Save Password in Startup File"
 326              :value ,(if (memq 'mail-source-password-cache gnus-variable-list)
 327                          t
 328                          nil)
 329              (const :tag "OK, I'm sure it's safe."     t)
 330              (const :tag "No way, it's too dangerous!" nil)) "\
 331 Whether you want your POP passwords written in .newsrc.eld or not.")
 332
 333     (mail-source
 334      (sexp :tag "Mail Sources" :value ,gnus-offline-mail-source) "\
 335 Information of mail sources. Actually, a list of `Mail Source Specifiers'.
 336
 337 The format of this variable is just the same as `mail-sources' (or
 338 `nnmail-spool-file' which seems obsolete).
 339
 340 `Mail Source Specifiers' can take a lot of keywords. For example,
 341 if you want to use movemail instead of pop3.el which comes with
 342 Gnus, you can set a specifier using the kerword :program as shown
 343 below:
 344
 345           (pop :program \"movemail -pf po:%u %t %p\")
 346
 347 If you want to know more about mail source specifiers and keywords,
 348 click the button below.")))
 349
 350 (defun gnus-ofsetup-customize ()
 351   "Edit the gnus-offline parameters."
 352   (interactive)
 353   (let* ((params (gnus-ofsetup-find-parameters))
 354          (types (mapcar (lambda (entry)
 355                          `(cons :format "%v%h\n"
 356                                 :doc ,(nth 2 entry)
 357                                 (const :format "" ,(nth 0 entry))
 358                                 ,(nth 1 entry)))
 359                         params)))
 360   (kill-buffer (gnus-get-buffer-create "*Gnus Offline Customize*"))
 361   (switch-to-buffer (gnus-get-buffer-create "*Gnus Offline Customize*"))
 362   (gnus-custom-mode)
 363   (widget-insert "Customize the Gnus Offline Parameters, and press ")
 364   (widget-create 'push-button
 365                    :tag "done"
 366                    :help-echo "Push me when done customizing."
 367                    :action 'gnus-ofsetup-customize-done)
 368   (widget-insert "\n\n")
 369   (make-local-variable 'gnus-ofsetup-params)
 370   (setq gnus-ofsetup-params
 371         (widget-create 'group
 372                        `(set :inline t
 373                              :greedy t
 374                              :tag "Parameters"
 375                              :format "%t:\n%h%v"
 376                              :doc "\
 377 These parameters will be saved in ~/.gnus-offline.el.
 378
 379 Note: Touching these parameters may require Gnus or even Emacs to be
 380 restarted."
 381                              ,@types)))
 382
 383   (widget-create 'info-link
 384                  :help-echo "Push me to learn more."
 385                  :tag "<Info> mail sources"
 386                  "(gnus)Mail Sources")
 387
 388   (use-local-map widget-keymap)
 389   (local-set-key "q" 'bury-buffer)
 390   (widget-setup)
 391   (goto-char (point-min))))
 392
 393 (defun gnus-ofsetup-customize-done (&rest ignore)
 394   "Apply changes and bury the buffer."
 395   (interactive)
 396   (let ((params (widget-value gnus-ofsetup-params))
 397         (news-method gnus-offline-news-fetch-method)
 398         (mail-method gnus-offline-mail-fetch-method)
 399         (agent-directory gnus-agent-directory)
 400         (dialup-program gnus-offline-dialup-program)
 401         (dialup-program-arguments gnus-offline-dialup-program-arguments)
 402         (hangup-program gnus-offline-hangup-program)
 403         (hangup-program-arguments gnus-offline-hangup-program-arguments)
 404         (drafts-queue-type gnus-offline-drafts-queue-type)
 405         (interval gnus-offline-interval-time)
 406         (use-miee (and (boundp 'miee-version)
 407                        (or (eq gnus-offline-news-fetch-method 'nnspool)
 408                            (eq gnus-offline-drafts-queue-type 'miee))))
 409         (mail-spool (or (and (boundp 'sendmail-to-spool-directory)
 410                              sendmail-to-spool-directory)
 411                         "/usr/spool/mail.out"))
 412         (news-spool (or (and (boundp 'news-spool-request-post-directory)
 413                              news-spool-request-post-directory)
 414                         "/usr/spool/news.out"))
 415         (MTA-type gnus-offline-MTA-type)
 416         (mail-source gnus-offline-mail-source)
 417         (save-passwd (and (memq 'mail-source-password-cache gnus-variable-list)
 418                           t)))
 419     (if (null params)
 420         (gnus-message 4 "(No changes need to be saved)")
 421       (mapcar (lambda (el)
 422                 (let ((sym (car el))
 423                       (val (cdr el)))
 424                   (set sym val)
 425                   (cond ((eq sym 'news-method)
 426                          (if (eq val 'nnspool)
 427                              (setq use-miee t)))
 428                         ((eq sym 'drafts-queue-type)
 429                          (setq use-miee
 430                                (if (eq val 'miee) t nil)))
 431                         ((eq sym 'save-passwd)
 432                          (if val
 433                              (add-to-list 'gnus-variable-list
 434                                           'mail-source-password-cache)
 435                            (setq gnus-variable-list
 436                                  (delq 'mail-source-password-cache
 437                                        gnus-variable-list)))))))
 438               params)
 439       (if (and (eq news-method 'nnspool)
 440                (not (eq drafts-queue-type 'miee)))
 441           (error "Invalid parameters. Check the news method and drafts queue type."))
 442       (if use-miee
 443           (gnus-ofsetup-prepare-for-miee))
 444       (gnus-ofsetup-update-setting-file)
 445       (load gnus-offline-setting-file)))
 446   (bury-buffer)
 447   (switch-to-buffer gnus-group-buffer))
 448
 449 ;; gnus-ofsetup.el Ends here.