wl/wl.el

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