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