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