wl/wl.el

   1 ;;; wl.el -- Wanderlust bootstrap.
   2
   3 ;; Copyright 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
   4
   5 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
   6 ;; Keywords: mail, net news
   7
   8 ;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen).
   9
  10 ;; This program is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14 ;;
  15 ;; This program is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19 ;;
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24 ;;
  25
  26 ;;; Commentary:
  27 ;;
  28
  29 ;;; Code:
  30 ;;
  31
  32 (require 'elmo2)
  33 ;; from x-face.el
  34 (unless (and (fboundp 'defgroup)
  35              (fboundp 'defcustom))
  36   (require 'backquote)
  37   (defmacro defgroup (&rest args))
  38   (defmacro defcustom (symbol value &optional doc &rest args)
  39     (let ((doc (concat "*" (or doc ""))))
  40       (` (defvar (, symbol) (, value) (, doc))))))
  41
  42 (require 'wl-vars)
  43 (require 'wl-util)
  44
  45 (if wl-on-xemacs
  46     (require 'wl-xmas)
  47   (if wl-on-nemacs
  48       (require 'wl-nemacs)
  49     (require 'wl-mule)))
  50
  51 (provide 'wl) ; circular dependency
  52 (require 'wl-folder)
  53 (require 'wl-summary)
  54 (require 'wl-thread)
  55 (require 'wl-address)
  56
  57 (wl-draft-mode-setup)
  58 (require 'wl-draft)
  59 (wl-draft-key-setup)
  60
  61 (require 'wl-demo)
  62 (require 'wl-highlight)
  63
  64 (eval-when-compile
  65   (require 'smtp)
  66   (require 'wl-score)
  67   (unless wl-on-nemacs
  68     (require 'wl-fldmgr))
  69   (if wl-use-semi
  70       (require 'wl-mime)
  71     (require 'tm-wl)))
  72
  73 (defun wl-plugged-init (&optional make-alist)
  74   (setq elmo-plugged wl-plugged)
  75   (if wl-reset-plugged-alist
  76       (elmo-set-plugged elmo-plugged))
  77   (when make-alist
  78     (wl-make-plugged-alist))
  79   ;; Plug status.
  80   (setq elmo-plugged (setq wl-plugged (elmo-plugged-p)))
  81   (setq wl-plug-state-indicator
  82         (if wl-plugged
  83             wl-plug-state-indicator-on
  84           wl-plug-state-indicator-off))
  85   (if wl-plugged
  86       (wl-toggle-plugged t 'flush))
  87   (force-mode-line-update t))
  88
  89 (defun wl-toggle-plugged (&optional arg queue-flush-only)
  90   (interactive)
  91   (elmo-quit) ; Disconnect current connection.
  92   (unless queue-flush-only
  93     (cond
  94      ((eq arg 'on)
  95       (setq wl-plugged t))
  96      ((eq arg 'off)
  97       (setq wl-plugged nil))
  98      (t (setq wl-plugged (null wl-plugged))))
  99     (elmo-set-plugged wl-plugged))
 100   (setq elmo-plugged wl-plugged)
 101   (save-excursion
 102     (mapcar
 103      (function
 104       (lambda (x)
 105         (set-buffer x)
 106         (wl-summary-msgdb-save)
 107         ;; msgdb is saved, but cache is not saved yet.
 108         (wl-summary-set-message-modified)))
 109      (wl-collect-summary)))
 110   (if wl-plugged
 111       (progn
 112         ;; flush queue!!
 113         (setq wl-plug-state-indicator wl-plug-state-indicator-on)
 114         (elmo-dop-queue-flush)
 115         (if (and wl-draft-enable-queuing
 116                  wl-auto-flush-queue)
 117             (wl-draft-queue-flush))
 118         (when (and (eq major-mode 'wl-summary-mode)
 119                    (elmo-folder-plugged-p wl-summary-buffer-folder-name))
 120           (let* ((msgdb-dir (elmo-msgdb-expand-path
 121                              wl-summary-buffer-folder-name))
 122                  (seen-list (elmo-msgdb-seen-load msgdb-dir)))
 123             (setq seen-list
 124                   (wl-summary-flush-pending-append-operations seen-list))
 125             (elmo-msgdb-seen-save msgdb-dir seen-list)))
 126         (run-hooks 'wl-plugged-hook))
 127     (setq wl-plug-state-indicator wl-plug-state-indicator-off)
 128     (run-hooks 'wl-unplugged-hook))
 129   (force-mode-line-update t))
 130
 131 ;;; wl-plugged-mode
 132
 133 (defvar wl-plugged-port-label-alist
 134   (list (cons elmo-default-nntp-port "nntp")
 135         (cons elmo-default-imap4-port "imap4")
 136         (cons elmo-default-pop3-port "pop3")))
 137         ;;(cons elmo-pop-before-smtp-port "pop3")
 138
 139 (defconst wl-plugged-switch-variables
 140   '(("Queuing" . wl-draft-enable-queuing)
 141     ("AutoFlushQueue" . wl-auto-flush-queue)
 142     ("DisconnectedOperation" . elmo-enable-disconnected-operation)))
 143
 144 (defvar wl-plugged-buf-name "Plugged")
 145 (defvar wl-plugged-mode-map nil)
 146 (defvar wl-plugged-alist nil)
 147 (defvar wl-plugged-switch nil)
 148 (defvar wl-plugged-winconf nil)
 149 (defvar wl-plugged-sending-queue-alist nil)
 150 (defvar wl-plugged-dop-queue-alist nil)
 151 (defvar wl-plugged-alist-modified nil)
 152
 153 (defvar wl-plugged-glyph nil)
 154 (defvar wl-unplugged-glyph 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   (when wl-show-plug-status-on-modeline
 213     (setq mode-line-format (wl-make-modeline)))
 214   (setq wl-plugged-switch wl-plugged)
 215   (setq wl-plugged-alist-modified nil)
 216   (setq buffer-read-only t)
 217   (run-hooks 'wl-plugged-mode-hook))
 218
 219 (defmacro wl-plugged-string (plugged &optional time)
 220   (` (if (, time) wl-plugged-auto-off
 221        (if (, plugged) wl-plugged-plug-on wl-plugged-plug-off))))
 222
 223 (defmacro wl-plugged-server-indent ()
 224   (` (make-string wl-plugged-server-indent ? )))
 225
 226 (defun wl-plugged-set-variables ()
 227   (setq wl-plugged-sending-queue-alist
 228         (wl-plugged-sending-queue-info))
 229   (setq wl-plugged-dop-queue-alist
 230         (wl-plugged-dop-queue-info))
 231   (setq wl-plugged-alist
 232         (sort (copy-sequence elmo-plugged-alist)
 233               '(lambda (a b)
 234                  (string< (caar a) (caar b))))))
 235
 236 (defun wl-plugged-sending-queue-info ()
 237   ;; sending queue status
 238   (let (alist msgs sent-via server port)
 239     (setq msgs (elmo-list-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-folder-portinfo 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 (caaar alist)
 341             port (cdaar 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   (set-buffer-modified-p nil))
 424
 425 (defun wl-plugged-change ()
 426   (interactive)
 427   (if (not elmo-plugged-alist)
 428       (message "No plugged info")
 429     (setq wl-plugged-winconf (current-window-configuration))
 430     (let* ((cur-win (selected-window))
 431            (max-lines (if (eq major-mode 'wl-summary-mode)
 432                           (/ (frame-height) 2)
 433                         (window-height)))
 434            window-lines lines)
 435       (save-excursion
 436         (set-buffer (get-buffer-create wl-plugged-buf-name))
 437         (wl-plugged-mode)
 438         (buffer-disable-undo (current-buffer))
 439         (delete-windows-on (current-buffer))
 440         (wl-plugged-set-variables)
 441         (setq lines (wl-plugged-drawing wl-plugged-alist)))
 442       (select-window cur-win)
 443       (setq window-lines (min max-lines (max lines window-min-height)))
 444       (when (> (- (window-height) window-lines) window-min-height)
 445         (split-window cur-win (- (window-height) window-lines)))
 446       (switch-to-buffer wl-plugged-buf-name)
 447       (condition-case nil
 448           (progn
 449             (enlarge-window (- window-lines (window-height)))
 450             (when (fboundp 'pos-visible-in-window-p)
 451               (goto-char (point-min))
 452               (while (and (<= (window-height) max-lines)
 453                           (not (pos-visible-in-window-p (1- (point-max)))))
 454                 (enlarge-window 2))))
 455         (error))
 456       (goto-char (point-min))
 457       (forward-line 1)
 458       (wl-plugged-move-to-next)))) ;; goto first entry
 459
 460 (defsubst wl-plugged-get-server ()
 461   (save-excursion
 462     (end-of-line)
 463     (wl-plugged-move-to-previous-server)
 464     (beginning-of-line)
 465     (when (looking-at (format "^%s\\[[^]]+\\]\\(.*\\)"
 466                               (wl-plugged-server-indent)))
 467       (elmo-match-buffer 1))))
 468
 469 (defun wl-plugged-toggle ()
 470   (interactive)
 471   (let ((cur-point (point)))
 472     (save-excursion
 473       (beginning-of-line)
 474       (cond
 475        ;; swtich variable
 476        ((bobp)
 477         (let (variable switch name)
 478           (goto-char cur-point)
 479           (when (and (not (bobp))
 480                      (not (eq (char-before) ? )))
 481             (if (re-search-backward " [^ ]+" nil t)
 482                 (forward-char 1)
 483               (re-search-backward "^[^ ]+" nil t)))
 484           (when (looking-at "\\([^ :[]+\\):?\\[\\([^]]+\\)\\]")
 485             (setq name (elmo-match-buffer 1))
 486             (setq switch (not (string= (elmo-match-buffer 2) wl-plugged-plug-on)))
 487             (when (setq variable (cdr (assoc name wl-plugged-switch-variables)))
 488               (set variable switch))
 489             (goto-char (match-beginning 2))
 490             (let ((buffer-read-only nil))
 491               (delete-region (match-beginning 2) (match-end 2))
 492               (insert (wl-plugged-string switch))
 493               (set-buffer-modified-p nil)))))
 494        ;; swtich plug
 495        ((looking-at "^\\( *\\)\\[\\([^]]+\\)\\]\\([^ \n]*\\)")
 496         (let* ((indent (length (elmo-match-buffer 1)))
 497                (switch (elmo-match-buffer 2))
 498                (name (elmo-match-buffer 3))
 499                (plugged (not (string= switch wl-plugged-plug-on)))
 500                (alist wl-plugged-alist)
 501                server port)
 502           (cond
 503            ((eq indent wl-plugged-port-indent)  ;; toggle port plug
 504             (cond
 505              ((string-match "\\([^([]*\\)(\\([^)[]+\\))" name)
 506               (setq port (string-to-int (elmo-match-string 2 name))))
 507              (t
 508               (setq port name)))
 509             (setq server (wl-plugged-get-server))
 510             (elmo-set-plugged plugged server port nil alist))
 511            ((eq indent wl-plugged-server-indent)  ;; toggle server plug
 512             (elmo-set-plugged plugged name nil nil alist))
 513            ((eq indent 0)  ;; toggle all plug
 514             (elmo-set-plugged plugged nil nil nil alist)))
 515           ;; redraw
 516           (wl-plugged-redrawing wl-plugged-alist)
 517           ;; change wl-plug-state-indicator
 518           (let ((elmo-plugged wl-plugged-switch))
 519             (setq wl-plugged-switch (elmo-plugged-p))
 520             (setq wl-plug-state-indicator
 521                   (if wl-plugged-switch
 522                       wl-plug-state-indicator-on
 523                     wl-plug-state-indicator-off))
 524             (force-mode-line-update t))))))
 525     (setq wl-plugged-alist-modified t)
 526     (goto-char cur-point)))
 527
 528 (defun wl-plugged-click (e)
 529   (interactive "e")
 530   (mouse-set-point e)
 531   (wl-plugged-toggle))
 532
 533 (defun wl-plugged-toggle-all ()
 534   (interactive)
 535   (let ((cur-point (point)))
 536     (setq wl-plugged-switch (not wl-plugged-switch))
 537     (elmo-set-plugged wl-plugged-switch nil nil nil wl-plugged-alist)
 538     (wl-plugged-redrawing wl-plugged-alist)
 539     (goto-char cur-point)
 540     (setq wl-plugged-alist-modified t)
 541     ;; change wl-plug-state-indicator
 542     (setq wl-plug-state-indicator
 543           (if wl-plugged-switch
 544               wl-plug-state-indicator-on
 545             wl-plug-state-indicator-off))
 546     (force-mode-line-update t)))
 547
 548 (defun wl-plugged-exit ()
 549   (interactive)
 550   (setq ;;elmo-plugged-alist wl-plugged-alist
 551         wl-plugged wl-plugged-switch
 552         wl-plugged-alist nil
 553         wl-plugged-sending-queue-alist nil
 554         wl-plugged-dop-queue-alist nil)
 555   (run-hooks 'wl-plugged-exit-hook)
 556   (when wl-plugged-alist-modified
 557     (wl-toggle-plugged (if wl-plugged 'on 'off) t))
 558   (kill-buffer (current-buffer))
 559   (if wl-plugged-winconf
 560       (set-window-configuration wl-plugged-winconf)))
 561
 562 (defun wl-plugged-flush-queue ()
 563   (interactive)
 564   (let ((cur-point (point))
 565         (dop-status (elmo-dop-queue-flush))
 566         (send-status (wl-draft-queue-flush)))
 567     (unless (or dop-status send-status)
 568       (message "No processing queue."))
 569     (wl-plugged-set-variables)
 570     (wl-plugged-drawing wl-plugged-alist)
 571     (goto-char cur-point)))
 572
 573 (defun wl-plugged-move-to-next ()
 574   (interactive)
 575   (when (re-search-forward "\\[\\([^]]+\\)\\]" nil t)
 576     (let ((pos (match-beginning 1)))
 577       (if (invisible-p pos)
 578           (goto-char (next-visible-point pos))
 579         (goto-char pos)))))
 580
 581 (defun wl-plugged-move-to-previous ()
 582   (interactive)
 583   (if (eq (char-before) ?\]) (forward-char -1))
 584   (when (re-search-backward "\\[\\([^]]+\\)\\]" nil t)
 585     (let ((pos (match-beginning 1)))
 586       (if (invisible-p pos)
 587           (goto-char (next-visible-point pos))
 588         (goto-char pos)))))
 589
 590 (defun wl-plugged-move-to-next-server ()
 591   (interactive)
 592   (let ((regexp
 593          (format "^%s\\[\\([^]]+\\)\\]" (wl-plugged-server-indent)))
 594         point)
 595     (save-excursion
 596       (end-of-line)
 597       (if (re-search-forward regexp nil t)
 598           (setq point (match-beginning 1))))
 599     (if point (goto-char point))))
 600
 601 (defun wl-plugged-move-to-previous-server ()
 602   (interactive)
 603   (let ((regexp
 604          (format "^%s\\[\\([^]]+\\)\\]" (wl-plugged-server-indent))))
 605     (if (re-search-backward regexp nil t)
 606         (goto-char (match-beginning 1)))))
 607
 608 ;;; end of wl-plugged-mode
 609
 610 (defun wl-save ()
 611   "Save summary and folder status."
 612   (interactive)
 613   (wl-save-status 'keep-summary))
 614
 615 (defun wl-save-status (&optional keep-summary)
 616   (message "Saving summary and folder status...")
 617   (let (summary-buf)
 618     (save-excursion
 619       (let ((summaries (wl-collect-summary)))
 620         (mapcar
 621          (function
 622           (lambda (x)
 623             (set-buffer x)
 624             (unless keep-summary
 625               (wl-summary-cleanup-temp-marks))
 626             (wl-summary-save-status keep-summary)
 627             (unless keep-summary
 628               (kill-buffer x))))
 629          summaries))))
 630   (wl-refile-alist-save
 631    wl-refile-alist-file-name wl-refile-alist)
 632   (wl-refile-alist-save
 633    wl-refile-msgid-alist-file-name wl-refile-msgid-alist)
 634   (wl-folder-info-save)
 635   (and (featurep 'wl-fldmgr) (wl-fldmgr-exit))
 636   (wl-crosspost-alist-save)
 637   (message "Saving summary and folder status...done."))
 638
 639 (defun wl-exit ()
 640   (interactive)
 641   (when (or (not wl-interactive-exit)
 642             (y-or-n-p "Quit Wanderlust?"))
 643     (elmo-quit)
 644     (run-hooks 'wl-exit-hook)
 645     (wl-save-status)
 646     (wl-folder-cleanup-variables)
 647     (elmo-cleanup-variables)
 648     (wl-kill-buffers
 649      (format "^\\(%s\\)$"
 650              (mapconcat 'identity
 651                         (list (format "%s\\(:.*\\)?"
 652                                       (default-value 'wl-message-buf-name))
 653                               wl-original-buf-name
 654                               wl-folder-buffer-name)
 655                         "\\|")))
 656     (elmo-buffer-cache-clean-up)
 657     (if (fboundp 'mmelmo-cleanup-entity-buffers)
 658         (mmelmo-cleanup-entity-buffers))
 659     (setq wl-init nil)
 660     (unless wl-on-nemacs
 661       (remove-hook 'kill-emacs-hook 'wl-save-status))
 662     t)
 663   (message "") ;; empty minibuffer.
 664   )
 665
 666 (defun wl-init (&optional arg)
 667   (when (not wl-init)
 668     (setq elmo-plugged wl-plugged)
 669     (let (succeed demo-buf)
 670       (if wl-demo
 671           (setq demo-buf (wl-demo)))
 672       (unless wl-on-nemacs
 673         (add-hook 'kill-emacs-hook 'wl-save-status))
 674       (unwind-protect
 675           (progn
 676             (wl-address-init)
 677             (wl-draft-setup)
 678             (wl-refile-alist-setup)
 679             (wl-crosspost-alist-load)
 680             (if wl-use-semi
 681                 (progn
 682                   (require 'wl-mime)
 683                   (setq elmo-use-semi t))
 684               (require 'tm-wl)
 685               (setq elmo-use-semi nil))
 686             ;; defined above.
 687             (wl-mime-setup)
 688             (fset 'wl-summary-from-func-internal
 689                   (symbol-value 'wl-summary-from-func))
 690             (fset 'wl-summary-subject-func-internal
 691                   (symbol-value 'wl-summary-subject-func))
 692             (fset 'wl-summary-subject-filter-func-internal
 693                   (symbol-value 'wl-summary-subject-filter-func))
 694             (setq elmo-no-from wl-summary-no-from-message)
 695             (setq elmo-no-subject wl-summary-no-subject-message)
 696             (setq succeed t)
 697             (progn
 698               (message "Checking environment...")
 699               (wl-check-environment arg)
 700               (message "Checking environment...done.")))
 701         (if demo-buf
 702             (kill-buffer demo-buf))
 703         (if succeed
 704             (setq wl-init t))
 705         (run-hooks 'wl-init-hook)))))
 706
 707 (defun wl-check-environment (no-check-folder)
 708   (unless (featurep 'mime-setup)
 709     (require 'mime-setup))
 710   (unless wl-from
 711     (error "Please set `wl-from'"))
 712   (unless (string-match "[^.]\\.[^.]" (or wl-message-id-domain
 713                                           (if wl-local-domain
 714                                               (concat (system-name)
 715                                                       "." wl-local-domain)
 716                                             (system-name))))
 717     (error "Please set `wl-local-domain' to get valid FQDN"))
 718   (when (not no-check-folder)
 719     (if (not (eq (elmo-folder-get-type wl-draft-folder) 'localdir))
 720         (error "%s is not allowed for draft folder" wl-draft-folder))
 721     (unless (elmo-folder-exists-p wl-draft-folder)
 722       (if (y-or-n-p
 723            (format "Draft Folder %s does not exist, create it?"
 724                    wl-draft-folder))
 725           (elmo-create-folder wl-draft-folder)
 726         (error "Draft Folder is not created")))
 727     (if (and wl-draft-enable-queuing
 728              (not (elmo-folder-exists-p wl-queue-folder)))
 729         (if (y-or-n-p
 730              (format "Queue Folder %s does not exist, create it?"
 731                      wl-queue-folder))
 732             (elmo-create-folder wl-queue-folder)
 733           (error "Queue Folder is not created")))
 734     (unless (elmo-folder-exists-p wl-trash-folder)
 735       (if (y-or-n-p
 736            (format "Trash Folder %s does not exist, create it?"
 737                    wl-trash-folder))
 738           (elmo-create-folder wl-trash-folder)
 739         (error "Trash Folder is not created")))
 740     (unless (elmo-folder-exists-p elmo-lost+found-folder)
 741       (elmo-create-folder elmo-lost+found-folder)))
 742   (unless (file-exists-p wl-tmp-dir)
 743     (if (y-or-n-p
 744          (format "Temp directory (to save multipart) %s does not exist, create it now?"
 745                  wl-tmp-dir))
 746         (make-directory wl-tmp-dir)
 747       (error "Temp directory is not created"))))
 748
 749 ;;;###autoload
 750 (defun wl (&optional arg)
 751   "Start Wanderlust -- Yet Another Message Interface On Emacsen.
 752 If prefix argument is specified, folder checkings are skipped."
 753   (interactive "P")
 754   (unless wl-init
 755     (wl-load-profile))
 756   (unwind-protect
 757       (wl-init arg)
 758     (let ((make (wl-folder arg)))
 759       (wl-plugged-init make)))
 760   (run-hooks 'wl-hook))
 761
 762 ;; Define some autoload functions WL might use.
 763 (eval-and-compile
 764   ;; This little mapcar goes through the list below and marks the
 765   ;; symbols in question as autoloaded functions.
 766   (mapcar
 767    (function
 768     (lambda (package)
 769       (let ((interactive (nth 1 (memq ':interactive package))))
 770         (mapcar
 771          (function
 772           (lambda (function)
 773             (let (keymap)
 774               (when (consp function)
 775                 (setq keymap (car (memq 'keymap function)))
 776                 (setq function (car function)))
 777               (autoload function (car package) nil interactive keymap))))
 778          (if (eq (nth 1 package) ':interactive)
 779              (cdddr package)
 780            (cdr package))))))
 781    '(("wl-fldmgr" :interactive t
 782       wl-fldmgr-access-display-all wl-fldmgr-access-display-normal
 783       wl-fldmgr-add wl-fldmgr-clear-cut-entity-list wl-fldmgr-copy
 784       wl-fldmgr-copy-region wl-fldmgr-cut wl-fldmgr-cut-region
 785       wl-fldmgr-make-access-group wl-fldmgr-make-filter
 786       wl-fldmgr-make-group wl-fldmgr-make-multi
 787       wl-fldmgr-reconst-entity-hashtb wl-fldmgr-rename wl-fldmgr-delete
 788       wl-fldmgr-save-folders wl-fldmgr-set-petname wl-fldmgr-sort
 789       wl-fldmgr-subscribe wl-fldmgr-subscribe-region
 790       wl-fldmgr-unsubscribe wl-fldmgr-unsubscribe-region wl-fldmgr-yank )
 791      ("wl-fldmgr"
 792       (wl-fldmgr-mode-map keymap)
 793       wl-fldmgr-add-entity-hashtb)
 794      ("wl-expire" :interactive t
 795       wl-folder-archive-current-entity
 796       wl-folder-expire-current-entity wl-summary-archive
 797       wl-summary-expire )
 798      ("wl-score"
 799       wl-score-save wl-summary-rescore-msgs wl-summary-score-headers
 800       wl-summary-score-update-all-lines )
 801      ("wl-score" :interactive t
 802       wl-score-change-score-file wl-score-edit-current-scores
 803       wl-score-edit-file wl-score-flush-cache wl-summary-rescore
 804       wl-score-set-mark-below wl-score-set-expunge-below
 805       wl-summary-increase-score wl-summary-lower-score ))))
 806
 807 ;; for backward compatibility
 808 (defalias 'wl-summary-from-func-petname 'wl-summary-default-from)
 809
 810 (provide 'wl)
 811
 812 ;;; wl.el ends here