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