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