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                  server-info
 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 stream-type 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             stream-type (nth 2 (caar alist))
 355             label (nth 1 (car alist))
 356             plugged (nth 2 (car alist))
 357             time (nth 3 (car alist)))
 358       (unless (string= last server)
 359         ;; server plug
 360         (insert (format "%s[%s]%s\n"
 361                         (wl-plugged-server-indent)
 362                         (wl-plugged-string
 363                          (elmo-plugged-p server nil plugged-alist))
 364                         server))
 365         (setq last server))
 366       ;; port plug
 367       (setq line
 368             (format "%s[%s]%s"
 369                     (make-string wl-plugged-port-indent ? )
 370                     (wl-plugged-string plugged time)
 371                     (cond
 372                      ((stringp port)
 373                       port)
 374                      (t
 375                       (format "%s(%d)"
 376                               (or label
 377                                   (cdr (assq port wl-plugged-port-label-alist))
 378                                   "")
 379                               port)))))
 380       (setq column (max (if line (1+ (string-width line)) 0)
 381                         wl-plugged-queue-status-column))
 382       (cond
 383        ;; sending queue status
 384        ((setq qinfo (assoc (cons server port) wl-plugged-sending-queue-alist))
 385         (setq line
 386               (concat
 387                (wl-set-string-width column line)
 388                (wl-plugged-sending-queue-status qinfo))))
 389        ;; dop queue status
 390        ((setq qinfo (assoc (list server port stream-type)
 391                            wl-plugged-dop-queue-alist))
 392         (setq line
 393               (concat
 394                (wl-set-string-width column line)
 395                (wl-plugged-dop-queue-status qinfo column)))))
 396       (insert line "\n")
 397       (setq alist (cdr alist)))
 398     (delete-region (1- (point-max)) (point-max)) ;; delete line at the end.
 399     (goto-char (point-min))
 400     (while (not (eobp))
 401       (wl-highlight-plugged-current-line)
 402       (forward-line 1)))
 403   (set-buffer-modified-p nil)
 404   (count-lines (point-min) (point-max)))
 405
 406 (defun wl-plugged-redrawing-switch (indent switch &optional time)
 407   (beginning-of-line)
 408   (when (re-search-forward
 409          (format "^%s\\[\\([^]]+\\)\\]" (make-string indent ? )))
 410     (goto-char (match-beginning 1))
 411     (delete-region (match-beginning 1) (match-end 1))
 412     (insert (wl-plugged-string switch time))
 413     (wl-highlight-plugged-current-line)
 414     (forward-line 1)))
 415
 416 (defun wl-plugged-redrawing (plugged-alist)
 417   (let ((buffer-read-only nil)
 418         (alist plugged-alist)
 419         last server port plugged time)
 420     (goto-char (point-min))
 421     (wl-plugged-redrawing-switch 0 (elmo-plugged-p))
 422     (while alist
 423       (setq server (caaar alist)
 424             port (cdaar alist)
 425             plugged (nth 2 (car alist))
 426             time (nth 3 (car alist)))
 427       (unless (string= last server)
 428         ;; server plug
 429         (wl-plugged-redrawing-switch
 430          wl-plugged-server-indent
 431          (elmo-plugged-p server nil plugged-alist))
 432         (setq last server))
 433       ;; port plug
 434       (wl-plugged-redrawing-switch
 435        wl-plugged-port-indent plugged time)
 436       (setq alist (cdr alist))))
 437   (sit-for 0)
 438   (set-buffer-modified-p nil))
 439
 440 (defun wl-plugged-change ()
 441   (interactive)
 442   (if (not elmo-plugged-alist)
 443       (message "No plugged info")
 444     (setq wl-plugged-winconf (current-window-configuration))
 445     (let* ((cur-win (selected-window))
 446            (max-lines (if (eq major-mode 'wl-summary-mode)
 447                           (/ (frame-height) 2)
 448                         (window-height)))
 449            window-lines lines)
 450       (save-excursion
 451         (set-buffer (get-buffer-create wl-plugged-buf-name))
 452         (wl-plugged-mode)
 453         (buffer-disable-undo (current-buffer))
 454         (delete-windows-on (current-buffer))
 455         (wl-plugged-set-variables)
 456         (setq lines (wl-plugged-drawing wl-plugged-alist)))
 457       (select-window cur-win)
 458       (setq window-lines (min max-lines (max lines window-min-height)))
 459       (when (> (- (window-height) window-lines) window-min-height)
 460         (split-window cur-win (- (window-height) window-lines)))
 461       (switch-to-buffer wl-plugged-buf-name)
 462       (condition-case nil
 463           (progn
 464             (enlarge-window (- window-lines (window-height)))
 465             (when (fboundp 'pos-visible-in-window-p)
 466               (goto-char (point-min))
 467               (while (and (< (window-height) max-lines)
 468                           (not (pos-visible-in-window-p (1- (point-max)))))
 469                 (enlarge-window 2))))
 470         (error))
 471       (goto-char (point-min))
 472       (forward-line 1)
 473       (wl-plugged-move-to-next)))) ;; goto first entry
 474
 475 (defsubst wl-plugged-get-server ()
 476   (save-excursion
 477     (end-of-line)
 478     (wl-plugged-move-to-previous-server)
 479     (beginning-of-line)
 480     (when (looking-at (format "^%s\\[[^]]+\\]\\(.*\\)"
 481                               (wl-plugged-server-indent)))
 482       (elmo-match-buffer 1))))
 483
 484 (defun wl-plugged-toggle ()
 485   (interactive)
 486   (let ((cur-point (point)))
 487     (save-excursion
 488       (beginning-of-line)
 489       (cond
 490        ;; swtich variable
 491        ((bobp)
 492         (let (variable switch name)
 493           (goto-char cur-point)
 494           (when (and (not (bobp))
 495                      (not (eq (char-before) ? )))
 496             (if (re-search-backward " [^ ]+" nil t)
 497                 (forward-char 1)
 498               (re-search-backward "^[^ ]+" nil t)))
 499           (when (looking-at "\\([^ :[]+\\):?\\[\\([^]]+\\)\\]")
 500             (setq name (elmo-match-buffer 1))
 501             (setq switch (not (string= (elmo-match-buffer 2) wl-plugged-plug-on)))
 502             (when (setq variable (cdr (assoc name wl-plugged-switch-variables)))
 503               (set variable switch))
 504             (goto-char (match-beginning 2))
 505             (let ((buffer-read-only nil))
 506               (delete-region (match-beginning 2) (match-end 2))
 507               (insert (wl-plugged-string switch))
 508               (set-buffer-modified-p nil)))))
 509        ;; swtich plug
 510        ((looking-at "^\\( *\\)\\[\\([^]]+\\)\\]\\([^ \n]*\\)")
 511         (let* ((indent (length (elmo-match-buffer 1)))
 512                (switch (elmo-match-buffer 2))
 513                (name (elmo-match-buffer 3))
 514                (plugged (not (string= switch wl-plugged-plug-on)))
 515                (alist wl-plugged-alist)
 516                server port stream-type name-1)
 517           (cond
 518            ((eq indent wl-plugged-port-indent)  ;; toggle port plug
 519             (cond
 520              ((string-match "\\([^([]*\\)(\\([^)[]+\\))" name)
 521               (setq port (string-to-int (elmo-match-string 2 name)))
 522               (if (string-match "!" (setq name-1 (elmo-match-string 1 name)))
 523                   (setq stream-type
 524                         (intern (substring name-1 (match-end 0))))))
 525              (t
 526               (setq port name)))
 527             (setq server (wl-plugged-get-server))
 528             (elmo-set-plugged plugged server port stream-type nil alist))
 529            ((eq indent wl-plugged-server-indent)  ;; toggle server plug
 530             (elmo-set-plugged plugged name nil nil nil alist))
 531            ((eq indent 0)  ;; toggle all plug
 532             (elmo-set-plugged plugged nil nil nil nil alist)))
 533           ;; redraw
 534           (wl-plugged-redrawing wl-plugged-alist)
 535           ;; show plugged status in modeline
 536           (let ((elmo-plugged wl-plugged-switch))
 537             (setq wl-plugged-switch (elmo-plugged-p)
 538                   wl-modeline-plug-status wl-plugged-switch)
 539             (force-mode-line-update t))))))
 540     (setq wl-plugged-alist-modified t)
 541     (goto-char cur-point)))
 542
 543 (defun wl-plugged-click (e)
 544   (interactive "e")
 545   (mouse-set-point e)
 546   (wl-plugged-toggle))
 547
 548 (defun wl-plugged-toggle-all ()
 549   (interactive)
 550   (let ((cur-point (point)))
 551     (setq wl-plugged-switch (not wl-plugged-switch))
 552     (elmo-set-plugged wl-plugged-switch nil nil nil nil wl-plugged-alist)
 553     (wl-plugged-redrawing wl-plugged-alist)
 554     (goto-char cur-point)
 555     (setq wl-plugged-alist-modified t)
 556     ;; show plugged status in modeline
 557     (setq wl-modeline-plug-status wl-plugged-switch)
 558     (force-mode-line-update t)))
 559
 560 (defun wl-plugged-exit ()
 561   (interactive)
 562   (setq ;;elmo-plugged-alist wl-plugged-alist
 563         wl-plugged wl-plugged-switch
 564         wl-plugged-alist nil
 565         wl-plugged-sending-queue-alist nil
 566         wl-plugged-dop-queue-alist nil)
 567   (run-hooks 'wl-plugged-exit-hook)
 568   (when wl-plugged-alist-modified
 569     (wl-toggle-plugged (if wl-plugged 'on 'off) t))
 570   (kill-buffer (current-buffer))
 571   (if wl-plugged-winconf
 572       (set-window-configuration wl-plugged-winconf)))
 573
 574 (defun wl-plugged-flush-queue ()
 575   (interactive)
 576   (let ((cur-point (point))
 577         (dop-status (elmo-dop-queue-flush))
 578         (send-status (wl-draft-queue-flush)))
 579     (unless (or dop-status send-status)
 580       (message "No processing queue."))
 581     (wl-plugged-set-variables)
 582     (wl-plugged-drawing wl-plugged-alist)
 583     (goto-char cur-point)))
 584
 585 (defun wl-plugged-move-to-next ()
 586   (interactive)
 587   (when (re-search-forward "\\[\\([^]]+\\)\\]" nil t)
 588     (let ((pos (match-beginning 1)))
 589       (if (invisible-p pos)
 590           (goto-char (next-visible-point pos))
 591         (goto-char pos)))))
 592
 593 (defun wl-plugged-move-to-previous ()
 594   (interactive)
 595   (if (eq (char-before) ?\]) (forward-char -1))
 596   (when (re-search-backward "\\[\\([^]]+\\)\\]" nil t)
 597     (let ((pos (match-beginning 1)))
 598       (if (invisible-p pos)
 599           (goto-char (next-visible-point pos))
 600         (goto-char pos)))))
 601
 602 (defun wl-plugged-move-to-next-server ()
 603   (interactive)
 604   (let ((regexp
 605          (format "^%s\\[\\([^]]+\\)\\]" (wl-plugged-server-indent)))
 606         point)
 607     (save-excursion
 608       (end-of-line)
 609       (if (re-search-forward regexp nil t)
 610           (setq point (match-beginning 1))))
 611     (if point (goto-char point))))
 612
 613 (defun wl-plugged-move-to-previous-server ()
 614   (interactive)
 615   (let ((regexp
 616          (format "^%s\\[\\([^]]+\\)\\]" (wl-plugged-server-indent))))
 617     (if (re-search-backward regexp nil t)
 618         (goto-char (match-beginning 1)))))
 619
 620 ;;; end of wl-plugged-mode
 621
 622 (defun wl-save ()
 623   "Save summary and folder status."
 624   (interactive)
 625   (wl-save-status 'keep-summary)
 626   (run-hooks 'wl-save-hook))
 627
 628 (defun wl-save-status (&optional keep-summary)
 629   (message "Saving summary and folder status...")
 630   (let (summary-buf)
 631     (save-excursion
 632       (let ((summaries (wl-collect-summary)))
 633         (while summaries
 634           (with-current-buffer (car summaries)
 635             (unless keep-summary
 636               (wl-summary-cleanup-temp-marks))
 637             (wl-summary-save-view keep-summary)
 638             (elmo-folder-commit wl-summary-buffer-elmo-folder)
 639             (unless keep-summary
 640               (kill-buffer (car summaries))))
 641           (setq summaries (cdr summaries))))))
 642   (wl-refile-alist-save)
 643   (wl-folder-info-save)
 644   (and (featurep 'wl-fldmgr) (wl-fldmgr-exit))
 645   (elmo-crosspost-message-alist-save)
 646   (message "Saving summary and folder status...done"))
 647
 648 (defun wl-exit ()
 649   (interactive)
 650   (when (or (not wl-interactive-exit)
 651             (y-or-n-p "Quit Wanderlust? "))
 652     (elmo-quit)
 653     (wl-biff-stop)
 654     (run-hooks 'wl-exit-hook)
 655     (wl-save-status)
 656     (wl-folder-cleanup-variables)
 657     (wl-message-buffer-cache-clean-up)
 658     (wl-kill-buffers
 659      (format "^\\(%s\\)$"
 660              (mapconcat 'identity
 661                         (list wl-folder-buffer-name
 662                               wl-plugged-buf-name)
 663                         "\\|")))
 664     (if (and wl-folder-use-frame
 665              (> (length (visible-frame-list)) 1))
 666         (delete-frame))
 667     (setq wl-init nil)
 668     (unless wl-on-nemacs
 669       (remove-hook 'kill-emacs-hook 'wl-save-status))
 670     t)
 671   (message "") ; empty minibuffer.
 672   )
 673
 674 (defun wl-init ()
 675   (when (not wl-init)
 676     (unless (featurep 'mime-setup)
 677       (require 'mime-setup))
 678     (setq elmo-plugged wl-plugged)
 679     (unless wl-on-nemacs
 680       (add-hook 'kill-emacs-hook 'wl-save-status))
 681     (wl-address-init)
 682     (wl-draft-setup)
 683     (wl-refile-alist-setup)
 684     (if wl-use-semi
 685         (progn
 686           (require 'wl-mime)
 687           (setq elmo-use-semi t))
 688       (require 'tm-wl)
 689       (setq elmo-use-semi nil))
 690     ;; defined above.
 691     (wl-mime-setup)
 692     (fset 'wl-summary-from-func-internal
 693           (symbol-value 'wl-summary-from-function))
 694     (fset 'wl-summary-subject-func-internal
 695           (symbol-value 'wl-summary-subject-function))
 696     (fset 'wl-summary-subject-filter-func-internal
 697           (symbol-value 'wl-summary-subject-filter-function))
 698     (setq elmo-no-from wl-summary-no-from-message)
 699     (setq elmo-no-subject wl-summary-no-subject-message)
 700     (setq wl-init t)
 701     ;; This hook may contain the functions `wl-plugged-init-icons' and
 702     ;; `wl-biff-init-icons' for reasons of system internal to accord
 703     ;; facilities for the Emacs variants.
 704     (run-hooks 'wl-init-hook)))
 705
 706 (defun wl-check-environment (no-check-folder)
 707   (unless wl-from
 708     (error "Please set `wl-from'"))
 709   ;; Message-ID
 710   (unless (string-match "[^.]\\.[^.]" (or wl-message-id-domain
 711                                           (if wl-local-domain
 712                                               (concat (system-name)
 713                                                       "." wl-local-domain)
 714                                             (system-name))))
 715     (error "Please set `wl-local-domain' to get valid FQDN"))
 716   (if (string-match "@" (or wl-message-id-domain
 717                             (if wl-local-domain
 718                                 (concat (system-name)
 719                                         "." wl-local-domain)
 720                               (system-name))))
 721       (error "Please remove `@' from `wl-message-id-domain'"))
 722   (if (string= wl-local-domain "localdomain")
 723       (error "Please set `wl-local-domain'"))
 724   (if (string= wl-message-id-domain "localhost.localdomain")
 725       (error "Please set `wl-message-id-domain'"))
 726   ;; folders
 727   (when (not no-check-folder)
 728     (let ((draft-folder (wl-folder-get-elmo-folder wl-draft-folder))
 729           (queue-folder (wl-folder-get-elmo-folder wl-queue-folder))
 730           (trash-folder (wl-folder-get-elmo-folder wl-trash-folder))
 731           (lost+found-folder (wl-folder-get-elmo-folder
 732                               elmo-lost+found-folder)))
 733       (if (not (elmo-folder-message-file-p draft-folder))
 734           (error "%s is not allowed for draft folder" wl-draft-folder))
 735       (unless (elmo-folder-exists-p draft-folder)
 736         (if (y-or-n-p
 737              (format "Draft Folder %s does not exist, create it? "
 738                      wl-draft-folder))
 739             (elmo-folder-create draft-folder)
 740           (error "Draft Folder is not created")))
 741       (if (and wl-draft-enable-queuing
 742                (not (elmo-folder-exists-p queue-folder)))
 743           (if (y-or-n-p
 744                (format "Queue Folder %s does not exist, create it? "
 745                        wl-queue-folder))
 746               (elmo-folder-create queue-folder)
 747             (error "Queue Folder is not created")))
 748       (when (not (eq no-check-folder 'wl-draft))
 749         (unless (elmo-folder-exists-p trash-folder)
 750           (if (y-or-n-p
 751                (format "Trash Folder %s does not exist, create it? "
 752                        wl-trash-folder))
 753               (elmo-folder-create trash-folder)
 754             (error "Trash Folder is not created")))
 755         (unless (elmo-folder-exists-p lost+found-folder)
 756           (elmo-folder-create lost+found-folder)))
 757       ;; tmp dir
 758       (unless (file-exists-p wl-tmp-dir)
 759         (if (y-or-n-p
 760              (format "Temp directory (to save multipart) %s does not exist, create it now? "
 761                      wl-tmp-dir))
 762             (make-directory wl-tmp-dir)
 763           (error "Temp directory is not created"))))))
 764
 765 ;;;###autoload
 766 (defun wl (&optional arg)
 767   "Start Wanderlust -- Yet Another Message Interface On Emacsen.
 768 If ARG (prefix argument) is specified, folder checkings are skipped."
 769   (interactive "P")
 770   (unless wl-init
 771     (wl-load-profile))
 772   (elmo-init)
 773   (let (demo-buf)
 774     (unless wl-init
 775       (if wl-demo (setq demo-buf (wl-demo))))
 776     (wl-init)
 777     (unless wl-init
 778       (condition-case nil
 779           (progn
 780             (message "Checking environment...")
 781             (wl-check-environment arg)
 782             (message "Checking environment...done"))
 783         (error)
 784         (quit)))
 785     (condition-case obj
 786         (progn
 787           (wl-plugged-init (wl-folder arg))
 788           (unless arg
 789             (run-hooks 'wl-auto-check-folder-pre-hook)
 790             (wl-folder-auto-check)
 791             (run-hooks 'wl-auto-check-folder-hook))
 792           (unless arg (wl-biff-start)))
 793       (error
 794        (if (buffer-live-p demo-buf)
 795            (kill-buffer demo-buf))
 796        (signal (car obj)(cdr obj)))
 797       (quit))
 798     (if (buffer-live-p demo-buf)
 799         (kill-buffer demo-buf)))
 800   (run-hooks 'wl-hook))
 801
 802 ;; Define some autoload functions WL might use.
 803 (eval-and-compile
 804   ;; This little mapcar goes through the list below and marks the
 805   ;; symbols in question as autoloaded functions.
 806   (mapcar
 807    (function
 808     (lambda (package)
 809       (let ((interactive (nth 1 (memq ':interactive package))))
 810         (mapcar
 811          (function
 812           (lambda (function)
 813             (let (keymap)
 814               (when (consp function)
 815                 (setq keymap (car (memq 'keymap function)))
 816                 (setq function (car function)))
 817               (autoload function (car package) nil interactive keymap))))
 818          (if (eq (nth 1 package) ':interactive)
 819              (cdddr package)
 820            (cdr package))))))
 821    '(("wl-fldmgr" :interactive t
 822       wl-fldmgr-access-display-all wl-fldmgr-access-display-normal
 823       wl-fldmgr-add wl-fldmgr-clear-cut-entity-list wl-fldmgr-copy
 824       wl-fldmgr-copy-region wl-fldmgr-cut wl-fldmgr-cut-region
 825       wl-fldmgr-make-access-group wl-fldmgr-make-filter
 826       wl-fldmgr-make-group wl-fldmgr-make-multi
 827       wl-fldmgr-reconst-entity-hashtb wl-fldmgr-rename wl-fldmgr-delete
 828       wl-fldmgr-save-folders wl-fldmgr-set-petname wl-fldmgr-sort
 829       wl-fldmgr-subscribe wl-fldmgr-subscribe-region
 830       wl-fldmgr-unsubscribe wl-fldmgr-unsubscribe-region wl-fldmgr-yank )
 831      ("wl-fldmgr"
 832       (wl-fldmgr-mode-map keymap)
 833       wl-fldmgr-add-entity-hashtb)
 834      ("wl-expire" :interactive t
 835       wl-folder-archive-current-entity
 836       wl-folder-expire-current-entity wl-summary-archive
 837       wl-summary-expire )
 838      ("wl-score"
 839       wl-score-save wl-summary-rescore-msgs wl-summary-score-headers
 840       wl-summary-score-update-all-lines )
 841      ("wl-score" :interactive t
 842       wl-score-change-score-file wl-score-edit-current-scores
 843       wl-score-edit-file wl-score-flush-cache wl-summary-rescore
 844       wl-score-set-mark-below wl-score-set-expunge-below
 845       wl-summary-increase-score wl-summary-lower-score ))))
 846
 847 ;; for backward compatibility
 848 (defalias 'wl-summary-from-func-petname 'wl-summary-default-from)
 849
 850 (require 'product)
 851 (product-provide (provide 'wl) (require 'wl-version))
 852
 853 ;;; wl.el ends here