wl/wl.el

   1 ;;; wl.el -- Wanderlust bootstrap.
   2
   3 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
   4 ;; Copyright (C) 1998,1999,2000 Masahiro MURATA <muse@ba2.so-net.ne.jp>
   5
   6 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
   7 ;;      Masahiro MURATA <muse@ba2.so-net.ne.jp>
   8 ;; Keywords: mail, net news
   9
  10 ;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen).
  11
  12 ;; This program is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16 ;;
  17 ;; This program is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21 ;;
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26 ;;
  27
  28 ;;; Commentary:
  29 ;;
  30
  31 ;;; Code:
  32 ;;
  33
  34 (require 'elmo)
  35 (require 'wl-version)                   ; reduce recursive-load-depth
  36
  37 ;; from x-face.el
  38 (unless (and (fboundp 'defgroup)
  39              (fboundp 'defcustom))
  40   (require 'backquote)
  41   (defmacro defgroup (&rest args))
  42   (defmacro defcustom (symbol value &optional doc &rest args)
  43     (let ((doc (concat "*" (or doc ""))))
  44       (` (defvar (, symbol) (, value) (, doc))))))
  45
  46 (require 'wl-vars)
  47 (require 'wl-util)
  48
  49 (cond (wl-on-xemacs
  50        (require 'wl-xmas))
  51       (wl-on-emacs21
  52        (require 'wl-e21))
  53       (wl-on-nemacs
  54        (require 'wl-nemacs))
  55       (t
  56        (require 'wl-mule)))
  57
  58 (provide 'wl)                           ; circular dependency
  59 (require 'wl-folder)
  60 (require 'wl-summary)
  61 (require 'wl-thread)
  62 (require 'wl-address)
  63
  64 (wl-draft-mode-setup)
  65 (require 'wl-draft)
  66 (wl-draft-key-setup)
  67
  68 (require 'wl-demo)
  69 (require 'wl-highlight)
  70
  71 (eval-when-compile
  72   (require 'cl)
  73   (require 'smtp)
  74   (require 'wl-score)
  75   (unless wl-on-nemacs
  76     (require 'wl-fldmgr))
  77   (if wl-use-semi
  78       (require 'wl-mime)
  79     (require 'tm-wl)))
  80
  81 (defun wl-plugged-init (&optional make-alist)
  82   (setq elmo-plugged wl-plugged)
  83   (if wl-reset-plugged-alist
  84       (elmo-set-plugged elmo-plugged))
  85   (when make-alist
  86     (wl-make-plugged-alist))
  87   ;; Plug status.
  88   (setq elmo-plugged (setq wl-plugged (elmo-plugged-p))
  89         wl-modeline-plug-status wl-plugged)
  90   (if wl-plugged
  91       (wl-toggle-plugged t 'flush)))
  92
  93 (defun wl-toggle-plugged (&optional arg queue-flush-only)
  94   (interactive)
  95   (elmo-quit) ; Disconnect current connection.
  96   (unless queue-flush-only
  97     (cond
  98      ((eq arg 'on)
  99       (setq wl-plugged t))
 100      ((eq arg 'off)
 101       (setq wl-plugged nil))
 102      (t (setq wl-plugged (null wl-plugged))))
 103     (elmo-set-plugged wl-plugged))
 104   (setq elmo-plugged wl-plugged
 105         wl-modeline-plug-status wl-plugged)
 106   (save-excursion
 107     (let ((summaries (wl-collect-summary)))
 108       (while summaries
 109         (set-buffer (pop summaries))
 110         (elmo-folder-commit wl-summary-buffer-elmo-folder)
 111         (wl-summary-set-message-modified))))
 112   (setq wl-biff-check-folders-running nil)
 113   (if wl-plugged
 114       (progn
 115         ;; flush queue!!
 116         (elmo-dop-queue-flush)
 117         (unless queue-flush-only (wl-biff-start))
 118         (if (and wl-draft-enable-queuing
 119                  wl-auto-flush-queue)
 120             (wl-draft-queue-flush))
 121 ;;      (when (and (eq major-mode 'wl-summary-mode)
 122 ;;                 (elmo-folder-plugged-p wl-summary-buffer-elmo-folder))
 123 ;;        (let* ((msgdb-dir (elmo-folder-msgdb-path
 124 ;;                           wl-summary-buffer-elmo-folder))
 125 ;;               (seen-list (elmo-msgdb-seen-load msgdb-dir)))
 126 ;;       (setq seen-list
 127 ;;                (wl-summary-flush-pending-append-operations seen-list))
 128 ;;          (elmo-msgdb-seen-save msgdb-dir seen-list)))
 129         (run-hooks 'wl-plugged-hook))
 130     (wl-biff-stop)
 131     (run-hooks 'wl-unplugged-hook))
 132   (force-mode-line-update t))
 133
 134 ;;; wl-plugged-mode
 135
 136 (defvar wl-plugged-port-label-alist
 137   (list (cons 119 "nntp")
 138         (cons 143 "imap4")
 139         (cons 110 "pop3")))
 140         ;;(cons elmo-pop-before-smtp-port "pop3")
 141
 142 (defconst wl-plugged-switch-variables
 143   '(("Queuing" . wl-draft-enable-queuing)
 144     ("AutoFlushQueue" . wl-auto-flush-queue)
 145     ("DisconnectedOperation" . elmo-enable-disconnected-operation)))
 146
 147 (defvar wl-plugged-buf-name "Plugged")
 148 (defvar wl-plugged-mode-map nil)
 149 (defvar wl-plugged-alist nil)
 150 (defvar wl-plugged-switch nil)
 151 (defvar wl-plugged-winconf nil)
 152 (defvar wl-plugged-sending-queue-alist nil)
 153 (defvar wl-plugged-dop-queue-alist nil)
 154 (defvar wl-plugged-alist-modified nil)
 155
 156 (defvar wl-plugged-mode-menu-spec
 157   '("Plugged"
 158     ["Toggle plugged" wl-plugged-toggle t]
 159     ["Toggle All plugged" wl-plugged-toggle-all t]
 160     ["Prev Port"      wl-plugged-move-to-previous t]
 161     ["Next Port"      wl-plugged-move-to-next t]
 162     ["Prev Server"    wl-plugged-move-to-previous-server t]
 163     ["Next Server"    wl-plugged-move-to-next-server t]
 164     ["Flush queue"    wl-plugged-flush-queue t]
 165     "----"
 166     ["Exit"           wl-plugged-exit t]))
 167
 168 (eval-and-compile
 169   (if wl-on-xemacs
 170       (defun wl-plugged-setup-mouse ()
 171         (define-key wl-plugged-mode-map 'button2 'wl-plugged-click))
 172     (if wl-on-nemacs
 173         (defun wl-plugged-setup-mouse ())
 174       (defun wl-plugged-setup-mouse ()
 175         (define-key wl-plugged-mode-map [mouse-2] 'wl-plugged-click)))))
 176
 177 (unless wl-plugged-mode-map
 178   (setq wl-plugged-mode-map (make-sparse-keymap))
 179   (define-key wl-plugged-mode-map " "    'wl-plugged-toggle)
 180   (define-key wl-plugged-mode-map "\C-m" 'wl-plugged-toggle)
 181   (define-key wl-plugged-mode-map "\M-t" 'wl-plugged-toggle-all)
 182   (define-key wl-plugged-mode-map "q"    'wl-plugged-exit)
 183   (define-key wl-plugged-mode-map "\C-t" 'wl-plugged-exit)
 184   (define-key wl-plugged-mode-map "F"    'wl-plugged-flush-queue)
 185   (define-key wl-plugged-mode-map "P"    'wl-plugged-move-to-previous-server)
 186   (define-key wl-plugged-mode-map "N"    'wl-plugged-move-to-next-server)
 187   (define-key wl-plugged-mode-map "p"    'wl-plugged-move-to-previous)
 188   (define-key wl-plugged-mode-map "n"    'wl-plugged-move-to-next)
 189   (define-key wl-plugged-mode-map "\e\t" 'wl-plugged-move-to-previous)
 190   (define-key wl-plugged-mode-map "\t"   'wl-plugged-move-to-next)
 191   (wl-plugged-setup-mouse)
 192   (easy-menu-define
 193    wl-plugged-mode-menu
 194    wl-plugged-mode-map
 195    "Menu used in Plugged mode."
 196    wl-plugged-mode-menu-spec))
 197
 198 (defun wl-plugged-mode ()
 199   "Mode for setting Wanderlust plugged.
 200 See info under Wanderlust for full documentation.
 201
 202 Special commands:
 203 \\{wl-plugged-mode-map}
 204
 205 Entering Plugged mode calls the value of `wl-plugged-mode-hook'."
 206   (interactive)
 207   (kill-all-local-variables)
 208   (use-local-map wl-plugged-mode-map)
 209   (setq major-mode 'wl-plugged-mode)
 210   (setq mode-name "Plugged")
 211   (easy-menu-add wl-plugged-mode-menu)
 212   (wl-mode-line-buffer-identification)
 213   (setq wl-plugged-switch wl-plugged)
 214   (setq wl-plugged-alist-modified nil)
 215   (setq buffer-read-only t)
 216   (run-hooks 'wl-plugged-mode-hook))
 217
 218 (defmacro wl-plugged-string (plugged &optional time)
 219   (` (if (, time) wl-plugged-auto-off
 220        (if (, plugged) wl-plugged-plug-on wl-plugged-plug-off))))
 221
 222 (defmacro wl-plugged-server-indent ()
 223   (` (make-string wl-plugged-server-indent ? )))
 224
 225 (defun wl-plugged-set-variables ()
 226   (setq wl-plugged-sending-queue-alist
 227         (wl-plugged-sending-queue-info))
 228   (setq wl-plugged-dop-queue-alist
 229         (wl-plugged-dop-queue-info))
 230   (setq wl-plugged-alist
 231         (sort (copy-sequence elmo-plugged-alist)
 232               '(lambda (a b)
 233                  (string< (caar a) (caar b))))))
 234
 235 (defun wl-plugged-sending-queue-info ()
 236   ;; sending queue status
 237   (let (alist msgs sent-via server port)
 238     (setq msgs (elmo-folder-list-messages
 239                 (wl-folder-get-elmo-folder wl-queue-folder)))
 240     (while msgs
 241       (setq sent-via (wl-draft-queue-info-operation (car msgs) 'get-sent-via))
 242       (while sent-via
 243         (when (eq (nth 1 (car sent-via)) 'unplugged)
 244           (setq server (car (nth 2 (car sent-via)))
 245                 port (cdr (nth 2 (car sent-via))))
 246           (elmo-plugged-p server port)  ;; add elmo-plugged-alist if nothing.
 247           (setq alist
 248                 (wl-append-assoc-list
 249                  (cons server port)
 250                  (car msgs)
 251                  alist)))
 252         (setq sent-via (cdr sent-via)))
 253       (setq msgs (cdr msgs)))
 254     alist))
 255
 256 (defun wl-plugged-sending-queue-status (qinfo)
 257   ;; sending queue status
 258   (let ((len (length (cdr qinfo))))
 259     (concat (wl-plugged-set-folder-icon
 260              wl-queue-folder
 261              (wl-folder-get-petname wl-queue-folder))
 262             (if (> len 1)
 263                 (format ": %d msgs (" len)
 264               (format ": %d msg (" len))
 265             (mapconcat (function int-to-string) (cdr qinfo) ",")
 266             ")")))
 267
 268 (defun wl-plugged-dop-queue-info ()
 269   ;; dop queue status
 270   (let* ((count 0)
 271          (elmo-dop-queue (copy-sequence elmo-dop-queue))
 272          dop-queue last alist server-info
 273          ope operation)
 274     ;(elmo-dop-queue-load)
 275     (elmo-dop-queue-merge)
 276     (setq dop-queue (sort elmo-dop-queue '(lambda (a b)
 277                                             (string< (elmo-dop-queue-fname a)
 278                                                      (elmo-dop-queue-fname b)))))
 279     (wl-append dop-queue (list nil)) ;; terminate(dummy)
 280     (when (car dop-queue)
 281       (setq last (elmo-dop-queue-fname (car dop-queue)))) ;; first
 282     (while dop-queue
 283       (when (car dop-queue)
 284         (setq ope (cons (elmo-dop-queue-method (car dop-queue))
 285                         (length
 286                          (if (listp
 287                               (car
 288                                (elmo-dop-queue-arguments (car dop-queue))))
 289                              (car (elmo-dop-queue-arguments
 290                                    (car dop-queue))))))))
 291       (if (and (car dop-queue)
 292                (string= last (elmo-dop-queue-fname (car dop-queue))))
 293           (wl-append operation (list ope))
 294         ;;(setq count (1+ count))
 295         (when (and last (setq server-info (elmo-net-port-info
 296                                            (wl-folder-get-elmo-folder last))))
 297           (setq alist
 298                 (wl-append-assoc-list
 299                  (cons (car server-info) (nth 1 server-info)) ;; server port
 300                  (cons last operation)
 301                  alist)))
 302         (when (car dop-queue)
 303           (setq last (elmo-dop-queue-fname (car dop-queue))
 304                 operation (list ope))))
 305       (setq dop-queue (cdr dop-queue)))
 306     alist))
 307
 308 (defun wl-plugged-dop-queue-status (qinfo &optional column)
 309   ;; dop queue status
 310   (let ((operations (cdr qinfo))
 311         (column (or column wl-plugged-queue-status-column)))
 312     (mapconcat
 313      '(lambda (folder-ope)
 314         (concat (wl-plugged-set-folder-icon
 315                  (car folder-ope)
 316                  (wl-folder-get-petname (car folder-ope)))
 317                 "("
 318                 (mapconcat
 319                  '(lambda (ope)
 320                     (if (> (cdr ope) 0)
 321                         (format "%s:%d" (car ope) (cdr ope))
 322                       (format "%s" (car ope))))
 323                  (cdr folder-ope) ",")
 324                 ")"))
 325      operations
 326      (concat "\n" (wl-set-string-width column "")))))
 327
 328 (defun wl-plugged-drawing (plugged-alist)
 329   (let ((buffer-read-only nil)
 330         (alist plugged-alist)
 331         (vars wl-plugged-switch-variables)
 332         last server port label plugged time
 333         line len qinfo column)
 334     (erase-buffer)
 335     (while vars
 336       (insert (format "%s:[%s]%s"
 337                       (caar vars)
 338                       (wl-plugged-string (symbol-value (cdar vars)))
 339                       (if (cdr vars) " " "")))
 340       (setq vars (cdr vars)))
 341     (insert "\n")
 342     (let ((elmo-plugged wl-plugged-switch))
 343       (setq line (format "[%s](wl-plugged)"
 344                          (wl-plugged-string (elmo-plugged-p))))
 345       ;; sending queue status
 346       (when (setq qinfo (assoc (cons nil nil) wl-plugged-sending-queue-alist))
 347         (setq line (concat
 348                     (wl-set-string-width wl-plugged-queue-status-column line)
 349                     (wl-plugged-sending-queue-status qinfo))))
 350       (insert line "\n"))
 351     (while alist
 352       (setq server (nth 0 (caar alist))
 353             port (nth 1 (caar alist))
 354             label (nth 1 (car alist))
 355             plugged (nth 2 (car alist))
 356             time (nth 3 (car alist)))
 357       (unless (string= last server)
 358         ;; server plug
 359         (insert (format "%s[%s]%s\n"
 360                         (wl-plugged-server-indent)
 361                         (wl-plugged-string
 362                          (elmo-plugged-p server nil plugged-alist))
 363                         server))
 364         (setq last server))
 365       ;; port plug
 366       (setq line
 367             (format "%s[%s]%s"
 368                     (make-string wl-plugged-port-indent ? )
 369                     (wl-plugged-string plugged time)
 370                     (cond
 371                      ((stringp port)
 372                       port)
 373                      (t
 374                       (format "%s(%d)"
 375                               (or label
 376                                   (cdr (assq port wl-plugged-port-label-alist))
 377                                   "")
 378                               port)))))
 379       (setq column (max (if line (1+ (string-width line)) 0)
 380                         wl-plugged-queue-status-column))
 381       (cond
 382        ;; sending queue status
 383        ((setq qinfo (assoc (cons server port) wl-plugged-sending-queue-alist))
 384         (setq line
 385               (concat
 386                (wl-set-string-width column line)
 387                (wl-plugged-sending-queue-status qinfo))))
 388        ;; dop queue status
 389        ((setq qinfo (assoc (cons server port) wl-plugged-dop-queue-alist))
 390         (setq line
 391               (concat
 392                (wl-set-string-width column line)
 393                (wl-plugged-dop-queue-status qinfo column)))))
 394       (insert line "\n")
 395       (setq alist (cdr alist)))
 396     (delete-region (1- (point-max)) (point-max)) ;; delete line at the end.
 397     (goto-char (point-min))
 398     (while (not (eobp))
 399       (wl-highlight-plugged-current-line)
 400       (forward-line 1)))
 401   (set-buffer-modified-p nil)
 402   (count-lines (point-min) (point-max)))
 403
 404 (defun wl-plugged-redrawing-switch (indent switch &optional time)
 405   (beginning-of-line)
 406   (when (re-search-forward
 407          (format "^%s\\[\\([^]]+\\)\\]" (make-string indent ? )))
 408     (goto-char (match-beginning 1))
 409     (delete-region (match-beginning 1) (match-end 1))
 410     (insert (wl-plugged-string switch time))
 411     (wl-highlight-plugged-current-line)
 412     (forward-line 1)))
 413
 414 (defun wl-plugged-redrawing (plugged-alist)
 415   (let ((buffer-read-only nil)
 416         (alist plugged-alist)
 417         last server port plugged time)
 418     (goto-char (point-min))
 419     (wl-plugged-redrawing-switch 0 (elmo-plugged-p))
 420     (while alist
 421       (setq server (caaar alist)
 422             port (cdaar alist)
 423             plugged (nth 2 (car alist))
 424             time (nth 3 (car alist)))
 425       (unless (string= last server)
 426         ;; server plug
 427         (wl-plugged-redrawing-switch
 428          wl-plugged-server-indent
 429          (elmo-plugged-p server nil plugged-alist))
 430         (setq last server))
 431       ;; port plug
 432       (wl-plugged-redrawing-switch
 433        wl-plugged-port-indent plugged time)
 434       (setq alist (cdr alist))))
 435   (sit-for 0)
 436   (set-buffer-modified-p nil))
 437
 438 (defun wl-plugged-change ()
 439   (interactive)
 440   (if (not elmo-plugged-alist)
 441       (message "No plugged info")
 442     (setq wl-plugged-winconf (current-window-configuration))
 443     (let* ((cur-win (selected-window))
 444            (max-lines (if (eq major-mode 'wl-summary-mode)
 445                           (/ (frame-height) 2)
 446                         (window-height)))
 447            window-lines lines)
 448       (save-excursion
 449         (set-buffer (get-buffer-create wl-plugged-buf-name))
 450         (wl-plugged-mode)
 451         (buffer-disable-undo (current-buffer))
 452         (delete-windows-on (current-buffer))
 453         (wl-plugged-set-variables)
 454         (setq lines (wl-plugged-drawing wl-plugged-alist)))
 455       (select-window cur-win)
 456       (setq window-lines (min max-lines (max lines window-min-height)))
 457       (when (> (- (window-height) window-lines) window-min-height)
 458         (split-window cur-win (- (window-height) window-lines)))
 459       (switch-to-buffer wl-plugged-buf-name)
 460       (condition-case nil
 461           (progn
 462             (enlarge-window (- window-lines (window-height)))
 463             (when (fboundp 'pos-visible-in-window-p)
 464               (goto-char (point-min))
 465               (while (and (< (window-height) max-lines)
 466                           (not (pos-visible-in-window-p (1- (point-max)))))
 467                 (enlarge-window 2))))
 468         (error))
 469       (goto-char (point-min))
 470       (forward-line 1)
 471       (wl-plugged-move-to-next)))) ;; goto first entry
 472
 473 (defsubst wl-plugged-get-server ()
 474   (save-excursion
 475     (end-of-line)
 476     (wl-plugged-move-to-previous-server)
 477     (beginning-of-line)
 478     (when (looking-at (format "^%s\\[[^]]+\\]\\(.*\\)"
 479                               (wl-plugged-server-indent)))
 480       (elmo-match-buffer 1))))
 481
 482 (defun wl-plugged-toggle ()
 483   (interactive)
 484   (let ((cur-point (point)))
 485     (save-excursion
 486       (beginning-of-line)
 487       (cond
 488        ;; swtich variable
 489        ((bobp)
 490         (let (variable switch name)
 491           (goto-char cur-point)
 492           (when (and (not (bobp))
 493                      (not (eq (char-before) ? )))
 494             (if (re-search-backward " [^ ]+" nil t)
 495                 (forward-char 1)
 496               (re-search-backward "^[^ ]+" nil t)))
 497           (when (looking-at "\\([^ :[]+\\):?\\[\\([^]]+\\)\\]")
 498             (setq name (elmo-match-buffer 1))
 499             (setq switch (not (string= (elmo-match-buffer 2) wl-plugged-plug-on)))
 500             (when (setq variable (cdr (assoc name wl-plugged-switch-variables)))
 501               (set variable switch))
 502             (goto-char (match-beginning 2))
 503             (let ((buffer-read-only nil))
 504               (delete-region (match-beginning 2) (match-end 2))
 505               (insert (wl-plugged-string switch))
 506               (set-buffer-modified-p nil)))))
 507        ;; swtich plug
 508        ((looking-at "^\\( *\\)\\[\\([^]]+\\)\\]\\([^ \n]*\\)")
 509         (let* ((indent (length (elmo-match-buffer 1)))
 510                (switch (elmo-match-buffer 2))
 511                (name (elmo-match-buffer 3))
 512                (plugged (not (string= switch wl-plugged-plug-on)))
 513                (alist wl-plugged-alist)
 514                server port stream-type name-1)
 515           (cond
 516            ((eq indent wl-plugged-port-indent)  ;; toggle port plug
 517             (cond
 518              ((string-match "\\([^([]*\\)(\\([^)[]+\\))" name)
 519               (setq port (string-to-int (elmo-match-string 2 name)))
 520               (if (string-match "!" (setq name-1 (elmo-match-string 1 name)))
 521                   (setq stream-type
 522                         (intern (substring name-1 (match-end 0))))))
 523              (t
 524               (setq port name)))
 525             (setq server (wl-plugged-get-server))
 526             (elmo-set-plugged plugged server port stream-type nil alist))
 527            ((eq indent wl-plugged-server-indent)  ;; toggle server plug
 528             (elmo-set-plugged plugged name nil nil nil alist))
 529            ((eq indent 0)  ;; toggle all plug
 530             (elmo-set-plugged plugged nil nil nil nil alist)))
 531           ;; redraw
 532           (wl-plugged-redrawing wl-plugged-alist)
 533           ;; show plugged status in modeline
 534           (let ((elmo-plugged wl-plugged-switch))
 535             (setq wl-plugged-switch (elmo-plugged-p)
 536                   wl-modeline-plug-status wl-plugged-switch)
 537             (force-mode-line-update t))))))
 538     (setq wl-plugged-alist-modified t)
 539     (goto-char cur-point)))
 540
 541 (defun wl-plugged-click (e)
 542   (interactive "e")
 543   (mouse-set-point e)
 544   (wl-plugged-toggle))
 545
 546 (defun wl-plugged-toggle-all ()
 547   (interactive)
 548   (let ((cur-point (point)))
 549     (setq wl-plugged-switch (not wl-plugged-switch))
 550     (elmo-set-plugged wl-plugged-switch nil nil nil nil wl-plugged-alist)
 551     (wl-plugged-redrawing wl-plugged-alist)
 552     (goto-char cur-point)
 553     (setq wl-plugged-alist-modified t)
 554     ;; show plugged status in modeline
 555     (setq wl-modeline-plug-status wl-plugged-switch)
 556     (force-mode-line-update t)))
 557
 558 (defun wl-plugged-exit ()
 559   (interactive)
 560   (setq ;;elmo-plugged-alist wl-plugged-alist
 561         wl-plugged wl-plugged-switch
 562         wl-plugged-alist nil
 563         wl-plugged-sending-queue-alist nil
 564         wl-plugged-dop-queue-alist nil)
 565   (run-hooks 'wl-plugged-exit-hook)
 566   (when wl-plugged-alist-modified
 567     (wl-toggle-plugged (if wl-plugged 'on 'off) t))
 568   (kill-buffer (current-buffer))
 569   (if wl-plugged-winconf
 570       (set-window-configuration wl-plugged-winconf)))
 571
 572 (defun wl-plugged-flush-queue ()
 573   (interactive)
 574   (let ((cur-point (point))
 575         (dop-status (elmo-dop-queue-flush))
 576         (send-status (wl-draft-queue-flush)))
 577     (unless (or dop-status send-status)
 578       (message "No processing queue."))
 579     (wl-plugged-set-variables)
 580     (wl-plugged-drawing wl-plugged-alist)
 581     (goto-char cur-point)))
 582
 583 (defun wl-plugged-move-to-next ()
 584   (interactive)
 585   (when (re-search-forward "\\[\\([^]]+\\)\\]" nil t)
 586     (let ((pos (match-beginning 1)))
 587       (if (invisible-p pos)
 588           (goto-char (next-visible-point pos))
 589         (goto-char pos)))))
 590
 591 (defun wl-plugged-move-to-previous ()
 592   (interactive)
 593   (if (eq (char-before) ?\]) (forward-char -1))
 594   (when (re-search-backward "\\[\\([^]]+\\)\\]" nil t)
 595     (let ((pos (match-beginning 1)))
 596       (if (invisible-p pos)
 597           (goto-char (next-visible-point pos))
 598         (goto-char pos)))))
 599
 600 (defun wl-plugged-move-to-next-server ()
 601   (interactive)
 602   (let ((regexp
 603          (format "^%s\\[\\([^]]+\\)\\]" (wl-plugged-server-indent)))
 604         point)
 605     (save-excursion
 606       (end-of-line)
 607       (if (re-search-forward regexp nil t)
 608           (setq point (match-beginning 1))))
 609     (if point (goto-char point))))
 610
 611 (defun wl-plugged-move-to-previous-server ()
 612   (interactive)
 613   (let ((regexp
 614          (format "^%s\\[\\([^]]+\\)\\]" (wl-plugged-server-indent))))
 615     (if (re-search-backward regexp nil t)
 616         (goto-char (match-beginning 1)))))
 617
 618 ;;; end of wl-plugged-mode
 619
 620 (defun wl-save ()
 621   "Save summary and folder status."
 622   (interactive)
 623   (wl-save-status 'keep-summary)
 624   (run-hooks 'wl-save-hook))
 625
 626 (defun wl-save-status (&optional keep-summary)
 627   (message "Saving summary and folder status...")
 628   (let (summary-buf)
 629     (save-excursion
 630       (let ((summaries (wl-collect-summary)))
 631         (while summaries
 632           (with-current-buffer (car summaries)
 633             (unless keep-summary
 634               (wl-summary-cleanup-temp-marks))
 635             (wl-summary-save-view keep-summary)
 636             (elmo-folder-commit wl-summary-buffer-elmo-folder)
 637             (unless keep-summary
 638               (kill-buffer (car summaries))))
 639           (setq summaries (cdr summaries))))))
 640   (wl-refile-alist-save)
 641   (wl-folder-info-save)
 642   (and (featurep 'wl-fldmgr) (wl-fldmgr-exit))
 643   (elmo-crosspost-message-alist-save)
 644   (message "Saving summary and folder status...done"))
 645
 646 (defun wl-exit ()
 647   (interactive)
 648   (when (or (not wl-interactive-exit)
 649             (y-or-n-p "Quit Wanderlust? "))
 650     (elmo-quit)
 651     (wl-biff-stop)
 652     (run-hooks 'wl-exit-hook)
 653     (wl-save-status)
 654     (wl-folder-cleanup-variables)
 655     (wl-message-buffer-cache-clean-up)
 656     (wl-kill-buffers
 657      (format "^\\(%s\\)$"
 658              (mapconcat 'identity
 659                         (list wl-folder-buffer-name
 660                               wl-plugged-buf-name)
 661                         "\\|")))
 662     (if (and wl-folder-use-frame
 663              (> (length (visible-frame-list)) 1))
 664         (delete-frame))
 665     (setq wl-init nil)
 666     (unless wl-on-nemacs
 667       (remove-hook 'kill-emacs-hook 'wl-save-status))
 668     t)
 669   (message "") ; empty minibuffer.
 670   )
 671
 672 (defun wl-init ()
 673   (when (not wl-init)
 674     (unless (featurep 'mime-setup)
 675       (require 'mime-setup))
 676     (setq elmo-plugged wl-plugged)
 677     (unless wl-on-nemacs
 678       (add-hook 'kill-emacs-hook 'wl-save-status))
 679     (wl-address-init)
 680     (wl-draft-setup)
 681     (wl-refile-alist-setup)
 682     (if wl-use-semi
 683         (progn
 684           (require 'wl-mime)
 685           (setq elmo-use-semi t))
 686       (require 'tm-wl)
 687       (setq elmo-use-semi nil))
 688     ;; defined above.
 689     (wl-mime-setup)
 690     (fset 'wl-summary-from-func-internal
 691           (symbol-value 'wl-summary-from-function))
 692     (fset 'wl-summary-subject-func-internal
 693           (symbol-value 'wl-summary-subject-function))
 694     (fset 'wl-summary-subject-filter-func-internal
 695           (symbol-value 'wl-summary-subject-filter-function))
 696     (setq elmo-no-from wl-summary-no-from-message)
 697     (setq elmo-no-subject wl-summary-no-subject-message)
 698     (setq wl-init t)
 699     ;; This hook may contain the functions `wl-plugged-init-icons' and
 700     ;; `wl-biff-init-icons' for reasons of system internal to accord
 701     ;; facilities for the Emacs variants.
 702     (run-hooks 'wl-init-hook)))
 703
 704 (defun wl-check-environment (no-check-folder)
 705   (unless wl-from
 706     (error "Please set `wl-from'"))
 707   ;; Message-ID
 708   (unless (string-match "[^.]\\.[^.]" (or wl-message-id-domain
 709                                           (if wl-local-domain
 710                                               (concat (system-name)
 711                                                       "." wl-local-domain)
 712                                             (system-name))))
 713     (error "Please set `wl-local-domain' to get valid FQDN"))
 714   (if (string-match "@" (or wl-message-id-domain
 715                             (if wl-local-domain
 716                                 (concat (system-name)
 717                                         "." wl-local-domain)
 718                               (system-name))))
 719       (error "Please remove `@' from `wl-message-id-domain'"))
 720   (if (string= wl-local-domain "localdomain")
 721       (error "Please set `wl-local-domain'"))
 722   (if (string= wl-message-id-domain "localhost.localdomain")
 723       (error "Please set `wl-message-id-domain'"))
 724   ;; folders
 725   (when (not no-check-folder)
 726     (let ((draft-folder (wl-folder-get-elmo-folder wl-draft-folder))
 727           (queue-folder (wl-folder-get-elmo-folder wl-queue-folder))
 728           (trash-folder (wl-folder-get-elmo-folder wl-trash-folder))
 729           (lost+found-folder (wl-folder-get-elmo-folder
 730                               elmo-lost+found-folder)))
 731       (if (not (elmo-folder-message-file-p draft-folder))
 732           (error "%s is not allowed for draft folder" wl-draft-folder))
 733       (unless (elmo-folder-exists-p draft-folder)
 734         (if (y-or-n-p
 735              (format "Draft Folder %s does not exist, create it? "
 736                      wl-draft-folder))
 737             (elmo-folder-create draft-folder)
 738           (error "Draft Folder is not created")))
 739       (if (and wl-draft-enable-queuing
 740                (not (elmo-folder-exists-p queue-folder)))
 741           (if (y-or-n-p
 742                (format "Queue Folder %s does not exist, create it? "
 743                        wl-queue-folder))
 744               (elmo-folder-create queue-folder)
 745             (error "Queue Folder is not created")))
 746       (when (not (eq no-check-folder 'wl-draft))
 747         (unless (elmo-folder-exists-p trash-folder)
 748           (if (y-or-n-p
 749                (format "Trash Folder %s does not exist, create it? "
 750                        wl-trash-folder))
 751               (elmo-folder-create trash-folder)
 752             (error "Trash Folder is not created")))
 753         (unless (elmo-folder-exists-p lost+found-folder)
 754           (elmo-folder-create lost+found-folder)))
 755       ;; tmp dir
 756       (unless (file-exists-p wl-tmp-dir)
 757         (if (y-or-n-p
 758              (format "Temp directory (to save multipart) %s does not exist, create it now? "
 759                      wl-tmp-dir))
 760             (make-directory wl-tmp-dir)
 761           (error "Temp directory is not created"))))))
 762
 763 ;;;###autoload
 764 (defun wl (&optional arg)
 765   "Start Wanderlust -- Yet Another Message Interface On Emacsen.
 766 If ARG (prefix argument) is specified, folder checkings are skipped."
 767   (interactive "P")
 768   (unless wl-init
 769     (wl-load-profile))
 770   (elmo-init)
 771   (let (demo-buf)
 772     (unless wl-init
 773       (if wl-demo (setq demo-buf (wl-demo))))
 774     (wl-init)
 775     (unless wl-init
 776       (condition-case nil
 777           (progn
 778             (message "Checking environment...")
 779             (wl-check-environment arg)
 780             (message "Checking environment...done"))
 781         (error)
 782         (quit)))
 783     (condition-case obj
 784         (progn
 785           (wl-plugged-init (wl-folder arg))
 786           (unless arg
 787             (run-hooks 'wl-auto-check-folder-pre-hook)
 788             (wl-folder-auto-check)
 789             (run-hooks 'wl-auto-check-folder-hook))
 790           (unless arg (wl-biff-start)))
 791       (error
 792        (if (buffer-live-p demo-buf)
 793            (kill-buffer demo-buf))
 794        (signal (car obj)(cdr obj)))
 795       (quit))
 796     (if (buffer-live-p demo-buf)
 797         (kill-buffer demo-buf)))
 798   (run-hooks 'wl-hook))
 799
 800 ;; Define some autoload functions WL might use.
 801 (eval-and-compile
 802   ;; This little mapcar goes through the list below and marks the
 803   ;; symbols in question as autoloaded functions.
 804   (mapcar
 805    (function
 806     (lambda (package)
 807       (let ((interactive (nth 1 (memq ':interactive package))))
 808         (mapcar
 809          (function
 810           (lambda (function)
 811             (let (keymap)
 812               (when (consp function)
 813                 (setq keymap (car (memq 'keymap function)))
 814                 (setq function (car function)))
 815               (autoload function (car package) nil interactive keymap))))
 816          (if (eq (nth 1 package) ':interactive)
 817              (cdddr package)
 818            (cdr package))))))
 819    '(("wl-fldmgr" :interactive t
 820       wl-fldmgr-access-display-all wl-fldmgr-access-display-normal
 821       wl-fldmgr-add wl-fldmgr-clear-cut-entity-list wl-fldmgr-copy
 822       wl-fldmgr-copy-region wl-fldmgr-cut wl-fldmgr-cut-region
 823       wl-fldmgr-make-access-group wl-fldmgr-make-filter
 824       wl-fldmgr-make-group wl-fldmgr-make-multi
 825       wl-fldmgr-reconst-entity-hashtb wl-fldmgr-rename wl-fldmgr-delete
 826       wl-fldmgr-save-folders wl-fldmgr-set-petname wl-fldmgr-sort
 827       wl-fldmgr-subscribe wl-fldmgr-subscribe-region
 828       wl-fldmgr-unsubscribe wl-fldmgr-unsubscribe-region wl-fldmgr-yank )
 829      ("wl-fldmgr"
 830       (wl-fldmgr-mode-map keymap)
 831       wl-fldmgr-add-entity-hashtb)
 832      ("wl-expire" :interactive t
 833       wl-folder-archive-current-entity
 834       wl-folder-expire-current-entity wl-summary-archive
 835       wl-summary-expire )
 836      ("wl-score"
 837       wl-score-save wl-summary-rescore-msgs wl-summary-score-headers
 838       wl-summary-score-update-all-lines )
 839      ("wl-score" :interactive t
 840       wl-score-change-score-file wl-score-edit-current-scores
 841       wl-score-edit-file wl-score-flush-cache wl-summary-rescore
 842       wl-score-set-mark-below wl-score-set-expunge-below
 843       wl-summary-increase-score wl-summary-lower-score ))))
 844
 845 ;; for backward compatibility
 846 (defalias 'wl-summary-from-func-petname 'wl-summary-default-from)
 847
 848 (require 'product)
 849 (product-provide (provide 'wl) (require 'wl-version))
 850
 851 ;;; wl.el ends here