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