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-action)
  60 (require 'wl-thread)
  61 (require 'wl-address)
  62 (require 'wl-news)
  63
  64 (wl-draft-mode-setup)
  65 (require 'wl-draft)
  66 (wl-draft-key-setup)
  67
  68 (require 'wl-demo)
  69 (require 'wl-highlight)
  70
  71 (eval-when-compile
  72   (require 'cl)
  73   (require 'smtp)
  74   (require 'wl-score)
  75   (require 'wl-fldmgr)
  76   (require 'wl-mime)
  77   (require 'wl-spam))
  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 (not 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-save-view)
 109         (elmo-folder-commit wl-summary-buffer-elmo-folder))))
 110   (setq wl-biff-check-folders-running nil)
 111   (if wl-plugged
 112       (progn
 113         ;; flush queue!!
 114         (elmo-dop-queue-flush)
 115         (unless queue-flush-only
 116           (when wl-biff-check-folder-list
 117             (wl-biff-check-folders)
 118             (wl-biff-start)))
 119         (if (and wl-draft-enable-queuing
 120                  wl-auto-flush-queue)
 121             (wl-draft-queue-flush))
 122 ;;      (when (and (eq major-mode 'wl-summary-mode)
 123 ;;                 (elmo-folder-plugged-p wl-summary-buffer-elmo-folder))
 124 ;;        (let* ((msgdb-dir (elmo-folder-msgdb-path
 125 ;;                           wl-summary-buffer-elmo-folder))
 126 ;;               (seen-list (elmo-msgdb-seen-load msgdb-dir)))
 127 ;;       (setq seen-list
 128 ;;                (wl-summary-flush-pending-append-operations seen-list))
 129 ;;          (elmo-msgdb-seen-save msgdb-dir seen-list)))
 130         (run-hooks 'wl-plugged-hook))
 131     (wl-biff-stop)
 132     (run-hooks 'wl-unplugged-hook))
 133   (force-mode-line-update t))
 134
 135 ;;; wl-plugged-mode
 136
 137 (defvar wl-plugged-port-label-alist
 138   (list (cons 119 "nntp")
 139         (cons 143 "imap4")
 140         (cons 110 "pop3")
 141         (cons 25 "smtp")))
 142         ;;(cons elmo-pop-before-smtp-port "pop3")
 143
 144 (defconst wl-plugged-switch-variables
 145   '(("Queuing" . wl-draft-enable-queuing)
 146     ("AutoFlushQueue" . wl-auto-flush-queue)
 147     ("DisconnectedOperation" . elmo-enable-disconnected-operation)))
 148
 149 (defvar wl-plugged-buf-name "Plugged")
 150 (defvar wl-plugged-mode-map nil)
 151 (defvar wl-plugged-alist nil)
 152 (defvar wl-plugged-switch nil)
 153 (defvar wl-plugged-winconf nil)
 154 (defvar wl-plugged-sending-queue-alist nil)
 155 (defvar wl-plugged-dop-queue-alist nil)
 156 (defvar wl-plugged-alist-modified nil)
 157
 158 (defvar wl-plugged-mode-menu-spec
 159   '("Plugged"
 160     ["Toggle plugged" wl-plugged-toggle t]
 161     ["Toggle All plugged" wl-plugged-toggle-all t]
 162     ["Prev Port"      wl-plugged-move-to-previous t]
 163     ["Next Port"      wl-plugged-move-to-next t]
 164     ["Prev Server"    wl-plugged-move-to-previous-server t]
 165     ["Next Server"    wl-plugged-move-to-next-server t]
 166     ["Flush queue"    wl-plugged-flush-queue t]
 167     "----"
 168     ["Exit"           wl-plugged-exit t]))
 169
 170 (eval-and-compile
 171   (if wl-on-xemacs
 172       (defun wl-plugged-setup-mouse ()
 173         (define-key wl-plugged-mode-map 'button2 'wl-plugged-click))
 174     (defun wl-plugged-setup-mouse ()
 175       (define-key wl-plugged-mode-map [mouse-2] 'wl-plugged-click))))
 176
 177 (unless wl-plugged-mode-map
 178   (setq wl-plugged-mode-map (make-sparse-keymap))
 179   (define-key wl-plugged-mode-map " "    'wl-plugged-toggle)
 180   (define-key wl-plugged-mode-map "\C-m" 'wl-plugged-toggle)
 181   (define-key wl-plugged-mode-map "\M-t" 'wl-plugged-toggle-all)
 182   (define-key wl-plugged-mode-map "q"    'wl-plugged-exit)
 183   (define-key wl-plugged-mode-map "\C-t" 'wl-plugged-exit)
 184   (define-key wl-plugged-mode-map "F"    'wl-plugged-flush-queue)
 185   (define-key wl-plugged-mode-map "P"    'wl-plugged-move-to-previous-server)
 186   (define-key wl-plugged-mode-map "N"    'wl-plugged-move-to-next-server)
 187   (define-key wl-plugged-mode-map "p"    'wl-plugged-move-to-previous)
 188   (define-key wl-plugged-mode-map "n"    'wl-plugged-move-to-next)
 189   (define-key wl-plugged-mode-map "\e\t" 'wl-plugged-move-to-previous)
 190   (define-key wl-plugged-mode-map "\t"   'wl-plugged-move-to-next)
 191   (wl-plugged-setup-mouse)
 192   (easy-menu-define
 193    wl-plugged-mode-menu
 194    wl-plugged-mode-map
 195    "Menu used in Plugged mode."
 196    wl-plugged-mode-menu-spec))
 197
 198 (defun wl-plugged-mode ()
 199   "Mode for setting Wanderlust plugged.
 200 See info under Wanderlust for full documentation.
 201
 202 Special commands:
 203 \\{wl-plugged-mode-map}
 204
 205 Entering Plugged mode calls the value of `wl-plugged-mode-hook'."
 206   (interactive)
 207   (kill-all-local-variables)
 208   (use-local-map wl-plugged-mode-map)
 209   (setq major-mode 'wl-plugged-mode)
 210   (setq mode-name "Plugged")
 211   (easy-menu-add wl-plugged-mode-menu)
 212   (wl-mode-line-buffer-identification)
 213   (setq wl-plugged-switch wl-plugged)
 214   (setq wl-plugged-alist-modified nil)
 215   (setq buffer-read-only t)
 216   (run-hooks 'wl-plugged-mode-hook))
 217
 218 (defmacro wl-plugged-string (plugged &optional time)
 219   `(if ,time wl-plugged-auto-off
 220      (if ,plugged
 221          wl-plugged-plug-on
 222        wl-plugged-plug-off)))
 223
 224 (defmacro wl-plugged-server-indent ()
 225   '(make-string wl-plugged-server-indent ? ))
 226
 227 (defun wl-plugged-set-variables ()
 228   (setq wl-plugged-sending-queue-alist
 229         (wl-plugged-sending-queue-info))
 230   (setq wl-plugged-dop-queue-alist
 231         (wl-plugged-dop-queue-info))
 232   (setq wl-plugged-alist
 233         (sort (copy-sequence elmo-plugged-alist)
 234               '(lambda (a b)
 235                  (string< (caar a) (caar b))))))
 236
 237 (defun wl-plugged-sending-queue-info ()
 238   ;; sending queue status
 239   (let (alist msgs sent-via server port)
 240     (setq msgs (elmo-folder-list-messages
 241                 (wl-folder-get-elmo-folder wl-queue-folder)))
 242     (while msgs
 243       (setq sent-via (wl-draft-queue-info-operation (car msgs) 'get-sent-via))
 244       (while sent-via
 245         (when (eq (nth 1 (car sent-via)) 'unplugged)
 246           (setq server (car (nth 2 (car sent-via)))
 247                 port (cdr (nth 2 (car sent-via))))
 248           (elmo-plugged-p server port)  ;; add elmo-plugged-alist if nothing.
 249           (setq alist
 250                 (wl-append-assoc-list
 251                  (cons server port)
 252                  (car msgs)
 253                  alist)))
 254         (setq sent-via (cdr sent-via)))
 255       (setq msgs (cdr msgs)))
 256     alist))
 257
 258 (defun wl-plugged-sending-queue-status (qinfo)
 259   ;; sending queue status
 260   (let ((len (length (cdr qinfo))))
 261     (concat (wl-plugged-set-folder-icon
 262              wl-queue-folder
 263              (wl-folder-get-petname wl-queue-folder))
 264             (if (> len 1)
 265                 (format ": %d msgs (" len)
 266               (format ": %d msg (" len))
 267             (mapconcat (function int-to-string) (cdr qinfo) ",")
 268             ")")))
 269
 270 (defun wl-plugged-dop-queue-info ()
 271   ;; dop queue status
 272   (let* ((count 0)
 273          (elmo-dop-queue (copy-sequence elmo-dop-queue))
 274          dop-queue last alist server-info
 275          ope operation)
 276     ;(elmo-dop-queue-load)
 277     (elmo-dop-queue-merge)
 278     (setq dop-queue (sort elmo-dop-queue '(lambda (a b)
 279                                             (string< (elmo-dop-queue-fname a)
 280                                                      (elmo-dop-queue-fname b)))))
 281     (wl-append dop-queue (list nil)) ;; terminate(dummy)
 282     (when (car dop-queue)
 283       (setq last (elmo-dop-queue-fname (car dop-queue)))) ;; first
 284     (while dop-queue
 285       (when (car dop-queue)
 286         (setq ope (cons (elmo-dop-queue-method-name (car dop-queue))
 287                         (length
 288                          (if (listp
 289                               (car
 290                                (elmo-dop-queue-arguments (car dop-queue))))
 291                              (car (elmo-dop-queue-arguments
 292                                    (car dop-queue))))))))
 293       (if (and (car dop-queue)
 294                (string= last (elmo-dop-queue-fname (car dop-queue))))
 295           (wl-append operation (list ope))
 296         ;;(setq count (1+ count))
 297         (when (and last (setq server-info (elmo-net-port-info
 298                                            (wl-folder-get-elmo-folder last))))
 299           (setq alist
 300                 (wl-append-assoc-list
 301                  server-info
 302                  (cons last operation)
 303                  alist)))
 304         (when (car dop-queue)
 305           (setq last (elmo-dop-queue-fname (car dop-queue))
 306                 operation (list ope))))
 307       (setq dop-queue (cdr dop-queue)))
 308     alist))
 309
 310 (defun wl-plugged-dop-queue-status (qinfo &optional column)
 311   ;; dop queue status
 312   (let ((operations (cdr qinfo))
 313         (column (or column wl-plugged-queue-status-column)))
 314     (mapconcat
 315      '(lambda (folder-ope)
 316         (concat (wl-plugged-set-folder-icon
 317                  (car folder-ope)
 318                  (wl-folder-get-petname (car folder-ope)))
 319                 "("
 320                 (let ((opes (cdr folder-ope))
 321                       pair shrinked)
 322                   (while opes
 323                     (if (setq pair (assoc (car (car opes)) shrinked))
 324                         (setcdr pair (+ (cdr pair)
 325                                         (max (cdr (car opes)) 1)))
 326                       (setq shrinked (cons
 327                                       (cons (car (car opes))
 328                                             (max (cdr (car opes)) 1))
 329                                       shrinked)))
 330                     (setq opes (cdr opes)))
 331                   (mapconcat
 332                    '(lambda (ope)
 333                       (if (> (cdr ope) 0)
 334                           (format "%s:%d" (car ope) (cdr ope))
 335                         (format "%s" (car ope))))
 336                    (nreverse shrinked) ","))
 337                 ")"))
 338      operations
 339      (concat "\n" (wl-set-string-width column "")))))
 340
 341 (defun wl-plugged-drawing (plugged-alist)
 342   (let ((buffer-read-only nil)
 343         (alist plugged-alist)
 344         (vars wl-plugged-switch-variables)
 345         last server port stream-type label plugged time
 346         line len qinfo column)
 347     (erase-buffer)
 348     (while vars
 349       (insert (format "%s:[%s]%s"
 350                       (caar vars)
 351                       (wl-plugged-string (symbol-value (cdar vars)))
 352                       (if (cdr vars) " " "")))
 353       (setq vars (cdr vars)))
 354     (insert "\n")
 355     (let ((elmo-plugged wl-plugged-switch))
 356       (setq line (format "[%s](wl-plugged)"
 357                          (wl-plugged-string (elmo-plugged-p))))
 358       ;; sending queue status
 359       (when (setq qinfo (assoc (cons nil nil) wl-plugged-sending-queue-alist))
 360         (setq line (concat
 361                     (wl-set-string-width wl-plugged-queue-status-column line)
 362                     (wl-plugged-sending-queue-status qinfo))))
 363       (insert line "\n"))
 364     (while alist
 365       (setq server (nth 0 (caar alist))
 366             port (nth 1 (caar alist))
 367             stream-type (nth 2 (caar alist))
 368             label (nth 1 (car alist))
 369             plugged (nth 2 (car alist))
 370             time (nth 3 (car alist)))
 371       (unless (string= last server)
 372         ;; server plug
 373         (insert (format "%s[%s]%s\n"
 374                         (wl-plugged-server-indent)
 375                         (wl-plugged-string
 376                          (elmo-plugged-p server nil plugged-alist))
 377                         server))
 378         (setq last server))
 379       ;; port plug
 380       (setq line
 381             (format "%s[%s]%s"
 382                     (make-string wl-plugged-port-indent ? )
 383                     (wl-plugged-string plugged time)
 384                     (cond
 385                      ((stringp port)
 386                       port)
 387                      (t
 388                       (format "%s(%d)"
 389                               (or label
 390                                   (cdr (assq port wl-plugged-port-label-alist))
 391                                   "")
 392                               port)))))
 393       (setq column (max (if line (1+ (string-width line)) 0)
 394                         wl-plugged-queue-status-column))
 395       (cond
 396        ;; sending queue status
 397        ((setq qinfo (assoc (cons server port) wl-plugged-sending-queue-alist))
 398         (setq line
 399               (concat
 400                (wl-set-string-width column line)
 401                (wl-plugged-sending-queue-status qinfo))))
 402        ;; dop queue status
 403        ((setq qinfo (assoc (list server port stream-type)
 404                            wl-plugged-dop-queue-alist))
 405         (setq line
 406               (concat
 407                (wl-set-string-width column line)
 408                (wl-plugged-dop-queue-status qinfo column)))))
 409       (insert line "\n")
 410       (setq alist (cdr alist)))
 411     (delete-region (1- (point-max)) (point-max)) ;; delete line at the end.
 412     (goto-char (point-min))
 413     (while (not (eobp))
 414       (wl-highlight-plugged-current-line)
 415       (forward-line 1)))
 416   (set-buffer-modified-p nil)
 417   (count-lines (point-min) (point-max)))
 418
 419 (defun wl-plugged-redrawing-switch (indent switch &optional time)
 420   (beginning-of-line)
 421   (when (re-search-forward
 422          (format "^%s\\[\\([^]]+\\)\\]" (make-string indent ? )))
 423     (goto-char (match-beginning 1))
 424     (delete-region (match-beginning 1) (match-end 1))
 425     (insert (wl-plugged-string switch time))
 426     (wl-highlight-plugged-current-line)
 427     (forward-line 1)))
 428
 429 (defun wl-plugged-redrawing (plugged-alist)
 430   (let ((buffer-read-only nil)
 431         (alist plugged-alist)
 432         last server port plugged time)
 433     (goto-char (point-min))
 434     (wl-plugged-redrawing-switch 0 (elmo-plugged-p))
 435     (while alist
 436       (setq server (caaar alist)
 437             port (cdaar alist)
 438             plugged (nth 2 (car alist))
 439             time (nth 3 (car alist)))
 440       (unless (string= last server)
 441         ;; server plug
 442         (wl-plugged-redrawing-switch
 443          wl-plugged-server-indent
 444          (elmo-plugged-p server nil plugged-alist))
 445         (setq last server))
 446       ;; port plug
 447       (wl-plugged-redrawing-switch
 448        wl-plugged-port-indent plugged time)
 449       (setq alist (cdr alist))))
 450   (sit-for 0)
 451   (set-buffer-modified-p nil))
 452
 453 (defun wl-plugged-change ()
 454   (interactive)
 455   (if (not elmo-plugged-alist)
 456       (message "No plugged info")
 457     (setq wl-plugged-winconf (current-window-configuration))
 458     (let* ((cur-win (selected-window))
 459            (max-lines (if (eq major-mode 'wl-summary-mode)
 460                           (/ (frame-height) 2)
 461                         (window-height)))
 462            window-lines lines)
 463       (with-current-buffer (get-buffer-create wl-plugged-buf-name)
 464         (wl-plugged-mode)
 465         (buffer-disable-undo (current-buffer))
 466         (delete-windows-on (current-buffer))
 467         (wl-plugged-set-variables)
 468         (setq lines (wl-plugged-drawing wl-plugged-alist)))
 469       (select-window cur-win)
 470       (setq window-lines (min max-lines (max lines window-min-height)))
 471       (when (> (- (window-height) window-lines) window-min-height)
 472         (split-window cur-win (- (window-height) window-lines)))
 473       (switch-to-buffer wl-plugged-buf-name)
 474       (condition-case nil
 475           (progn
 476             (enlarge-window (- window-lines (window-height)))
 477             (when (fboundp 'pos-visible-in-window-p)
 478               (goto-char (point-min))
 479               (while (and (< (window-height) max-lines)
 480                           (not (pos-visible-in-window-p (1- (point-max)))))
 481                 (enlarge-window 2))))
 482         (error))
 483       (goto-char (point-min))
 484       (forward-line 1)
 485       (wl-plugged-move-to-next)))) ;; goto first entry
 486
 487 (defsubst wl-plugged-get-server ()
 488   (save-excursion
 489     (end-of-line)
 490     (wl-plugged-move-to-previous-server)
 491     (beginning-of-line)
 492     (when (looking-at (format "^%s\\[[^]]+\\]\\(.*\\)"
 493                               (wl-plugged-server-indent)))
 494       (elmo-match-buffer 1))))
 495
 496 (defun wl-plugged-toggle ()
 497   (interactive)
 498   (let ((cur-point (point)))
 499     (save-excursion
 500       (beginning-of-line)
 501       (cond
 502        ;; switch variable
 503        ((bobp)
 504         (let (variable switch name)
 505           (goto-char cur-point)
 506           (when (and (not (bobp))
 507                      (not (eq (char-before) ? )))
 508             (if (re-search-backward " [^ ]+" nil t)
 509                 (forward-char 1)
 510               (re-search-backward "^[^ ]+" nil t)))
 511           (when (looking-at "\\([^ :[]+\\):?\\[\\([^]]+\\)\\]")
 512             (setq name (elmo-match-buffer 1))
 513             (setq switch (not (string= (elmo-match-buffer 2) wl-plugged-plug-on)))
 514             (when (setq variable (cdr (assoc name wl-plugged-switch-variables)))
 515               (set variable switch))
 516             (goto-char (match-beginning 2))
 517             (let ((buffer-read-only nil))
 518               (delete-region (match-beginning 2) (match-end 2))
 519               (insert (wl-plugged-string switch))
 520               (set-buffer-modified-p nil)))))
 521        ;; switch plug
 522        ((looking-at "^\\( *\\)\\[\\([^]]+\\)\\]\\([^ \n]*\\)")
 523         (let* ((indent (length (elmo-match-buffer 1)))
 524                (switch (elmo-match-buffer 2))
 525                (name (elmo-match-buffer 3))
 526                (plugged (not (string= switch wl-plugged-plug-on)))
 527                (alist wl-plugged-alist)
 528                server port stream-type name-1)
 529           (cond
 530            ((eq indent wl-plugged-port-indent)  ;; toggle port plug
 531             (cond
 532              ((string-match "\\([^([]*\\)(\\([^)[]+\\))" name)
 533               (setq port (string-to-number (elmo-match-string 2 name)))
 534               (if (string-match "!" (setq name-1 (elmo-match-string 1 name)))
 535                   (setq stream-type
 536                         (intern (substring name-1 (match-end 0))))))
 537              (t
 538               (setq port name)))
 539             (setq server (wl-plugged-get-server))
 540             (elmo-set-plugged plugged server port stream-type nil alist))
 541            ((eq indent wl-plugged-server-indent)  ;; toggle server plug
 542             (elmo-set-plugged plugged name nil nil nil alist))
 543            ((eq indent 0)  ;; toggle all plug
 544             (elmo-set-plugged plugged nil nil nil nil alist)))
 545           ;; redraw
 546           (wl-plugged-redrawing wl-plugged-alist)
 547           ;; show plugged status in modeline
 548           (let ((elmo-plugged wl-plugged-switch))
 549             (setq wl-plugged-switch (elmo-plugged-p)
 550                   wl-modeline-plug-status wl-plugged-switch)
 551             (force-mode-line-update t))))))
 552     (setq wl-plugged-alist-modified t)
 553     (goto-char cur-point)))
 554
 555 (defun wl-plugged-click (e)
 556   (interactive "e")
 557   (mouse-set-point e)
 558   (wl-plugged-toggle))
 559
 560 (defun wl-plugged-toggle-all ()
 561   (interactive)
 562   (let ((cur-point (point)))
 563     (setq wl-plugged-switch (not wl-plugged-switch))
 564     (elmo-set-plugged wl-plugged-switch nil nil nil nil wl-plugged-alist)
 565     (wl-plugged-redrawing wl-plugged-alist)
 566     (goto-char cur-point)
 567     (setq wl-plugged-alist-modified t)
 568     ;; show plugged status in modeline
 569     (setq wl-modeline-plug-status wl-plugged-switch)
 570     (force-mode-line-update t)))
 571
 572 (defun wl-plugged-exit ()
 573   (interactive)
 574   (setq ;;elmo-plugged-alist wl-plugged-alist
 575         wl-plugged wl-plugged-switch
 576         wl-plugged-alist nil
 577         wl-plugged-sending-queue-alist nil
 578         wl-plugged-dop-queue-alist nil)
 579   (run-hooks 'wl-plugged-exit-hook)
 580   (when wl-plugged-alist-modified
 581     (wl-toggle-plugged (if wl-plugged 'on 'off) t))
 582   (kill-buffer (current-buffer))
 583   (if wl-plugged-winconf
 584       (set-window-configuration wl-plugged-winconf)))
 585
 586 (defun wl-plugged-flush-queue ()
 587   (interactive)
 588   (let ((cur-point (point))
 589         (dop-status (elmo-dop-queue-flush))
 590         (send-status (wl-draft-queue-flush)))
 591     (unless (or dop-status send-status)
 592       (message "No processing queue."))
 593     (wl-plugged-set-variables)
 594     (wl-plugged-drawing wl-plugged-alist)
 595     (goto-char cur-point)))
 596
 597 (defun wl-plugged-move-to-next ()
 598   (interactive)
 599   (when (re-search-forward "\\[\\([^]]+\\)\\]" nil t)
 600     (let ((pos (match-beginning 1)))
 601       (if (invisible-p pos)
 602           (goto-char (next-visible-point pos))
 603         (goto-char pos)))))
 604
 605 (defun wl-plugged-move-to-previous ()
 606   (interactive)
 607   (if (eq (char-before) ?\]) (forward-char -1))
 608   (when (re-search-backward "\\[\\([^]]+\\)\\]" nil t)
 609     (let ((pos (match-beginning 1)))
 610       (if (invisible-p pos)
 611           (goto-char (next-visible-point pos))
 612         (goto-char pos)))))
 613
 614 (defun wl-plugged-move-to-next-server ()
 615   (interactive)
 616   (let ((regexp
 617          (format "^%s\\[\\([^]]+\\)\\]" (wl-plugged-server-indent)))
 618         point)
 619     (save-excursion
 620       (end-of-line)
 621       (if (re-search-forward regexp nil t)
 622           (setq point (match-beginning 1))))
 623     (if point (goto-char point))))
 624
 625 (defun wl-plugged-move-to-previous-server ()
 626   (interactive)
 627   (let ((regexp
 628          (format "^%s\\[\\([^]]+\\)\\]" (wl-plugged-server-indent))))
 629     (if (re-search-backward regexp nil t)
 630         (goto-char (match-beginning 1)))))
 631
 632 ;;; end of wl-plugged-mode
 633
 634 (defun wl-save ()
 635   "Save summary and folder status."
 636   (interactive)
 637   (wl-save-status 'keep-summary)
 638   (run-hooks 'wl-save-hook))
 639
 640 (defun wl-execute-temp-marks ()
 641   "Execute temporary marks in summary buffers."
 642   (interactive)
 643   (let ((summaries (wl-collect-summary)))
 644     (while summaries
 645       (with-current-buffer (car summaries)
 646         (wl-summary-exec-with-confirmation)
 647         (wl-summary-save-status))
 648       (setq summaries (cdr summaries)))))
 649
 650 (defun wl-save-status (&optional keep-summary)
 651   (message "Saving summary and folder status...")
 652   (save-excursion
 653     (let ((summaries (wl-collect-summary)))
 654       (while summaries
 655         (with-current-buffer (car summaries)
 656           (unless keep-summary
 657             (wl-summary-cleanup-temp-marks))
 658           (wl-summary-save-view)
 659           (elmo-folder-commit wl-summary-buffer-elmo-folder)
 660           (unless keep-summary
 661             (kill-buffer (car summaries))))
 662         (setq summaries (cdr summaries)))))
 663   (wl-refile-alist-save)
 664   (wl-folder-info-save)
 665   (and (featurep 'wl-fldmgr) (wl-fldmgr-exit))
 666   (and (featurep 'wl-spam) (wl-spam-save-status))
 667   (elmo-crosspost-message-alist-save)
 668   (message "Saving summary and folder status...done"))
 669
 670 (defun wl-exit ()
 671   (interactive)
 672   (when (or (not wl-interactive-exit)
 673             (y-or-n-p "Do you really want to quit Wanderlust? "))
 674     (elmo-quit)
 675     (when wl-use-acap (funcall (symbol-function 'wl-acap-exit)))
 676     (wl-biff-stop)
 677     (elmo-clear-signal-slots)
 678     (run-hooks 'wl-exit-hook)
 679     (wl-save-status)
 680     (wl-folder-cleanup-variables)
 681     (wl-message-buffer-cache-clean-up)
 682     (wl-kill-buffers
 683      (format "^\\(%s\\)$"
 684              (mapconcat 'identity
 685                         (list wl-folder-buffer-name
 686                               wl-plugged-buf-name)
 687                         "\\|")))
 688     (when wl-delete-startup-frame-function
 689       (funcall wl-delete-startup-frame-function))
 690 ;;    (if (and wl-folder-use-frame
 691 ;;           (> (length (visible-frame-list)) 1))
 692 ;;      (delete-frame))
 693     (setq wl-init nil)
 694     (remove-hook 'kill-emacs-hook 'wl-save-status)
 695     (elmo-passwd-alist-clear)
 696     t)
 697   (message "") ; empty minibuffer.
 698   )
 699
 700 (defun wl-init ()
 701   (when (not wl-init)
 702     (require 'mime-setup)
 703     (setq elmo-plugged wl-plugged)
 704     (add-hook 'kill-emacs-hook 'wl-save-status)
 705     (wl-address-init)
 706     (wl-draft-setup)
 707     (wl-refile-alist-setup)
 708     (require 'wl-mime)
 709     ;; defined above.
 710     (wl-mime-setup)
 711     (fset 'wl-summary-from-func-internal
 712           (symbol-value 'wl-summary-from-function))
 713     (fset 'wl-summary-subject-func-internal
 714           (symbol-value 'wl-summary-subject-function))
 715     (fset 'wl-summary-subject-filter-func-internal
 716           (symbol-value 'wl-summary-subject-filter-function))
 717     (wl-summary-define-sort-command)
 718     (wl-summary-define-mark-action)
 719     (dolist (spec wl-summary-flag-alist)
 720       (set-face-foreground
 721        (make-face (intern
 722                    (format "wl-highlight-summary-%s-flag-face" (car spec))))
 723        (nth 1 spec)))
 724     (setq elmo-get-folder-function #'wl-folder-make-elmo-folder
 725           elmo-progress-callback-function #'wl-progress-callback-function)
 726     (setq elmo-no-from wl-summary-no-from-message)
 727     (setq elmo-no-subject wl-summary-no-subject-message)
 728     (elmo-global-flags-initialize (mapcar 'car wl-summary-flag-alist))
 729     (elmo-connect-signal
 730      nil
 731      'message-number-changed
 732      'wl-draft
 733      (elmo-define-signal-handler (listener folder old-number new-number)
 734        (dolist (buffer (wl-collect-draft))
 735          (with-current-buffer buffer
 736            (wl-draft-buffer-change-number old-number new-number)))
 737        (wl-draft-rename-saved-config old-number new-number))
 738      (elmo-define-signal-filter (listener folder old-number new-number)
 739        (and folder
 740             (string= (elmo-folder-name-internal folder) wl-draft-folder))))
 741     (wl-news-check)
 742     (setq wl-init t)
 743     ;; This hook may contain the functions `wl-plugged-init-icons' and
 744     ;; `wl-biff-init-icons' for reasons of system internal to accord
 745     ;; facilities for the Emacs variants.
 746     (run-hooks 'wl-init-hook)))
 747
 748 (defun wl-check-environment (no-check-folder)
 749   (unless wl-from (error "Please set `wl-from' to your mail address"))
 750   ;; Message-ID
 751   (when wl-insert-message-id
 752     (let ((message-id (funcall wl-message-id-function))
 753           domain)
 754       (unless (string-match "^<\\([^@]*\\)@\\([^@]*\\)>$" message-id)
 755         (cond
 756          ((string-match "@" wl-message-id-domain)
 757           (error "Please remove `@' from `wl-message-id-domain'"))
 758          (t
 759           (error
 760            "Check around `wl-message-id-function' to get valid Message-ID string"))))
 761       (setq domain (match-string 2 message-id))
 762       (if (or (not (string-match "[^.]\\.[^.]" domain))
 763               (string= domain "localhost.localdomain"))
 764           (elmo-warning
 765            "Please set `wl-message-id-domain' to get valid Message-ID string."))))
 766   ;; folders
 767   (when (not no-check-folder)
 768     (let ((draft-folder (wl-folder-get-elmo-folder wl-draft-folder))
 769           (queue-folder (wl-folder-get-elmo-folder wl-queue-folder))
 770           (lost+found-folder (wl-folder-get-elmo-folder
 771                               elmo-lost+found-folder)))
 772       (unless (elmo-folder-exists-p draft-folder)
 773         (if (y-or-n-p
 774              (format "Draft Folder %s does not exist, create it? "
 775                      wl-draft-folder))
 776             (elmo-folder-create draft-folder)
 777           (error "Draft Folder is not created")))
 778       (if (and wl-draft-enable-queuing
 779                (not (elmo-folder-exists-p queue-folder)))
 780           (if (y-or-n-p
 781                (format "Queue Folder %s does not exist, create it? "
 782                        wl-queue-folder))
 783               (elmo-folder-create queue-folder)
 784             (error "Queue Folder is not created")))
 785       (when (not (eq no-check-folder 'wl-draft))
 786         (unless (elmo-folder-exists-p lost+found-folder)
 787           (elmo-folder-create lost+found-folder)))
 788       ;; tmp dir
 789       (unless (file-exists-p wl-temporary-file-directory)
 790         (if (y-or-n-p
 791              (format "Temp directory (to save multipart) %s does not exist, create it now? "
 792                      wl-temporary-file-directory))
 793             (make-directory wl-temporary-file-directory)
 794           (error "Temp directory is not created"))))))
 795
 796 (defconst wl-check-variables-alist
 797   '((numberp . elmo-pop3-default-port)
 798     (symbolp . elmo-pop3-default-authenticate-type)
 799     (numberp . elmo-imap4-default-port)
 800     (symbolp . elmo-imap4-default-authenticate-type)
 801     (numberp . elmo-nntp-default-port)
 802     (numberp . wl-pop-before-smtp-port)
 803     (symbolp . wl-pop-before-smtp-authenticate-type)))
 804
 805 (defun wl-check-variables ()
 806   (let ((type-variables wl-check-variables-alist)
 807         type)
 808     (while (setq type (car type-variables))
 809       (if (and (eval (cdr type))
 810                (not (funcall (car type)
 811                              (eval (cdr type)))))
 812           (error "%s must be %s: %S"
 813                  (cdr type)
 814                  (substring (format "%s" (car type)) 0 -1)
 815                  (eval (cdr type))))
 816       (setq type-variables (cdr type-variables)))))
 817
 818 (defun wl-check-variables-2 ()
 819   (if (< wl-message-buffer-cache-size 1)
 820       (error "`wl-message-buffer-cache-size' must be larger than 0"))
 821   (when wl-message-buffer-prefetch-depth
 822     (if (not (< wl-message-buffer-prefetch-depth
 823                 wl-message-buffer-cache-size))
 824         (error (concat
 825                 "`wl-message-buffer-prefetch-depth' must be smaller than "
 826                 "`wl-message-buffer-cache-size' - 1.")))))
 827
 828 ;;;###autoload
 829 (defun wl (&optional arg)
 830   "Start Wanderlust -- Yet Another Message Interface On Emacsen.
 831 If ARG (prefix argument) is specified, folder checkings are skipped."
 832   (interactive "P")
 833   (unless wl-init
 834     (wl-load-profile)
 835     (elmo-init))
 836   (let (demo-buf check)
 837     (unless wl-init
 838       (if wl-demo (setq demo-buf (wl-demo)))
 839       (setq check t))
 840     (wl-init)
 841     (condition-case obj
 842         (progn
 843           (if check
 844               (progn
 845                 (message "Checking environment...")
 846                 (wl-check-environment arg)
 847                 (message "Checking environment...done")
 848                 (message "Checking type of variables...")
 849                 (wl-check-variables)
 850                 (wl-check-variables-2)
 851                 (message "Checking type of variables...done")))
 852           (let ((inhibit-quit t))
 853             (wl-plugged-init (wl-folder)))
 854           (unless arg
 855             (run-hooks 'wl-auto-check-folder-pre-hook)
 856             (wl-folder-auto-check)
 857             (run-hooks 'wl-auto-check-folder-hook)))
 858       (error
 859        (if (buffer-live-p demo-buf)
 860            (kill-buffer demo-buf))
 861        (signal (car obj)(cdr obj)))
 862       (quit))
 863     (when wl-biff-check-folder-list
 864       (unless arg (wl-biff-check-folders))
 865       (wl-biff-start))
 866     (if (buffer-live-p demo-buf)
 867         (kill-buffer demo-buf)))
 868   (run-hooks 'wl-hook))
 869
 870 (defvar wl-delete-startup-frame-function nil)
 871
 872 ;;;###autoload
 873 (defun wl-other-frame (&optional arg)
 874   "Pop up a frame to read messages via Wanderlust."
 875   (interactive)
 876   (if wl-folder-use-frame
 877       (wl arg)
 878     (let ((focusing-functions (append '(raise-frame select-frame)
 879                                       (if (fboundp 'x-focus-frame)
 880                                           '(x-focus-frame)
 881                                         '(focus-frame))))
 882           (folder (get-buffer wl-folder-buffer-name))
 883           window frame wl-folder-use-frame)
 884       (if (and folder
 885                (setq window (get-buffer-window folder t))
 886                (window-live-p window)
 887                (setq frame (window-frame window)))
 888           (progn
 889             (while focusing-functions
 890               (funcall (car focusing-functions) frame)
 891               (setq focusing-functions (cdr focusing-functions)))
 892             (wl arg))
 893         (setq frame (make-frame))
 894         (while focusing-functions
 895           (funcall (car focusing-functions) frame)
 896           (setq focusing-functions (cdr focusing-functions)))
 897         (setq wl-delete-startup-frame-function
 898               `(lambda ()
 899                  (setq wl-delete-startup-frame-function nil)
 900                  (let ((frame ,frame))
 901                    (if (eq (selected-frame) frame)
 902                        (delete-frame frame)))))
 903         (wl arg)))))
 904
 905 ;; Define some autoload functions WL might use.
 906 (eval-and-compile
 907   ;; This little mapcar goes through the list below and marks the
 908   ;; symbols in question as autoloaded functions.
 909   (mapcar
 910    (function
 911     (lambda (package)
 912       (let ((interactive (nth 1 (memq ':interactive package))))
 913         (mapcar
 914          (function
 915           (lambda (function)
 916             (let (keymap)
 917               (when (consp function)
 918                 (setq keymap (car (memq 'keymap function)))
 919                 (setq function (car function)))
 920               (autoload function (car package) nil interactive keymap))))
 921          (if (eq (nth 1 package) ':interactive)
 922              (cdddr package)
 923            (cdr package))))))
 924    '(("wl-fldmgr" :interactive t
 925       wl-fldmgr-access-display-all wl-fldmgr-access-display-normal
 926       wl-fldmgr-add wl-fldmgr-clear-cut-entity-list wl-fldmgr-copy
 927       wl-fldmgr-copy-region wl-fldmgr-cut wl-fldmgr-cut-region
 928       wl-fldmgr-make-access-group wl-fldmgr-make-filter
 929       wl-fldmgr-make-group wl-fldmgr-make-multi
 930       wl-fldmgr-reconst-entity-hashtb wl-fldmgr-rename wl-fldmgr-delete
 931       wl-fldmgr-save-folders wl-fldmgr-set-petname wl-fldmgr-sort
 932       wl-fldmgr-subscribe wl-fldmgr-subscribe-region
 933       wl-fldmgr-unsubscribe wl-fldmgr-unsubscribe-region wl-fldmgr-yank )
 934      ("wl-acap" wl-acap-init)
 935      ("wl-acap" :interactive t wl-acap-store)
 936      ("wl-fldmgr"
 937       (wl-fldmgr-mode-map keymap)
 938       wl-fldmgr-add-entity-hashtb)
 939      ("wl-expire" :interactive t
 940       wl-folder-archive-current-entity
 941       wl-folder-expire-current-entity wl-summary-archive
 942       wl-summary-expire )
 943      ("wl-score"
 944       wl-score-save wl-summary-rescore-msgs wl-summary-score-headers
 945       wl-summary-score-update-all-lines )
 946      ("wl-score" :interactive t
 947       wl-score-change-score-file wl-score-edit-current-scores
 948       wl-score-edit-file wl-score-flush-cache wl-summary-rescore
 949       wl-score-set-mark-below wl-score-set-expunge-below
 950       wl-summary-increase-score wl-summary-lower-score )
 951      ("wl-draft" wl-draft-rename-saved-config))))
 952
 953 ;; for backward compatibility
 954 (defalias 'wl-summary-from-func-petname 'wl-summary-default-from)
 955
 956 (require 'product)
 957 (product-provide (provide 'wl) (require 'wl-version))
 958
 959 ;;; wl.el ends here