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