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