1 ;;; wl.el --- Wanderlust bootstrap.
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>
6 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
7 ;; Masahiro MURATA <muse@ba2.so-net.ne.jp>
8 ;; Keywords: mail, net news
10 ;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen).
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)
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.
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.
35 (require 'wl-version) ; reduce recursive-load-depth
38 (unless (and (fboundp 'defgroup)
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))))
56 (provide 'wl) ; circular dependency
69 (require 'wl-highlight)
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))
84 (wl-make-plugged-alist))
86 (setq elmo-plugged (setq wl-plugged (elmo-plugged-p))
87 wl-modeline-plug-status wl-plugged)
89 (wl-toggle-plugged t 'flush)))
91 (defun wl-toggle-plugged (&optional arg queue-flush-only)
93 (elmo-quit) ; Disconnect current connection.
94 (unless queue-flush-only
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)
105 (let ((summaries (wl-collect-summary)))
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)
114 (elmo-dop-queue-flush)
115 (unless queue-flush-only
116 (when wl-biff-check-folder-list
117 (wl-biff-check-folders)
119 (if (and wl-draft-enable-queuing
121 (wl-draft-queue-flush))
122 ;; (when (and (eq major-mode 'wl-summary-mode)
123 ;; (elmo-folder-plugged-p wl-summary-buffer-elmo-folder))
124 ;; (let* ((msgdb-dir (elmo-folder-msgdb-path
125 ;; wl-summary-buffer-elmo-folder))
126 ;; (seen-list (elmo-msgdb-seen-load msgdb-dir)))
128 ;; (wl-summary-flush-pending-append-operations seen-list))
129 ;; (elmo-msgdb-seen-save msgdb-dir seen-list)))
130 (run-hooks 'wl-plugged-hook))
132 (run-hooks 'wl-unplugged-hook))
133 (force-mode-line-update t))
137 (defvar wl-plugged-port-label-alist
138 (list (cons 119 "nntp")
142 ;;(cons elmo-pop-before-smtp-port "pop3")
144 (defconst wl-plugged-switch-variables
145 '(("Queuing" . wl-draft-enable-queuing)
146 ("AutoFlushQueue" . wl-auto-flush-queue)
147 ("DisconnectedOperation" . elmo-enable-disconnected-operation)))
149 (defvar wl-plugged-buf-name "Plugged")
150 (defvar wl-plugged-mode-map nil)
151 (defvar wl-plugged-alist nil)
152 (defvar wl-plugged-switch nil)
153 (defvar wl-plugged-winconf nil)
154 (defvar wl-plugged-sending-queue-alist nil)
155 (defvar wl-plugged-dop-queue-alist nil)
156 (defvar wl-plugged-alist-modified nil)
158 (defvar wl-plugged-mode-menu-spec
160 ["Toggle plugged" wl-plugged-toggle t]
161 ["Toggle All plugged" wl-plugged-toggle-all t]
162 ["Prev Port" wl-plugged-move-to-previous t]
163 ["Next Port" wl-plugged-move-to-next t]
164 ["Prev Server" wl-plugged-move-to-previous-server t]
165 ["Next Server" wl-plugged-move-to-next-server t]
166 ["Flush queue" wl-plugged-flush-queue t]
168 ["Exit" wl-plugged-exit t]))
172 (defun wl-plugged-setup-mouse ()
173 (define-key wl-plugged-mode-map 'button2 'wl-plugged-click))
174 (defun wl-plugged-setup-mouse ()
175 (define-key wl-plugged-mode-map [mouse-2] 'wl-plugged-click))))
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)
195 "Menu used in Plugged mode."
196 wl-plugged-mode-menu-spec))
198 (defun wl-plugged-mode ()
199 "Mode for setting Wanderlust plugged.
200 See info under Wanderlust for full documentation.
203 \\{wl-plugged-mode-map}
205 Entering Plugged mode calls the value of `wl-plugged-mode-hook'."
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))
218 (defun wl-plugged-string (plugged &optional time)
223 wl-plugged-plug-off)))
225 (defun wl-plugged-server-indent ()
226 (make-string wl-plugged-server-indent (string-to-char " ")))
228 (defun wl-plugged-set-variables ()
229 (setq wl-plugged-sending-queue-alist
230 (wl-plugged-sending-queue-info))
231 (setq wl-plugged-dop-queue-alist
232 (wl-plugged-dop-queue-info))
233 (setq wl-plugged-alist
234 (sort (copy-sequence elmo-plugged-alist)
236 (string< (caar a) (caar b))))))
238 (defun wl-plugged-sending-queue-info ()
239 ;; sending queue status
240 (let (alist msgs sent-via server port)
241 (setq msgs (elmo-folder-list-messages
242 (wl-folder-get-elmo-folder wl-queue-folder)))
244 (setq sent-via (wl-draft-queue-info-operation (car msgs) 'get-sent-via))
246 (when (eq (nth 1 (car sent-via)) 'unplugged)
247 (setq server (car (nth 2 (car sent-via)))
248 port (cdr (nth 2 (car sent-via))))
249 (elmo-plugged-p server port) ;; add elmo-plugged-alist if nothing.
251 (wl-append-assoc-list
255 (setq sent-via (cdr sent-via)))
256 (setq msgs (cdr msgs)))
259 (defun wl-plugged-sending-queue-status (qinfo)
260 ;; sending queue status
261 (let ((len (length (cdr qinfo))))
262 (concat (wl-plugged-set-folder-icon
264 (wl-folder-get-petname wl-queue-folder))
266 (format ": %d msgs (" len)
267 (format ": %d msg (" len))
268 (mapconcat (function int-to-string) (cdr qinfo) ",")
271 (defun wl-plugged-dop-queue-info ()
274 (elmo-dop-queue (copy-sequence elmo-dop-queue))
275 dop-queue last alist server-info
277 ;(elmo-dop-queue-load)
278 (elmo-dop-queue-merge)
279 (setq dop-queue (sort elmo-dop-queue '(lambda (a b)
280 (string< (elmo-dop-queue-fname a)
281 (elmo-dop-queue-fname b)))))
282 (wl-append dop-queue (list nil)) ;; terminate(dummy)
283 (when (car dop-queue)
284 (setq last (elmo-dop-queue-fname (car dop-queue)))) ;; first
286 (when (car dop-queue)
287 (setq ope (cons (elmo-dop-queue-method-name (car dop-queue))
291 (elmo-dop-queue-arguments (car dop-queue))))
292 (car (elmo-dop-queue-arguments
293 (car dop-queue))))))))
294 (if (and (car dop-queue)
295 (string= last (elmo-dop-queue-fname (car dop-queue))))
296 (wl-append operation (list ope))
297 ;;(setq count (1+ count))
298 (when (and last (setq server-info (elmo-net-port-info
299 (wl-folder-get-elmo-folder last))))
301 (wl-append-assoc-list
303 (cons last operation)
305 (when (car dop-queue)
306 (setq last (elmo-dop-queue-fname (car dop-queue))
307 operation (list ope))))
308 (setq dop-queue (cdr dop-queue)))
311 (defun wl-plugged-dop-queue-status (qinfo &optional column)
313 (let ((operations (cdr qinfo))
314 (column (or column wl-plugged-queue-status-column)))
316 '(lambda (folder-ope)
317 (concat (wl-plugged-set-folder-icon
319 (wl-folder-get-petname (car folder-ope)))
321 (let ((opes (cdr folder-ope))
324 (if (setq pair (assoc (car (car opes)) shrinked))
325 (setcdr pair (+ (cdr pair)
326 (max (cdr (car opes)) 1)))
328 (cons (car (car opes))
329 (max (cdr (car opes)) 1))
331 (setq opes (cdr opes)))
335 (format "%s:%d" (car ope) (cdr ope))
336 (format "%s" (car ope))))
337 (nreverse shrinked) ","))
340 (concat "\n" (wl-set-string-width column "")))))
342 (defun wl-plugged-drawing (plugged-alist)
343 (let ((buffer-read-only nil)
344 (alist plugged-alist)
345 (vars wl-plugged-switch-variables)
346 last server port stream-type label plugged time
347 line len qinfo column)
350 (insert (format "%s:[%s]%s"
352 (wl-plugged-string (symbol-value (cdar vars)))
353 (if (cdr vars) " " "")))
354 (setq vars (cdr vars)))
356 (let ((elmo-plugged wl-plugged-switch))
357 (setq line (format "[%s](wl-plugged)"
358 (wl-plugged-string (elmo-plugged-p))))
359 ;; sending queue status
360 (when (setq qinfo (assoc (cons nil nil) wl-plugged-sending-queue-alist))
362 (wl-set-string-width wl-plugged-queue-status-column line)
363 (wl-plugged-sending-queue-status qinfo))))
366 (setq server (nth 0 (caar alist))
367 port (nth 1 (caar alist))
368 stream-type (nth 2 (caar alist))
369 label (nth 1 (car alist))
370 plugged (nth 2 (car alist))
371 time (nth 3 (car alist)))
372 (unless (string= last server)
374 (insert (format "%s[%s]%s\n"
375 (wl-plugged-server-indent)
377 (elmo-plugged-p server nil plugged-alist))
383 (make-string wl-plugged-port-indent (string-to-char " "))
384 (wl-plugged-string plugged time)
391 (cdr (assq port wl-plugged-port-label-alist))
394 (setq column (max (if line (1+ (string-width line)) 0)
395 wl-plugged-queue-status-column))
397 ;; sending queue status
398 ((setq qinfo (assoc (cons server port) wl-plugged-sending-queue-alist))
401 (wl-set-string-width column line)
402 (wl-plugged-sending-queue-status qinfo))))
404 ((setq qinfo (assoc (list server port stream-type)
405 wl-plugged-dop-queue-alist))
408 (wl-set-string-width column line)
409 (wl-plugged-dop-queue-status qinfo column)))))
411 (setq alist (cdr alist)))
412 (delete-region (1- (point-max)) (point-max)) ;; delete line at the end.
413 (goto-char (point-min))
415 (wl-highlight-plugged-current-line)
417 (set-buffer-modified-p nil)
418 (count-lines (point-min) (point-max)))
420 (defun wl-plugged-redrawing-switch (indent switch &optional time)
422 (when (re-search-forward
423 (format "^%s\\[\\([^]]+\\)\\]"
424 (make-string indent (string-to-char " "))))
425 (goto-char (match-beginning 1))
426 (delete-region (match-beginning 1) (match-end 1))
427 (insert (wl-plugged-string switch time))
428 (wl-highlight-plugged-current-line)
431 (defun wl-plugged-redrawing (plugged-alist)
432 (let ((buffer-read-only nil)
433 (alist plugged-alist)
434 last server port plugged time)
435 (goto-char (point-min))
436 (wl-plugged-redrawing-switch 0 (elmo-plugged-p))
438 (setq server (caaar alist)
440 plugged (nth 2 (car alist))
441 time (nth 3 (car alist)))
442 (unless (string= last server)
444 (wl-plugged-redrawing-switch
445 wl-plugged-server-indent
446 (elmo-plugged-p server nil plugged-alist))
449 (wl-plugged-redrawing-switch
450 wl-plugged-port-indent plugged time)
451 (setq alist (cdr alist))))
453 (set-buffer-modified-p nil))
455 (defun wl-plugged-change ()
457 (if (not elmo-plugged-alist)
458 (message "No plugged info")
459 (setq wl-plugged-winconf (current-window-configuration))
460 (let* ((cur-win (selected-window))
461 (max-lines (if (eq major-mode 'wl-summary-mode)
465 (with-current-buffer (get-buffer-create wl-plugged-buf-name)
467 (buffer-disable-undo (current-buffer))
468 (delete-windows-on (current-buffer))
469 (wl-plugged-set-variables)
470 (setq lines (wl-plugged-drawing wl-plugged-alist)))
471 (select-window cur-win)
472 (setq window-lines (min max-lines (max lines window-min-height)))
473 (when (> (- (window-height) window-lines) window-min-height)
474 (split-window cur-win (- (window-height) window-lines)))
475 (switch-to-buffer wl-plugged-buf-name)
478 (enlarge-window (- window-lines (window-height)))
479 (when (fboundp 'pos-visible-in-window-p)
480 (goto-char (point-min))
481 (while (and (< (window-height) max-lines)
482 (not (pos-visible-in-window-p (1- (point-max)))))
483 (enlarge-window 2))))
485 (goto-char (point-min))
487 (wl-plugged-move-to-next)))) ;; goto first entry
489 (defsubst wl-plugged-get-server ()
492 (wl-plugged-move-to-previous-server)
494 (when (looking-at (format "^%s\\[[^]]+\\]\\(.*\\)"
495 (wl-plugged-server-indent)))
496 (elmo-match-buffer 1))))
498 (defun wl-plugged-toggle ()
500 (let ((cur-point (point)))
506 (let (variable switch name)
507 (goto-char cur-point)
508 (when (and (not (bobp))
509 (not (eq (char-before) (string-to-char " "))))
510 (if (re-search-backward " [^ ]+" nil t)
512 (re-search-backward "^[^ ]+" nil t)))
513 (when (looking-at "\\([^ :[]+\\):?\\[\\([^]]+\\)\\]")
514 (setq name (elmo-match-buffer 1))
515 (setq switch (not (string= (elmo-match-buffer 2) wl-plugged-plug-on)))
516 (when (setq variable (cdr (assoc name wl-plugged-switch-variables)))
517 (set variable switch))
518 (goto-char (match-beginning 2))
519 (let ((buffer-read-only nil))
520 (delete-region (match-beginning 2) (match-end 2))
521 (insert (wl-plugged-string switch))
522 (set-buffer-modified-p nil)))))
524 ((looking-at "^\\( *\\)\\[\\([^]]+\\)\\]\\([^ \n]*\\)")
525 (let* ((indent (length (elmo-match-buffer 1)))
526 (switch (elmo-match-buffer 2))
527 (name (elmo-match-buffer 3))
528 (plugged (not (string= switch wl-plugged-plug-on)))
529 (alist wl-plugged-alist)
530 server port stream-type name-1)
532 ((eq indent wl-plugged-port-indent) ;; toggle port plug
534 ((string-match "\\([^([]*\\)(\\([^)[]+\\))" name)
535 (setq port (string-to-number (elmo-match-string 2 name)))
536 (if (string-match "!" (setq name-1 (elmo-match-string 1 name)))
538 (intern (substring name-1 (match-end 0))))))
541 (setq server (wl-plugged-get-server))
542 (elmo-set-plugged plugged server port stream-type nil alist))
543 ((eq indent wl-plugged-server-indent) ;; toggle server plug
544 (elmo-set-plugged plugged name nil nil nil alist))
545 ((eq indent 0) ;; toggle all plug
546 (elmo-set-plugged plugged nil nil nil nil alist)))
548 (wl-plugged-redrawing wl-plugged-alist)
549 ;; show plugged status in modeline
550 (let ((elmo-plugged wl-plugged-switch))
551 (setq wl-plugged-switch (elmo-plugged-p)
552 wl-modeline-plug-status wl-plugged-switch)
553 (force-mode-line-update t))))))
554 (setq wl-plugged-alist-modified t)
555 (goto-char cur-point)))
557 (defun wl-plugged-click (e)
562 (defun wl-plugged-toggle-all ()
564 (let ((cur-point (point)))
565 (setq wl-plugged-switch (not wl-plugged-switch))
566 (elmo-set-plugged wl-plugged-switch nil nil nil nil wl-plugged-alist)
567 (wl-plugged-redrawing wl-plugged-alist)
568 (goto-char cur-point)
569 (setq wl-plugged-alist-modified t)
570 ;; show plugged status in modeline
571 (setq wl-modeline-plug-status wl-plugged-switch)
572 (force-mode-line-update t)))
574 (defun wl-plugged-exit ()
576 (setq ;;elmo-plugged-alist wl-plugged-alist
577 wl-plugged wl-plugged-switch
579 wl-plugged-sending-queue-alist nil
580 wl-plugged-dop-queue-alist nil)
581 (run-hooks 'wl-plugged-exit-hook)
582 (when wl-plugged-alist-modified
583 (wl-toggle-plugged (if wl-plugged 'on 'off) t))
584 (kill-buffer (current-buffer))
585 (if wl-plugged-winconf
586 (set-window-configuration wl-plugged-winconf)))
588 (defun wl-plugged-flush-queue ()
590 (let ((cur-point (point))
591 (dop-status (elmo-dop-queue-flush))
592 (send-status (wl-draft-queue-flush)))
593 (unless (or dop-status send-status)
594 (message "No processing queue."))
595 (wl-plugged-set-variables)
596 (wl-plugged-drawing wl-plugged-alist)
597 (goto-char cur-point)))
599 (defun wl-plugged-move-to-next ()
601 (when (re-search-forward "\\[\\([^]]+\\)\\]" nil t)
602 (let ((pos (match-beginning 1)))
603 (if (invisible-p pos)
604 (goto-char (next-visible-point pos))
607 (defun wl-plugged-move-to-previous ()
609 (if (eq (char-before) ?\]) (forward-char -1))
610 (when (re-search-backward "\\[\\([^]]+\\)\\]" nil t)
611 (let ((pos (match-beginning 1)))
612 (if (invisible-p pos)
613 (goto-char (next-visible-point pos))
616 (defun wl-plugged-move-to-next-server ()
619 (format "^%s\\[\\([^]]+\\)\\]" (wl-plugged-server-indent)))
623 (if (re-search-forward regexp nil t)
624 (setq point (match-beginning 1))))
625 (if point (goto-char point))))
627 (defun wl-plugged-move-to-previous-server ()
630 (format "^%s\\[\\([^]]+\\)\\]" (wl-plugged-server-indent))))
631 (if (re-search-backward regexp nil t)
632 (goto-char (match-beginning 1)))))
634 ;;; end of wl-plugged-mode
637 "Save summary and folder status."
639 (wl-save-status 'keep-summary)
640 (run-hooks 'wl-save-hook))
642 (defun wl-execute-temp-marks ()
643 "Execute temporary marks in summary buffers."
645 (let ((summaries (wl-collect-summary)))
647 (with-current-buffer (car summaries)
648 (wl-summary-exec-with-confirmation)
649 (wl-summary-save-status))
650 (setq summaries (cdr summaries)))))
652 (defun wl-save-status (&optional keep-summary)
653 (message "Saving summary and folder status...")
655 (let ((summaries (wl-collect-summary)))
657 (with-current-buffer (car summaries)
659 (wl-summary-cleanup-temp-marks))
660 (wl-summary-save-view)
661 (elmo-folder-commit wl-summary-buffer-elmo-folder)
663 (kill-buffer (car summaries))))
664 (setq summaries (cdr summaries)))))
665 (wl-refile-alist-save)
666 (wl-folder-info-save)
667 (and (featurep 'wl-fldmgr) (wl-fldmgr-exit))
668 (and (featurep 'wl-spam) (wl-spam-save-status))
669 (elmo-crosspost-message-alist-save)
670 (message "Saving summary and folder status...done"))
674 (when (or (not wl-interactive-exit)
675 (y-or-n-p "Do you really want to quit Wanderlust? "))
677 (when wl-use-acap (funcall (symbol-function 'wl-acap-exit)))
679 (elmo-clear-signal-slots)
680 (run-hooks 'wl-exit-hook)
682 (wl-folder-cleanup-variables)
683 (wl-message-buffer-cache-clean-up)
687 (list wl-folder-buffer-name
690 (when wl-delete-startup-frame-function
691 (funcall wl-delete-startup-frame-function))
692 ;; (if (and wl-folder-use-frame
693 ;; (> (length (visible-frame-list)) 1))
696 (remove-hook 'kill-emacs-hook 'wl-save-status)
697 (elmo-passwd-alist-clear)
699 (message "") ; empty minibuffer.
704 (require 'mime-setup)
705 (setq elmo-plugged wl-plugged)
706 (add-hook 'kill-emacs-hook 'wl-save-status)
709 (wl-refile-alist-setup)
713 (fset 'wl-summary-from-func-internal
714 (symbol-value 'wl-summary-from-function))
715 (fset 'wl-summary-subject-func-internal
716 (symbol-value 'wl-summary-subject-function))
717 (fset 'wl-summary-subject-filter-func-internal
718 (symbol-value 'wl-summary-subject-filter-function))
719 (wl-summary-define-sort-command)
720 (wl-summary-define-mark-action)
721 (dolist (spec wl-summary-flag-alist)
724 (format "wl-highlight-summary-%s-flag-face" (car spec))))
726 (setq elmo-get-folder-function #'wl-folder-make-elmo-folder
727 elmo-progress-callback-function #'wl-progress-callback-function)
728 (setq elmo-no-from wl-summary-no-from-message)
729 (setq elmo-no-subject wl-summary-no-subject-message)
730 (elmo-global-flags-initialize (mapcar 'car wl-summary-flag-alist))
733 'message-number-changed
735 (elmo-define-signal-handler (listener folder old-number new-number)
736 (dolist (buffer (wl-collect-draft))
737 (with-current-buffer buffer
738 (wl-draft-buffer-change-number old-number new-number)))
739 (wl-draft-rename-saved-config old-number new-number))
740 (elmo-define-signal-filter (listener folder old-number new-number)
742 (string= (elmo-folder-name-internal folder) wl-draft-folder))))
745 ;; This hook may contain the functions `wl-plugged-init-icons' and
746 ;; `wl-biff-init-icons' for reasons of system internal to accord
747 ;; facilities for the Emacs variants.
748 (run-hooks 'wl-init-hook)))
750 (defun wl-check-environment (no-check-folder)
751 (unless wl-from (error "Please set `wl-from' to your mail address"))
753 (when wl-insert-message-id
754 (let ((message-id (funcall wl-message-id-function))
756 (unless (string-match "^<\\([^@]*\\)@\\([^@]*\\)>$" message-id)
758 ((string-match "@" wl-message-id-domain)
759 (error "Please remove `@' from `wl-message-id-domain'"))
762 "Check around `wl-message-id-function' to get valid Message-ID string"))))
763 (setq domain (match-string 2 message-id))
764 (if (or (not (string-match "[^.]\\.[^.]" domain))
765 (string= domain "localhost.localdomain"))
767 "Please set `wl-message-id-domain' to get valid Message-ID string."))))
769 (when (not no-check-folder)
770 (let ((draft-folder (wl-folder-get-elmo-folder wl-draft-folder))
771 (queue-folder (wl-folder-get-elmo-folder wl-queue-folder))
772 (lost+found-folder (wl-folder-get-elmo-folder
773 elmo-lost+found-folder)))
774 (unless (elmo-folder-exists-p draft-folder)
776 (format "Draft Folder %s does not exist, create it? "
778 (elmo-folder-create draft-folder)
779 (error "Draft Folder is not created")))
780 (if (and wl-draft-enable-queuing
781 (not (elmo-folder-exists-p queue-folder)))
783 (format "Queue Folder %s does not exist, create it? "
785 (elmo-folder-create queue-folder)
786 (error "Queue Folder is not created")))
787 (when (not (eq no-check-folder 'wl-draft))
788 (unless (elmo-folder-exists-p lost+found-folder)
789 (elmo-folder-create lost+found-folder)))
791 (unless (file-exists-p wl-temporary-file-directory)
793 (format "Temp directory (to save multipart) %s does not exist, create it now? "
794 wl-temporary-file-directory))
795 (make-directory wl-temporary-file-directory)
796 (error "Temp directory is not created"))))))
798 (defconst wl-check-variables-alist
799 '((numberp . elmo-pop3-default-port)
800 (symbolp . elmo-pop3-default-authenticate-type)
801 (numberp . elmo-imap4-default-port)
802 (symbolp . elmo-imap4-default-authenticate-type)
803 (numberp . elmo-nntp-default-port)
804 (numberp . wl-pop-before-smtp-port)
805 (symbolp . wl-pop-before-smtp-authenticate-type)))
807 (defun wl-check-variables ()
808 (let ((type-variables wl-check-variables-alist)
810 (while (setq type (car type-variables))
811 (if (and (eval (cdr type))
812 (not (funcall (car type)
814 (error "%s must be %s: %S"
816 (substring (format "%s" (car type)) 0 -1)
818 (setq type-variables (cdr type-variables)))))
820 (defun wl-check-variables-2 ()
821 (if (< wl-message-buffer-cache-size 1)
822 (error "`wl-message-buffer-cache-size' must be larger than 0"))
823 (when wl-message-buffer-prefetch-depth
824 (if (not (< wl-message-buffer-prefetch-depth
825 wl-message-buffer-cache-size))
827 "`wl-message-buffer-prefetch-depth' must be smaller than "
828 "`wl-message-buffer-cache-size' - 1.")))))
831 (defun wl (&optional arg)
832 "Start Wanderlust -- Yet Another Message Interface On Emacsen.
833 If ARG (prefix argument) is specified, folder checkings are skipped."
838 (let (demo-buf check)
840 (if wl-demo (setq demo-buf (wl-demo)))
847 (message "Checking environment...")
848 (wl-check-environment arg)
849 (message "Checking environment...done")
850 (message "Checking type of variables...")
852 (wl-check-variables-2)
853 (message "Checking type of variables...done")))
854 (let ((inhibit-quit t))
855 (wl-plugged-init (wl-folder)))
857 (run-hooks 'wl-auto-check-folder-pre-hook)
858 (wl-folder-auto-check)
859 (run-hooks 'wl-auto-check-folder-hook)))
861 (if (buffer-live-p demo-buf)
862 (kill-buffer demo-buf))
863 (signal (car obj)(cdr obj)))
865 (when wl-biff-check-folder-list
866 (unless arg (wl-biff-check-folders))
868 (if (buffer-live-p demo-buf)
869 (kill-buffer demo-buf)))
870 (run-hooks 'wl-hook))
872 (defvar wl-delete-startup-frame-function nil)
875 (defun wl-other-frame (&optional arg)
876 "Pop up a frame to read messages via Wanderlust."
878 (if wl-folder-use-frame
880 (let ((focusing-functions (append '(raise-frame select-frame)
881 (if (fboundp 'x-focus-frame)
884 (folder (get-buffer wl-folder-buffer-name))
885 window frame wl-folder-use-frame)
887 (setq window (get-buffer-window folder t))
888 (window-live-p window)
889 (setq frame (window-frame window)))
891 (while focusing-functions
892 (funcall (car focusing-functions) frame)
893 (setq focusing-functions (cdr focusing-functions)))
895 (setq frame (make-frame))
896 (while focusing-functions
897 (funcall (car focusing-functions) frame)
898 (setq focusing-functions (cdr focusing-functions)))
899 (setq wl-delete-startup-frame-function
901 (setq wl-delete-startup-frame-function nil)
902 (let ((frame ,frame))
903 (if (eq (selected-frame) frame)
904 (delete-frame frame)))))
907 ;; Define some autoload functions WL might use.
909 ;; This little mapc goes through the list below and marks the
910 ;; symbols in question as autoloaded functions.
913 (let ((interactive (nth 1 (memq ':interactive package))))
917 (when (consp function)
918 (setq keymap (car (memq 'keymap function)))
919 (setq function (car function)))
920 (autoload function (car package) nil interactive keymap)))
921 (if (eq (nth 1 package) ':interactive)
924 '(("wl-fldmgr" :interactive t
925 wl-fldmgr-access-display-all wl-fldmgr-access-display-normal
926 wl-fldmgr-add wl-fldmgr-clear-cut-entity-list wl-fldmgr-copy
927 wl-fldmgr-copy-region wl-fldmgr-cut wl-fldmgr-cut-region
928 wl-fldmgr-make-access-group wl-fldmgr-make-filter
929 wl-fldmgr-make-group wl-fldmgr-make-multi
930 wl-fldmgr-reconst-entity-hashtb wl-fldmgr-rename wl-fldmgr-delete
931 wl-fldmgr-save-folders wl-fldmgr-set-petname wl-fldmgr-sort
932 wl-fldmgr-subscribe wl-fldmgr-subscribe-region
933 wl-fldmgr-unsubscribe wl-fldmgr-unsubscribe-region wl-fldmgr-yank )
934 ("wl-acap" wl-acap-init)
935 ("wl-acap" :interactive t wl-acap-store)
937 (wl-fldmgr-mode-map keymap)
938 wl-fldmgr-add-entity-hashtb)
939 ("wl-expire" :interactive t
940 wl-folder-archive-current-entity
941 wl-folder-expire-current-entity wl-summary-archive
944 wl-score-save wl-summary-rescore-msgs wl-summary-score-headers
945 wl-summary-score-update-all-lines )
946 ("wl-score" :interactive t
947 wl-score-change-score-file wl-score-edit-current-scores
948 wl-score-edit-file wl-score-flush-cache wl-summary-rescore
949 wl-score-set-mark-below wl-score-set-expunge-below
950 wl-summary-increase-score wl-summary-lower-score )
951 ("wl-draft" wl-draft-rename-saved-config))))
953 ;; for backward compatibility
954 (defalias 'wl-summary-from-func-petname 'wl-summary-default-from)
957 (product-provide (provide 'wl) (require 'wl-version))