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