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     (when wl-delete-startup-frame-function
 670       (funcall wl-delete-startup-frame-function))
 671 ;;    (if (and wl-folder-use-frame
 672 ;;           (> (length (visible-frame-list)) 1))
 673 ;;      (delete-frame))
 674     (setq wl-init nil)
 675     (remove-hook 'kill-emacs-hook 'wl-save-status)
 676     t)
 677   (message "") ; empty minibuffer.
 678   )
 679
 680 (defun wl-init ()
 681   (when (not wl-init)
 682     (require 'mime-setup)
 683     (setq elmo-plugged wl-plugged)
 684     (add-hook 'kill-emacs-hook 'wl-save-status)
 685     (wl-address-init)
 686     (wl-draft-setup)
 687     (wl-refile-alist-setup)
 688     (require 'wl-mime)
 689     ;; defined above.
 690     (wl-mime-setup)
 691     (fset 'wl-summary-from-func-internal
 692           (symbol-value 'wl-summary-from-function))
 693     (fset 'wl-summary-subject-func-internal
 694           (symbol-value 'wl-summary-subject-function))
 695     (fset 'wl-summary-subject-filter-func-internal
 696           (symbol-value 'wl-summary-subject-filter-function))
 697     (setq elmo-no-from wl-summary-no-from-message)
 698     (setq elmo-no-subject wl-summary-no-subject-message)
 699     (setq wl-init t)
 700     ;; This hook may contain the functions `wl-plugged-init-icons' and
 701     ;; `wl-biff-init-icons' for reasons of system internal to accord
 702     ;; facilities for the Emacs variants.
 703     (run-hooks 'wl-init-hook)))
 704
 705 (defun wl-check-environment (no-check-folder)
 706   (unless wl-from (error "Please set `wl-from' to your mail address."))
 707   ;; Message-ID
 708   (when wl-insert-message-id
 709     (let ((message-id (funcall wl-message-id-function))
 710           domain)
 711       (unless (string-match "^<\\([^@]*\\)@\\([^@]*\\)>$" message-id)
 712         (cond
 713          ((string-match "@" wl-message-id-domain)
 714           (error "Please remove `@' from `wl-message-id-domain'."))
 715          (t
 716           (error
 717            "Check around `wl-message-id-function' to get valid Message-ID string."))))
 718       (setq domain (match-string 2 message-id))
 719       (if (or (not (string-match "[^.]\\.[^.]" domain))
 720               (string= domain "localhost.localdomain"))
 721           (elmo-warning
 722            "Please set `wl-message-id-domain' to get valid Message-ID string."))))
 723   ;; folders
 724   (when (not no-check-folder)
 725     (let ((draft-folder (wl-folder-get-elmo-folder wl-draft-folder))
 726           (queue-folder (wl-folder-get-elmo-folder wl-queue-folder))
 727           (lost+found-folder (wl-folder-get-elmo-folder
 728                               elmo-lost+found-folder)))
 729       (if (not (elmo-folder-message-file-p draft-folder))
 730           (error "%s is not allowed for draft folder" wl-draft-folder))
 731       (unless (elmo-folder-exists-p draft-folder)
 732         (if (y-or-n-p
 733              (format "Draft Folder %s does not exist, create it? "
 734                      wl-draft-folder))
 735             (elmo-folder-create draft-folder)
 736           (error "Draft Folder is not created")))
 737       (if (and wl-draft-enable-queuing
 738                (not (elmo-folder-exists-p queue-folder)))
 739           (if (y-or-n-p
 740                (format "Queue Folder %s does not exist, create it? "
 741                        wl-queue-folder))
 742               (elmo-folder-create queue-folder)
 743             (error "Queue Folder is not created")))
 744       (when (not (eq no-check-folder 'wl-draft))
 745         (unless (elmo-folder-exists-p lost+found-folder)
 746           (elmo-folder-create lost+found-folder)))
 747       ;; tmp dir
 748       (unless (file-exists-p wl-temporary-file-directory)
 749         (if (y-or-n-p
 750              (format "Temp directory (to save multipart) %s does not exist, create it now? "
 751                      wl-temporary-file-directory))
 752             (make-directory wl-temporary-file-directory)
 753           (error "Temp directory is not created"))))))
 754
 755 (defconst wl-check-variables-alist
 756   '((numberp . elmo-pop3-default-port)
 757     (symbolp . elmo-pop3-default-authenticate-type)
 758     (numberp . elmo-imap4-default-port)
 759     (symbolp . elmo-imap4-default-authenticate-type)
 760     (numberp . elmo-nntp-default-port)
 761     (numberp . wl-pop-before-smtp-port)
 762     (symbolp . wl-pop-before-smtp-authenticate-type)))
 763
 764 (defun wl-check-variables ()
 765   (let ((type-variables wl-check-variables-alist)
 766         type)
 767     (while (setq type (car type-variables))
 768       (if (and (eval (cdr type))
 769                (not (funcall (car type)
 770                              (eval (cdr type)))))
 771           (error "%s must be %s: %S"
 772                  (cdr type)
 773                  (substring (format "%s" (car type)) 0 -1)
 774                  (eval (cdr type))))
 775       (setq type-variables (cdr type-variables)))))
 776
 777 (defun wl-check-variables-2 ()
 778   (if (< wl-message-buffer-cache-size 1)
 779       (error "`wl-message-buffer-cache-size' must be larger than 0."))
 780   (when wl-message-buffer-prefetch-depth
 781     (if (not (< wl-message-buffer-prefetch-depth
 782                 wl-message-buffer-cache-size))
 783         (error (concat
 784                 "`wl-message-buffer-prefetch-depth' must be smaller than "
 785                 "`wl-message-buffer-cache-size' - 1.")))))
 786
 787 ;;;###autoload
 788 (defun wl (&optional arg)
 789   "Start Wanderlust -- Yet Another Message Interface On Emacsen.
 790 If ARG (prefix argument) is specified, folder checkings are skipped."
 791   (interactive "P")
 792   (unless wl-init
 793     (wl-load-profile)
 794     (wl-folder-init)
 795     (elmo-init))
 796   (let (demo-buf check)
 797     (unless wl-init
 798       (if wl-demo (setq demo-buf (wl-demo)))
 799       (setq check t))
 800     (wl-init)
 801     (condition-case obj
 802         (progn
 803           (if check
 804               (progn
 805                 (message "Checking environment...")
 806                 (wl-check-environment arg)
 807                 (message "Checking environment...done")
 808                 (message "Checking type of variables...")
 809                 (wl-check-variables)
 810                 (wl-check-variables-2)
 811                 (message "Checking type of variables...done")))
 812           (let ((inhibit-quit t))
 813             (wl-plugged-init (wl-folder arg)))
 814           (unless arg
 815             (run-hooks 'wl-auto-check-folder-pre-hook)
 816             (wl-folder-auto-check)
 817             (run-hooks 'wl-auto-check-folder-hook))
 818           (unless arg (wl-biff-start)))
 819       (error
 820        (if (buffer-live-p demo-buf)
 821            (kill-buffer demo-buf))
 822        (setq wl-init nil)
 823        (signal (car obj)(cdr obj)))
 824       (quit))
 825     (if (buffer-live-p demo-buf)
 826         (kill-buffer demo-buf)))
 827   (run-hooks 'wl-hook))
 828
 829 (defvar wl-delete-startup-frame-function nil)
 830
 831 ;;;###autoload
 832 (defun wl-other-frame (&optional arg)
 833   "Pop up a frame to read messages via Wanderlust."
 834   (interactive)
 835   (if wl-folder-use-frame
 836       (wl arg)
 837     (let ((focusing-functions (append '(raise-frame select-frame)
 838                                       (if (fboundp 'x-focus-frame)
 839                                           '(x-focus-frame)
 840                                         '(focus-frame))))
 841           (folder (get-buffer wl-folder-buffer-name))
 842           window frame wl-folder-use-frame)
 843       (if (and folder
 844                (setq window (get-buffer-window folder t))
 845                (window-live-p window)
 846                (setq frame (window-frame window)))
 847           (progn
 848             (while focusing-functions
 849               (funcall (car focusing-functions) frame)
 850               (setq focusing-functions (cdr focusing-functions)))
 851             (wl arg))
 852         (setq frame (make-frame))
 853         (while focusing-functions
 854           (funcall (car focusing-functions) frame)
 855           (setq focusing-functions (cdr focusing-functions)))
 856         (setq wl-delete-startup-frame-function
 857               `(lambda ()
 858                  (setq wl-delete-startup-frame-function nil)
 859                  (let ((frame ,frame))
 860                    (if (eq (selected-frame) frame)
 861                        (delete-frame frame)))))
 862         (wl arg)))))
 863
 864 ;; Define some autoload functions WL might use.
 865 (eval-and-compile
 866   ;; This little mapcar goes through the list below and marks the
 867   ;; symbols in question as autoloaded functions.
 868   (mapcar
 869    (function
 870     (lambda (package)
 871       (let ((interactive (nth 1 (memq ':interactive package))))
 872         (mapcar
 873          (function
 874           (lambda (function)
 875             (let (keymap)
 876               (when (consp function)
 877                 (setq keymap (car (memq 'keymap function)))
 878                 (setq function (car function)))
 879               (autoload function (car package) nil interactive keymap))))
 880          (if (eq (nth 1 package) ':interactive)
 881              (cdddr package)
 882            (cdr package))))))
 883    '(("wl-fldmgr" :interactive t
 884       wl-fldmgr-access-display-all wl-fldmgr-access-display-normal
 885       wl-fldmgr-add wl-fldmgr-clear-cut-entity-list wl-fldmgr-copy
 886       wl-fldmgr-copy-region wl-fldmgr-cut wl-fldmgr-cut-region
 887       wl-fldmgr-make-access-group wl-fldmgr-make-filter
 888       wl-fldmgr-make-group wl-fldmgr-make-multi
 889       wl-fldmgr-reconst-entity-hashtb wl-fldmgr-rename wl-fldmgr-delete
 890       wl-fldmgr-save-folders wl-fldmgr-set-petname wl-fldmgr-sort
 891       wl-fldmgr-subscribe wl-fldmgr-subscribe-region
 892       wl-fldmgr-unsubscribe wl-fldmgr-unsubscribe-region wl-fldmgr-yank )
 893      ("wl-acap" wl-acap-init)
 894      ("wl-acap" :interactive t wl-acap-store)
 895      ("wl-fldmgr"
 896       (wl-fldmgr-mode-map keymap)
 897       wl-fldmgr-add-entity-hashtb)
 898      ("wl-expire" :interactive t
 899       wl-folder-archive-current-entity
 900       wl-folder-expire-current-entity wl-summary-archive
 901       wl-summary-expire )
 902      ("wl-score"
 903       wl-score-save wl-summary-rescore-msgs wl-summary-score-headers
 904       wl-summary-score-update-all-lines )
 905      ("wl-score" :interactive t
 906       wl-score-change-score-file wl-score-edit-current-scores
 907       wl-score-edit-file wl-score-flush-cache wl-summary-rescore
 908       wl-score-set-mark-below wl-score-set-expunge-below
 909       wl-summary-increase-score wl-summary-lower-score ))))
 910
 911 ;; for backward compatibility
 912 (defalias 'wl-summary-from-func-petname 'wl-summary-default-from)
 913
 914 (require 'product)
 915 (product-provide (provide 'wl) (require 'wl-version))
 916
 917 ;;; wl.el ends here