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.5 1999-08-27 16:57:12 czkmt Exp $
   4 ;;;
   5 ;;; Copyright (C) 1998 Tatsuya Ichikawa
   6 ;;; Author: Tatsuya Ichikawa <t-ichi@po.shiojiri.ne.jp>
   7 ;;;      Tsukamoto Tetsuo <czkmt@remus.dti.ne.jp>
   8 ;;;
   9 ;;; This file is part of Semi-gnus.
  10 ;;;
  11 ;;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;;; it under the terms of the GNU General Public License as published by
  13 ;;; the Free Software Foundation; either version 2, or (at your option)
  14 ;;; any later version.
  15
  16 ;;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  19 ;;; GNU General Public License for more details.
  20
  21 ;;; You should have received a copy of the GNU General Public License
  22 ;;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;;; Boston, MA 02111-1307, USA.
  25 ;;;
  26 ;;;; Commentary:
  27 ;;; How to use.
  28 ;;;
  29 ;;;      M-x load[RET]gnus-ofsetup
  30 ;;;      M-x gnus-setup-for-offline
  31 ;;;
  32
  33 ;;; Code:
  34
  35 (eval-when-compile
  36   (require 'gnus-offline))
  37
  38 (defvar gnus-offline-setting-file
  39   (let ((user (user-login-name))
  40         (real-user (user-real-login-name)))
  41     (if (string= user real-user)
  42         "~/.gnus-offline.el"
  43       ;; Seems it is after "su".
  44       (let ((file (concat "~" user "/.gnus-offline.el"))
  45             (real-file (concat "~" real-user "/.gnus-offline.el")))
  46         (cond ((file-exists-p real-file)
  47                real-file)
  48               ((file-exists-p file)
  49                file)
  50               (t
  51                real-file))))))
  52
  53 (eval-when-compile
  54   (defvar gnus-ofsetup-prepare-for-miee
  55     '(;; Spool directory setting - MIEE.
  56       (setq mail-spool (or mail-spool "/usr/spool/mail.out"))
  57       (setq news-spool (or news-spool "/usr/spool/news.out"))
  58       (condition-case nil
  59           (progn
  60             (if (not (file-exists-p mail-spool))
  61                 (make-directory mail-spool t))
  62             (if (not (file-exists-p news-spool))
  63                 (make-directory news-spool t)))
  64         (error
  65          (error
  66           "%s%s"
  67           "Making directories failed."
  68           "Set mail/news spool directories properly.")))))
  69
  70   (defvar gnus-ofsetup-update-setting-file
  71     '((save-excursion
  72         (set-buffer (get-buffer-create "* Setting"))
  73         (erase-buffer)
  74         (insert ";;\n")
  75         (insert ";; This file is created by gnus-ofsetup.el\n")
  76         (insert ";; Creation date : " (current-time-string) "\n")
  77         (insert ";;\n")
  78
  79         ;; write Basic setting
  80         (insert "(setq gnus-offline-news-fetch-method '"
  81                 (prin1-to-string news-method) ")\n")
  82         (insert "(setq gnus-offline-mail-fetch-method '"
  83                 (prin1-to-string mail-method) ")\n")
  84
  85         ;; write dialup/hangup program and options.
  86         (insert "(setq gnus-offline-dialup-program "
  87                 (prin1-to-string dialup-program) ")\n")
  88         (if (stringp dialup-program)
  89             (insert "(setq gnus-offline-dialup-program-arguments '"
  90                     (prin1-to-string dialup-program-arguments) ")\n"))
  91         (insert "(setq gnus-offline-hangup-program "
  92                 (prin1-to-string hangup-program) ")\n")
  93         (if (stringp hangup-program)
  94             (insert "(setq gnus-offline-hangup-program-arguments '"
  95                     (prin1-to-string hangup-program-arguments) ")\n"))
  96
  97         (if (integerp interval)
  98             (insert "(setq gnus-offline-interval-time "
  99                     (prin1-to-string interval) ")\n"))
 100
 101         ;; write setting about MIEE.
 102         (when use-miee
 103           (insert "(setq sendmail-to-spool-directory "
 104                   (prin1-to-string mail-spool) ")\n")
 105           (insert "(setq news-spool-request-post-directory "
 106                   (prin1-to-string news-spool) ")\n")
 107           (insert "(if (not (boundp 'miee-version))
 108     (load \"miee\"))\n")
 109           (insert "(setq message-send-news-function 'gnspool-request-post)\n"))
 110
 111         ;; write setting about nnspool and gnus-agent.
 112         (if (eq news-method 'nnspool)
 113             (insert "(message-offline-state)\n")
 114           (insert "(setq gnus-agent-directory "
 115                   (prin1-to-string agent-directory) ")\n"))
 116
 117         ;; write setting about queue type -- MIEE or nnagent.
 118         (insert "(setq gnus-offline-drafts-queue-type '"
 119                 (prin1-to-string drafts-queue-type) ")\n")
 120         (insert "(setq gnus-offline-MTA-type '"
 121                 (prin1-to-string MTA-type) ")\n")
 122
 123         ;; Offline setting for gnus-nntp-*
 124         (insert "(setq gnus-nntp-service nil)\n")
 125         (insert "(setq gnus-nntp-server nil)\n")
 126
 127         ;; Write setting about hooks.
 128         (insert (format "%s %s %s\n"
 129                         "(add-hook"
 130                         "'gnus-group-mode-hook"
 131                         "'gnus-offline-processed-by-timer t)"))
 132         (insert (format "%s %s %s\n"
 133                         "(add-hook"
 134                         "'gnus-group-mode-hook"
 135                         "'gnus-offline-error-check t)"))
 136         (insert (format "%s %s %s\n"
 137                         "(add-hook"
 138                         "'gnus-after-getting-new-news-hook"
 139                         "'gnus-offline-after-get-new-news)"))
 140         (insert (format "%s %s %s\n"
 141                         "(add-hook"
 142                         "'gnus-after-getting-news-hook"
 143                         "'gnus-offline-after-get-new-news)"))
 144         (when (eq news-method 'nnspool)
 145           (insert (format "%s %s %s\n"
 146                           "(add-hook"
 147                           "'after-getting-news-hook"
 148                           "'gnus-offline-nnspool-hangup-line)"))
 149           (insert (format "%s %s %s\n"
 150                           "(add-hook"
 151                           "'gnus-before-startup-hook"
 152                           "(lambda () (setq nnmail-spool-file nil)
 153            (setq mail-sources nil)))")))
 154         (insert (format "%s %s %s\n"
 155                         "(add-hook"
 156                         "'message-send-hook"
 157                         "'gnus-offline-message-add-header)"))
 158         (insert "(autoload 'gnus-offline-setup \"gnus-offline\")\n")
 159         (insert "(add-hook 'gnus-load-hook 'gnus-offline-setup)\n")
 160
 161         ;; Write stting about mail-source.el
 162         (insert "(setq gnus-offline-mail-source '"
 163                 (prin1-to-string mail-source) ")\n")
 164         (insert "(setq mail-sources gnus-offline-mail-source)\n")
 165         (insert "(require 'read-passwd)\n")
 166         (insert "(setq mail-source-read-passwd 'read-pw-read-passwd)\n")
 167         (insert (format "%s %s %s\n"
 168                         "(add-hook"
 169                         "'gnus-setup-news-hook"
 170                         "'read-pw-set-mail-source-passwd-cache)"))
 171         (if save-passwd
 172             (insert "(add-hook 'gnus-setup-news-hook
 173           (lambda ()
 174             (add-to-list 'gnus-variable-list 'mail-source-password-cache)))\n"))
 175
 176         ;;
 177         (write-region (point-min) (point-max) gnus-offline-setting-file))
 178       (kill-buffer "* Setting")))
 179
 180   (defmacro gnus-ofsetup-prepare (list)
 181     (let ((forms (symbol-value list)))
 182       `(progn ,@forms))))
 183
 184 (defun gnus-ofsetup-completing-read-symbol (msg &rest syms)
 185   (intern
 186    (completing-read (concat msg " (TAB to completion): ")
 187                     (mapcar
 188                      (lambda (sym)
 189                        (list (symbol-name sym)))
 190                      syms)
 191                     nil t nil)))
 192
 193 (defun gnus-setup-for-offline ()
 194   "*Set up Gnus for offline environment."
 195   (interactive)
 196   (unless (file-exists-p gnus-offline-setting-file)
 197     (let (news-method
 198           mail-method agent-directory drafts-queue-type news-spool mail-spool
 199           use-miee MTA-type dialup-program dialup-program-arguments
 200           hangup-program hangup-program-arguments interval
 201           num-of-address i mail-source save-passwd)
 202       (setq news-method
 203             (gnus-ofsetup-completing-read-symbol
 204              "Method for offline News reading"
 205              'nnagent 'nnspool))
 206       ;; Setting for gnus-agent.
 207       (if (eq news-method 'nnagent)
 208           (setq agent-directory
 209                 (read-from-minibuffer "Agent directory: " "~/News/agent")))
 210       (setq mail-method 'nnmail)
 211       (setq dialup-program
 212             (read-file-name
 213              "Dialup program (give a null string if you do not use): "
 214              nil nil t))
 215       (if (string-match "^[ \t]*$" dialup-program)
 216           (setq dialup-program nil)
 217         (setq dialup-program-arguments
 218               (delete "" (split-string
 219                           (read-from-minibuffer "Dialup program options: ")
 220                           "[\t ]+"))))
 221       (setq hangup-program
 222             (read-file-name
 223              "Hangup program (give a null string if you do not use): "
 224              nil nil t))
 225       (if (string-match "^[ \t]*$" hangup-program)
 226           (setq hangup-program nil)
 227         (setq hangup-program-arguments
 228               (delete "" (split-string
 229                           (read-from-minibuffer "Hangup program options: ")
 230                           "[\t ]+"))))
 231       (setq MTA-type (gnus-ofsetup-completing-read-symbol
 232                       "Select MTA type for sending mail"
 233                       'smtp 'sendmail))
 234       (if (eq news-method 'nnspool)
 235           (setq use-miee t)
 236         (setq use-miee (y-or-n-p "Use MIEE post/send message ")))
 237       (if use-miee
 238           (progn
 239             ;; Setting for MIEE.
 240             (setq news-spool
 241                   (read-from-minibuffer
 242                    "News spool directory for sending: "
 243                    "/usr/spool/news.out"))
 244             (setq mail-spool
 245                   (read-from-minibuffer
 246                    "Mail spool directory for sending: "
 247                    "/usr/spool/mail.out"))
 248             (setq drafts-queue-type 'miee)
 249             (gnus-ofsetup-prepare gnus-ofsetup-prepare-for-miee))
 250         ;; Set drafts type gnus-agent.
 251         (setq drafts-queue-type 'agent))
 252       ;; Set E-Mail Address and pop3 movemail type.
 253       (setq num-of-address
 254             (read-from-minibuffer "How many e-mail address do you have: "))
 255       (setq i (string-to-int num-of-address))
 256       (while (> i 0)
 257         (let ((user (read-from-minibuffer "Mail Account name : "))
 258               (server (read-from-minibuffer "Mail server : "))
 259               (auth (completing-read
 260                      "Authentification Method (TAB to completion): "
 261                      '(("password") ("apop")) nil t nil))
 262               (islisp (y-or-n-p "Do you use pop3.el to fetch mail? "))
 263               source)
 264           (if (not islisp)
 265               (let ((prog (read-file-name "movemail program name: "
 266                                           exec-directory "movemail"))
 267                     (args (read-from-minibuffer "movemail options: "
 268                                                 "-pf")))
 269                 (setq source `(pop
 270                                :user ,user
 271                                :server ,server
 272                                :program ,(format "%s %s %s %s %s"
 273                                                  prog
 274                                                  args
 275                                                  "po:%u"
 276                                                  "%t"
 277                                                  "%p"))))
 278             (setq source `(pop
 279                            :user ,user
 280                            :server ,server)))
 281           (setq mail-source
 282                 (nconc mail-source
 283                        (list
 284                         (if (string-equal "apop" auth)
 285                             (nconc source '(:authentication apop))
 286                           source)))))
 287         (setq i (1- i)))
 288       (setq save-passwd
 289             (y-or-n-p "Do you save password information to newsrc file? "))
 290       ;;
 291       (gnus-ofsetup-prepare gnus-ofsetup-update-setting-file)))
 292   (load gnus-offline-setting-file))
 293
 294 ;; Suppport for customizing gnus-ofsetup parameters.
 295
 296 (defvar sendmail-to-spool-directory)
 297 (defvar news-spool-request-post-directory)
 298
 299 (defun gnus-ofsetup-find-parameters ()
 300   "Return the each current value of gnus-offline parameters."
 301   `((news-method
 302      (choice :tag "News Method" :value ,gnus-offline-news-fetch-method
 303              (const :tag "Gnus Agent" nnagent)
 304              (const :tag "nnspool"    nnspool)) "\
 305 Method to fetch news articles.")
 306
 307     (dialup-program
 308      (choice :tag "Dialup Program" :value ,gnus-offline-dialup-program
 309              (string :tag "Use Program..")
 310              (const :tag "Don't auto-dial." nil)) "\
 311 Program which does dial.")
 312
 313     (dialup-program-arguments
 314      (repeat :tag "Dialup Program Arguments"
 315              :value ,gnus-offline-dialup-program-arguments
 316              (string :tag "Argument"))"\
 317 Program arguments of gnus-offline-dialup-program.")
 318
 319     (hangup-program
 320      (choice :tag "Hangup Program" :value ,gnus-offline-hangup-program
 321              (string :tag "Use Program..")
 322              (const :tag "Don't auto-hangup." nil)) "\
 323 Program which does hangup.")
 324
 325     (hangup-program-arguments
 326      (repeat :tag "Hangup Program Arguments"
 327              :value ,gnus-offline-hangup-program-arguments
 328              (string :tag "Argument")) "\
 329 Program arguments of gnus-offline-hangup-program.")
 330
 331     (interval
 332      (integer :tag "Interval between Jobs"
 333               :value ,gnus-offline-interval-time) "\
 334 Interval time(minutes) to do online jobs.
 335 If set to 0 , timer call is disabled.")
 336
 337     (drafts-queue-type
 338      (choice :tag "Drafts Queue Type" :value ,gnus-offline-drafts-queue-type
 339              (const :tag "Gnus Draft for queuing."    agent)
 340              (const :tag "I prefer MIEE for queuing." miee)) "\
 341 Type of queue used for draft messages.
 342
 343 If the select method for news is nnspool, you must choose MIEE.
 344 MIEE is another library for offline messaging. It isn't part of
 345 Semi-gnus. If you want to know about MIEE, see README-offline.{en,ja}.")
 346
 347     (mail-spool
 348      (directory :tag "Mail Spool Directory for MIEE"
 349                 :value ,(cond ((and (boundp 'sendmail-to-spool-directory)
 350                                     sendmail-to-spool-directory)
 351                                sendmail-to-spool-directory)
 352                               (t
 353                                "/usr/spool/mail.out"))))
 354
 355     (news-spool
 356      (directory :tag "News Spool Directory for MIEE"
 357                 :value ,(cond ((and (boundp 'news-spool-request-post-directory)
 358                                     news-spool-request-post-directory)
 359                                news-spool-request-post-directory)
 360                               (t
 361                                "/usr/spool/news.out"))))
 362
 363     (MTA-type
 364      (choice :tag "MTA Type" :value ,gnus-offline-MTA-type
 365              (const :tag "Use smtp.el"  smtp)
 366              (const :tag "Use sendmail" sendmail)) "\
 367 Type of MTA used for sending mail.")
 368
 369     (save-passwd
 370      (choice :tag "Save Password in Startup File"
 371              :value ,(if (memq 'mail-source-password-cache gnus-variable-list)
 372                          t
 373                          nil)
 374              (const :tag "OK, I'm sure it's safe."     t)
 375              (const :tag "No way, it's too dangerous!" nil)) "\
 376 Whether you want your POP passwords written in .newsrc.eld or not.")
 377
 378     (mail-source
 379      (sexp :tag "Mail Sources" :value ,gnus-offline-mail-source) "\
 380 Information of mail sources. Actually, a list of `Mail Source Specifiers'.
 381
 382 The format of this variable is just the same as `mail-sources' (or
 383 `nnmail-spool-file' which seems obsolete).
 384
 385 `Mail Source Specifiers' can take a lot of keywords. For example,
 386 if you want to use movemail instead of pop3.el which comes with
 387 Gnus, you can set a specifier using the kerword :program as shown
 388 below:
 389
 390           (pop :program \"movemail -pf po:%u %t %p\")
 391
 392 If you want to know more about mail source specifiers and keywords,
 393 click the button below.")))
 394
 395 (defvar gnus-ofsetup-params)
 396
 397 (eval-and-compile
 398   (autoload 'gnus-custom-mode "gnus-cus"))
 399
 400 (defun gnus-ofsetup-customize ()
 401   "Edit the gnus-offline parameters."
 402   (interactive)
 403   (let* ((params (gnus-ofsetup-find-parameters))
 404          (types (mapcar (lambda (entry)
 405                          `(cons :format "%v%h\n"
 406                                 :doc ,(nth 2 entry)
 407                                 (const :format "" ,(nth 0 entry))
 408                                 ,(nth 1 entry)))
 409                         params)))
 410   (kill-buffer (gnus-get-buffer-create "*Gnus Offline Customize*"))
 411   (switch-to-buffer (gnus-get-buffer-create "*Gnus Offline Customize*"))
 412   (gnus-custom-mode)
 413   (widget-insert "Customize the Gnus Offline Parameters, and press ")
 414   (widget-create 'push-button
 415                    :tag "done"
 416                    :help-echo "Push me when done customizing."
 417                    :action 'gnus-ofsetup-customize-done)
 418   (widget-insert "\n\n")
 419   (make-local-variable 'gnus-ofsetup-params)
 420   (setq gnus-ofsetup-params
 421         (widget-create 'group
 422                        `(set :inline t
 423                              :greedy t
 424                              :tag "Parameters"
 425                              :format "%t:\n%h%v"
 426                              :doc "\
 427 These parameters will be saved in ~/.gnus-offline.el.
 428
 429 Note: Touching these parameters may require Gnus or even Emacs to be
 430 restarted."
 431                              ,@types)))
 432
 433   (widget-create 'info-link
 434                  :help-echo "Push me to learn more."
 435                  :tag "<Info> mail sources"
 436                  "(gnus)Mail Sources")
 437
 438   (use-local-map widget-keymap)
 439   (local-set-key "q" 'bury-buffer)
 440   (widget-setup)
 441   (goto-char (point-min))))
 442
 443 (defun gnus-ofsetup-customize-done (&rest ignore)
 444   "Apply changes and bury the buffer."
 445   (interactive)
 446   (let ((params (widget-value gnus-ofsetup-params))
 447         (news-method gnus-offline-news-fetch-method)
 448         (mail-method gnus-offline-mail-fetch-method)
 449         (agent-directory gnus-agent-directory)
 450         (dialup-program gnus-offline-dialup-program)
 451         (dialup-program-arguments gnus-offline-dialup-program-arguments)
 452         (hangup-program gnus-offline-hangup-program)
 453         (hangup-program-arguments gnus-offline-hangup-program-arguments)
 454         (drafts-queue-type gnus-offline-drafts-queue-type)
 455         (interval gnus-offline-interval-time)
 456         (use-miee (and (boundp 'miee-version)
 457                        (or (eq gnus-offline-news-fetch-method 'nnspool)
 458                            (eq gnus-offline-drafts-queue-type 'miee))))
 459         (mail-spool (or (and (boundp 'sendmail-to-spool-directory)
 460                              sendmail-to-spool-directory)
 461                         "/usr/spool/mail.out"))
 462         (news-spool (or (and (boundp 'news-spool-request-post-directory)
 463                              news-spool-request-post-directory)
 464                         "/usr/spool/news.out"))
 465         (MTA-type gnus-offline-MTA-type)
 466         (mail-source gnus-offline-mail-source)
 467         (save-passwd (and (memq 'mail-source-password-cache gnus-variable-list)
 468                           t)))
 469     (if (null params)
 470         (gnus-message 4 "(No changes need to be saved)")
 471       (mapcar (lambda (el)
 472                 (let ((sym (car el))
 473                       (val (cdr el)))
 474                   (set sym val)
 475                   (cond ((eq sym 'news-method)
 476                          (if (eq val 'nnspool)
 477                              (setq use-miee t)))
 478                         ((eq sym 'drafts-queue-type)
 479                          (setq use-miee
 480                                (if (eq val 'miee) t nil)))
 481                         ((eq sym 'save-passwd)
 482                          (if val
 483                              (add-to-list 'gnus-variable-list
 484                                           'mail-source-password-cache)
 485                            (setq gnus-variable-list
 486                                  (delq 'mail-source-password-cache
 487                                        gnus-variable-list)))))))
 488               params)
 489       (if (and (eq news-method 'nnspool)
 490                (not (eq drafts-queue-type 'miee)))
 491           (error
 492            "Invalid parameters. Check the news method and drafts queue type."))
 493       (if use-miee
 494           (gnus-ofsetup-prepare gnus-ofsetup-prepare-for-miee))
 495       (gnus-ofsetup-prepare gnus-ofsetup-update-setting-file)
 496       (load gnus-offline-setting-file)))
 497   (bury-buffer)
 498   (switch-to-buffer gnus-group-buffer))
 499
 500 ;; gnus-ofsetup.el Ends here.