wl/wl.el

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