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