X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl.el;h=e076fa3c223ad84e8e9e39993558311f2ee94c4c;hb=6dc2bb1ee1d35e7f6cf19df145c35561cc5265bd;hp=696716bb621e0f9365466e2c7a522d16a26b4cae;hpb=b682c4af26cb887d22c94b60bec0af2604c74580;p=elisp%2Fwanderlust.git diff --git a/wl/wl.el b/wl/wl.el index 696716b..e076fa3 100644 --- a/wl/wl.el +++ b/wl/wl.el @@ -1,4 +1,4 @@ -;;; wl.el -- Wanderlust bootstrap. +;;; wl.el --- Wanderlust bootstrap. ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi ;; Copyright (C) 1998,1999,2000 Masahiro MURATA @@ -31,12 +31,12 @@ ;;; Code: ;; -(require 'elmo2) +(require 'elmo) (require 'wl-version) ; reduce recursive-load-depth ;; from x-face.el (unless (and (fboundp 'defgroup) - (fboundp 'defcustom)) + (fboundp 'defcustom)) (require 'backquote) (defmacro defgroup (&rest args)) (defmacro defcustom (symbol value &optional doc &rest args) @@ -50,16 +50,16 @@ (require 'wl-xmas)) (wl-on-emacs21 (require 'wl-e21)) - (wl-on-nemacs - (require 'wl-nemacs)) (t (require 'wl-mule))) (provide 'wl) ; circular dependency (require 'wl-folder) (require 'wl-summary) +(require 'wl-action) (require 'wl-thread) (require 'wl-address) +(require 'wl-news) (wl-draft-mode-setup) (require 'wl-draft) @@ -69,13 +69,11 @@ (require 'wl-highlight) (eval-when-compile + (require 'cl) (require 'smtp) (require 'wl-score) - (unless wl-on-nemacs - (require 'wl-fldmgr)) - (if wl-use-semi - (require 'wl-mime) - (require 'tm-wl))) + (require 'wl-fldmgr) + (require 'wl-mime)) (defun wl-plugged-init (&optional make-alist) (setq elmo-plugged wl-plugged) @@ -98,7 +96,7 @@ (setq wl-plugged t)) ((eq arg 'off) (setq wl-plugged nil)) - (t (setq wl-plugged (null wl-plugged)))) + (t (setq wl-plugged (not wl-plugged)))) (elmo-set-plugged wl-plugged)) (setq elmo-plugged wl-plugged wl-modeline-plug-status wl-plugged) @@ -106,9 +104,8 @@ (let ((summaries (wl-collect-summary))) (while summaries (set-buffer (pop summaries)) - (wl-summary-msgdb-save) - ;; msgdb is saved, but cache is not saved yet. - (wl-summary-set-message-modified)))) + (wl-summary-save-view) + (elmo-folder-commit wl-summary-buffer-elmo-folder)))) (setq wl-biff-check-folders-running nil) (if wl-plugged (progn @@ -118,14 +115,14 @@ (if (and wl-draft-enable-queuing wl-auto-flush-queue) (wl-draft-queue-flush)) - (when (and (eq major-mode 'wl-summary-mode) - (elmo-folder-plugged-p wl-summary-buffer-folder-name)) - (let* ((msgdb-dir (elmo-msgdb-expand-path - wl-summary-buffer-folder-name)) - (seen-list (elmo-msgdb-seen-load msgdb-dir))) - (setq seen-list - (wl-summary-flush-pending-append-operations seen-list)) - (elmo-msgdb-seen-save msgdb-dir seen-list))) +;; (when (and (eq major-mode 'wl-summary-mode) +;; (elmo-folder-plugged-p wl-summary-buffer-elmo-folder)) +;; (let* ((msgdb-dir (elmo-folder-msgdb-path +;; wl-summary-buffer-elmo-folder)) +;; (seen-list (elmo-msgdb-seen-load msgdb-dir))) +;; (setq seen-list +;; (wl-summary-flush-pending-append-operations seen-list)) +;; (elmo-msgdb-seen-save msgdb-dir seen-list))) (run-hooks 'wl-plugged-hook)) (wl-biff-stop) (run-hooks 'wl-unplugged-hook)) @@ -134,9 +131,9 @@ ;;; wl-plugged-mode (defvar wl-plugged-port-label-alist - (list (cons elmo-default-nntp-port "nntp") - (cons elmo-default-imap4-port "imap4") - (cons elmo-default-pop3-port "pop3"))) + (list (cons 119 "nntp") + (cons 143 "imap4") + (cons 110 "pop3"))) ;;(cons elmo-pop-before-smtp-port "pop3") (defconst wl-plugged-switch-variables @@ -169,10 +166,8 @@ (if wl-on-xemacs (defun wl-plugged-setup-mouse () (define-key wl-plugged-mode-map 'button2 'wl-plugged-click)) - (if wl-on-nemacs - (defun wl-plugged-setup-mouse ()) - (defun wl-plugged-setup-mouse () - (define-key wl-plugged-mode-map [mouse-2] 'wl-plugged-click))))) + (defun wl-plugged-setup-mouse () + (define-key wl-plugged-mode-map [mouse-2] 'wl-plugged-click)))) (unless wl-plugged-mode-map (setq wl-plugged-mode-map (make-sparse-keymap)) @@ -235,7 +230,8 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'." (defun wl-plugged-sending-queue-info () ;; sending queue status (let (alist msgs sent-via server port) - (setq msgs (elmo-list-folder wl-queue-folder)) + (setq msgs (elmo-folder-list-messages + (wl-folder-get-elmo-folder wl-queue-folder))) (while msgs (setq sent-via (wl-draft-queue-info-operation (car msgs) 'get-sent-via)) (while sent-via @@ -267,28 +263,40 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'." (defun wl-plugged-dop-queue-info () ;; dop queue status (let* ((count 0) - elmo-dop-queue dop-queue last alist server-info + (elmo-dop-queue (copy-sequence elmo-dop-queue)) + dop-queue last alist server-info ope operation) - (elmo-dop-queue-load) + ;(elmo-dop-queue-load) (elmo-dop-queue-merge) (setq dop-queue (sort elmo-dop-queue '(lambda (a b) - (string< (car a) (car b))))) + (string< (elmo-dop-queue-fname a) + (elmo-dop-queue-fname b))))) (wl-append dop-queue (list nil)) ;; terminate(dummy) - (setq last (caar dop-queue)) ;; first + (when (car dop-queue) + (setq last (elmo-dop-queue-fname (car dop-queue)))) ;; first (while dop-queue - (setq ope (cons (nth 1 (car dop-queue)) - (length (nth 2 (car dop-queue))))) - (if (string= last (caar dop-queue)) + (when (car dop-queue) + (setq ope (cons (elmo-dop-queue-method-name (car dop-queue)) + (length + (if (listp + (car + (elmo-dop-queue-arguments (car dop-queue)))) + (car (elmo-dop-queue-arguments + (car dop-queue)))))))) + (if (and (car dop-queue) + (string= last (elmo-dop-queue-fname (car dop-queue)))) (wl-append operation (list ope)) ;;(setq count (1+ count)) - (when (and last (setq server-info (elmo-folder-portinfo last))) + (when (and last (setq server-info (elmo-net-port-info + (wl-folder-get-elmo-folder last)))) (setq alist (wl-append-assoc-list - (cons (car server-info) (nth 1 server-info)) ;; server port + server-info (cons last operation) alist))) - (setq last (caar dop-queue) - operation (list ope))) + (when (car dop-queue) + (setq last (elmo-dop-queue-fname (car dop-queue)) + operation (list ope)))) (setq dop-queue (cdr dop-queue))) alist)) @@ -302,12 +310,23 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'." (car folder-ope) (wl-folder-get-petname (car folder-ope))) "(" - (mapconcat - '(lambda (ope) - (if (> (cdr ope) 0) - (format "%s:%d" (car ope) (cdr ope)) - (format "%s" (car ope)))) - (cdr folder-ope) ",") + (let ((opes (cdr folder-ope)) + pair shrinked) + (while opes + (if (setq pair (assoc (car (car opes)) shrinked)) + (setcdr pair (+ (cdr pair) + (max (cdr (car opes)) 1))) + (setq shrinked (cons + (cons (car (car opes)) + (max (cdr (car opes)) 1)) + shrinked))) + (setq opes (cdr opes))) + (mapconcat + '(lambda (ope) + (if (> (cdr ope) 0) + (format "%s:%d" (car ope) (cdr ope)) + (format "%s" (car ope)))) + (nreverse shrinked) ",")) ")")) operations (concat "\n" (wl-set-string-width column ""))))) @@ -316,7 +335,7 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'." (let ((buffer-read-only nil) (alist plugged-alist) (vars wl-plugged-switch-variables) - last server port label plugged time + last server port stream-type label plugged time line len qinfo column) (erase-buffer) (while vars @@ -336,8 +355,9 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'." (wl-plugged-sending-queue-status qinfo)))) (insert line "\n")) (while alist - (setq server (caaar alist) - port (cdaar alist) + (setq server (nth 0 (caar alist)) + port (nth 1 (caar alist)) + stream-type (nth 2 (caar alist)) label (nth 1 (car alist)) plugged (nth 2 (car alist)) time (nth 3 (car alist))) @@ -373,7 +393,8 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'." (wl-set-string-width column line) (wl-plugged-sending-queue-status qinfo)))) ;; dop queue status - ((setq qinfo (assoc (cons server port) wl-plugged-dop-queue-alist)) + ((setq qinfo (assoc (list server port stream-type) + wl-plugged-dop-queue-alist)) (setq line (concat (wl-set-string-width column line) @@ -419,6 +440,7 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'." (wl-plugged-redrawing-switch wl-plugged-port-indent plugged time) (setq alist (cdr alist)))) + (sit-for 0) (set-buffer-modified-p nil)) (defun wl-plugged-change () @@ -448,7 +470,7 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'." (enlarge-window (- window-lines (window-height))) (when (fboundp 'pos-visible-in-window-p) (goto-char (point-min)) - (while (and (<= (window-height) max-lines) + (while (and (< (window-height) max-lines) (not (pos-visible-in-window-p (1- (point-max))))) (enlarge-window 2)))) (error)) @@ -471,7 +493,7 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'." (save-excursion (beginning-of-line) (cond - ;; swtich variable + ;; switch variable ((bobp) (let (variable switch name) (goto-char cur-point) @@ -490,27 +512,30 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'." (delete-region (match-beginning 2) (match-end 2)) (insert (wl-plugged-string switch)) (set-buffer-modified-p nil))))) - ;; swtich plug + ;; switch plug ((looking-at "^\\( *\\)\\[\\([^]]+\\)\\]\\([^ \n]*\\)") (let* ((indent (length (elmo-match-buffer 1))) (switch (elmo-match-buffer 2)) (name (elmo-match-buffer 3)) (plugged (not (string= switch wl-plugged-plug-on))) (alist wl-plugged-alist) - server port) + server port stream-type name-1) (cond ((eq indent wl-plugged-port-indent) ;; toggle port plug (cond ((string-match "\\([^([]*\\)(\\([^)[]+\\))" name) - (setq port (string-to-int (elmo-match-string 2 name)))) + (setq port (string-to-int (elmo-match-string 2 name))) + (if (string-match "!" (setq name-1 (elmo-match-string 1 name))) + (setq stream-type + (intern (substring name-1 (match-end 0)))))) (t (setq port name))) (setq server (wl-plugged-get-server)) - (elmo-set-plugged plugged server port nil alist)) + (elmo-set-plugged plugged server port stream-type nil alist)) ((eq indent wl-plugged-server-indent) ;; toggle server plug - (elmo-set-plugged plugged name nil nil alist)) + (elmo-set-plugged plugged name nil nil nil alist)) ((eq indent 0) ;; toggle all plug - (elmo-set-plugged plugged nil nil nil alist))) + (elmo-set-plugged plugged nil nil nil nil alist))) ;; redraw (wl-plugged-redrawing wl-plugged-alist) ;; show plugged status in modeline @@ -530,7 +555,7 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'." (interactive) (let ((cur-point (point))) (setq wl-plugged-switch (not wl-plugged-switch)) - (elmo-set-plugged wl-plugged-switch nil nil nil wl-plugged-alist) + (elmo-set-plugged wl-plugged-switch nil nil nil nil wl-plugged-alist) (wl-plugged-redrawing wl-plugged-alist) (goto-char cur-point) (setq wl-plugged-alist-modified t) @@ -612,165 +637,242 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'." (save-excursion (let ((summaries (wl-collect-summary))) (while summaries - (set-buffer (car summaries)) - (unless keep-summary - (wl-summary-cleanup-temp-marks)) - (wl-summary-save-status keep-summary) - (unless keep-summary - (kill-buffer (car summaries))) + (with-current-buffer (car summaries) + (unless keep-summary + (wl-summary-cleanup-temp-marks)) + (wl-summary-save-view) + (elmo-folder-commit wl-summary-buffer-elmo-folder) + (unless keep-summary + (kill-buffer (car summaries)))) (setq summaries (cdr summaries)))))) (wl-refile-alist-save) (wl-folder-info-save) (and (featurep 'wl-fldmgr) (wl-fldmgr-exit)) - (wl-crosspost-alist-save) + (elmo-crosspost-message-alist-save) (message "Saving summary and folder status...done")) (defun wl-exit () (interactive) (when (or (not wl-interactive-exit) - (y-or-n-p "Quit Wanderlust? ")) + (y-or-n-p "Do you really want to quit Wanderlust? ")) (elmo-quit) + (when wl-use-acap (funcall (symbol-function 'wl-acap-exit))) (wl-biff-stop) (run-hooks 'wl-exit-hook) (wl-save-status) (wl-folder-cleanup-variables) - (elmo-cleanup-variables) + (wl-message-buffer-cache-clean-up) (wl-kill-buffers (format "^\\(%s\\)$" (mapconcat 'identity - (list (format "%s\\(:.*\\)?" - (default-value 'wl-message-buf-name)) - wl-original-buf-name - wl-folder-buffer-name + (list wl-folder-buffer-name wl-plugged-buf-name) "\\|"))) - (elmo-buffer-cache-clean-up) - (if (fboundp 'mmelmo-cleanup-entity-buffers) - (mmelmo-cleanup-entity-buffers)) + (when wl-delete-startup-frame-function + (funcall wl-delete-startup-frame-function)) +;; (if (and wl-folder-use-frame +;; (> (length (visible-frame-list)) 1)) +;; (delete-frame)) (setq wl-init nil) - (unless wl-on-nemacs - (remove-hook 'kill-emacs-hook 'wl-save-status)) + (remove-hook 'kill-emacs-hook 'wl-save-status) t) - (message "") ;; empty minibuffer. + (message "") ; empty minibuffer. ) -(defun wl-init (&optional arg) +(defun wl-init () (when (not wl-init) + (require 'mime-setup) (setq elmo-plugged wl-plugged) - (let (succeed demo-buf) - (if wl-demo - (setq demo-buf (wl-demo))) - (unless wl-on-nemacs - (add-hook 'kill-emacs-hook 'wl-save-status)) - (unwind-protect - (progn - (wl-address-init) - (wl-draft-setup) - (wl-refile-alist-setup) - (wl-crosspost-alist-load) - (if wl-use-semi - (progn - (require 'wl-mime) - (setq elmo-use-semi t)) - (require 'tm-wl) - (setq elmo-use-semi nil)) - ;; defined above. - (wl-mime-setup) - (fset 'wl-summary-from-func-internal - (symbol-value 'wl-summary-from-func)) - (fset 'wl-summary-subject-func-internal - (symbol-value 'wl-summary-subject-func)) - (fset 'wl-summary-subject-filter-func-internal - (symbol-value 'wl-summary-subject-filter-func)) - (setq elmo-no-from wl-summary-no-from-message) - (setq elmo-no-subject wl-summary-no-subject-message) - (setq succeed t) - (progn - (message "Checking environment...") - (wl-check-environment arg) - (message "Checking environment...done"))) - (if demo-buf - (kill-buffer demo-buf)) - (if succeed - (setq wl-init t)) - ;; This hook may contain the functions `wl-plugged-init-icons' and - ;; `wl-biff-init-icons' for reasons of system internal to accord - ;; facilities for the Emacs variants. - (run-hooks 'wl-init-hook))))) + (add-hook 'kill-emacs-hook 'wl-save-status) + (wl-address-init) + (wl-draft-setup) + (wl-refile-alist-setup) + (require 'wl-mime) + ;; defined above. + (wl-mime-setup) + (fset 'wl-summary-from-func-internal + (symbol-value 'wl-summary-from-function)) + (fset 'wl-summary-subject-func-internal + (symbol-value 'wl-summary-subject-function)) + (fset 'wl-summary-subject-filter-func-internal + (symbol-value 'wl-summary-subject-filter-function)) + (wl-summary-define-mark-action) + (setq elmo-no-from wl-summary-no-from-message) + (setq elmo-no-subject wl-summary-no-subject-message) + (wl-news-check) + (setq wl-init t) + ;; This hook may contain the functions `wl-plugged-init-icons' and + ;; `wl-biff-init-icons' for reasons of system internal to accord + ;; facilities for the Emacs variants. + (run-hooks 'wl-init-hook))) (defun wl-check-environment (no-check-folder) - (unless (featurep 'mime-setup) - (require 'mime-setup)) - (unless wl-from - (error "Please set `wl-from'")) + (unless wl-from (error "Please set `wl-from' to your mail address")) ;; Message-ID - (unless (string-match "[^.]\\.[^.]" (or wl-message-id-domain - (if wl-local-domain - (concat (system-name) - "." wl-local-domain) - (system-name)))) - (error "Please set `wl-local-domain' to get valid FQDN")) - (if (string-match "@" (or wl-message-id-domain - (if wl-local-domain - (concat (system-name) - "." wl-local-domain) - (system-name)))) - (error "Please remove `@' from `wl-message-id-domain'")) - (if (string= wl-local-domain "localdomain") - (error "Please set `wl-local-domain'")) - (if (string= wl-message-id-domain "localhost.localdomain") - (error "Please set `wl-message-id-domain'")) + (when wl-insert-message-id + (let ((message-id (funcall wl-message-id-function)) + domain) + (unless (string-match "^<\\([^@]*\\)@\\([^@]*\\)>$" message-id) + (cond + ((string-match "@" wl-message-id-domain) + (error "Please remove `@' from `wl-message-id-domain'")) + (t + (error + "Check around `wl-message-id-function' to get valid Message-ID string")))) + (setq domain (match-string 2 message-id)) + (if (or (not (string-match "[^.]\\.[^.]" domain)) + (string= domain "localhost.localdomain")) + (elmo-warning + "Please set `wl-message-id-domain' to get valid Message-ID string.")))) ;; folders (when (not no-check-folder) - (if (not (eq (elmo-folder-get-type wl-draft-folder) 'localdir)) - (error "%s is not allowed for draft folder" wl-draft-folder)) - (unless (elmo-folder-exists-p wl-draft-folder) - (if (y-or-n-p - (format "Draft Folder %s does not exist, create it? " - wl-draft-folder)) - (elmo-create-folder wl-draft-folder) - (error "Draft Folder is not created"))) - (if (and wl-draft-enable-queuing - (not (elmo-folder-exists-p wl-queue-folder))) + (let ((draft-folder (wl-folder-get-elmo-folder wl-draft-folder)) + (queue-folder (wl-folder-get-elmo-folder wl-queue-folder)) + (lost+found-folder (wl-folder-get-elmo-folder + elmo-lost+found-folder))) + (if (not (elmo-folder-message-file-p draft-folder)) + (error "%s is not allowed for draft folder" wl-draft-folder)) + (unless (elmo-folder-exists-p draft-folder) + (if (y-or-n-p + (format "Draft Folder %s does not exist, create it? " + wl-draft-folder)) + (elmo-folder-create draft-folder) + (error "Draft Folder is not created"))) + (if (and wl-draft-enable-queuing + (not (elmo-folder-exists-p queue-folder))) + (if (y-or-n-p + (format "Queue Folder %s does not exist, create it? " + wl-queue-folder)) + (elmo-folder-create queue-folder) + (error "Queue Folder is not created"))) + (when (not (eq no-check-folder 'wl-draft)) + (unless (elmo-folder-exists-p lost+found-folder) + (elmo-folder-create lost+found-folder))) + ;; tmp dir + (unless (file-exists-p wl-temporary-file-directory) (if (y-or-n-p - (format "Queue Folder %s does not exist, create it? " - wl-queue-folder)) - (elmo-create-folder wl-queue-folder) - (error "Queue Folder is not created")))) - (when (not (eq no-check-folder 'wl-draft)) - (unless (elmo-folder-exists-p wl-trash-folder) - (if (y-or-n-p - (format "Trash Folder %s does not exist, create it? " - wl-trash-folder)) - (elmo-create-folder wl-trash-folder) - (error "Trash Folder is not created"))) - (unless (elmo-folder-exists-p elmo-lost+found-folder) - (elmo-create-folder elmo-lost+found-folder))) - ;; tmp dir - (unless (file-exists-p wl-tmp-dir) - (if (y-or-n-p - (format "Temp directory (to save multipart) %s does not exist, create it now? " - wl-tmp-dir)) - (make-directory wl-tmp-dir) - (error "Temp directory is not created")))) + (format "Temp directory (to save multipart) %s does not exist, create it now? " + wl-temporary-file-directory)) + (make-directory wl-temporary-file-directory) + (error "Temp directory is not created")))))) + +(defconst wl-check-variables-alist + '((numberp . elmo-pop3-default-port) + (symbolp . elmo-pop3-default-authenticate-type) + (numberp . elmo-imap4-default-port) + (symbolp . elmo-imap4-default-authenticate-type) + (numberp . elmo-nntp-default-port) + (numberp . wl-pop-before-smtp-port) + (symbolp . wl-pop-before-smtp-authenticate-type))) + +(defun wl-check-variables () + (let ((type-variables wl-check-variables-alist) + type) + (while (setq type (car type-variables)) + (if (and (eval (cdr type)) + (not (funcall (car type) + (eval (cdr type))))) + (error "%s must be %s: %S" + (cdr type) + (substring (format "%s" (car type)) 0 -1) + (eval (cdr type)))) + (setq type-variables (cdr type-variables))))) + +(defun wl-check-variables-2 () + (if (< wl-message-buffer-cache-size 1) + (error "`wl-message-buffer-cache-size' must be larger than 0")) + (when wl-message-buffer-prefetch-depth + (if (not (< wl-message-buffer-prefetch-depth + wl-message-buffer-cache-size)) + (error (concat + "`wl-message-buffer-prefetch-depth' must be smaller than " + "`wl-message-buffer-cache-size' - 1.")))) + (let (case-fold-search) + (unless (string-match "%T" wl-summary-line-format) + (error "`wl-summary-line-format' must contain %%T and %%P")) + (unless (string-match "%P" wl-summary-line-format) + (error "`wl-summary-line-format' must contain %%T and %%P")) + (dolist (pair wl-folder-summary-line-format-alist) + (unless (string-match "%T" (cdr pair)) + (error "Format `%s' must contain %%T and %%P" (cdr pair))) + (unless (string-match "%P" (cdr pair)) + (error "Format `%s' must contain %%T and %%P" (cdr pair)))))) ;;;###autoload (defun wl (&optional arg) "Start Wanderlust -- Yet Another Message Interface On Emacsen. If ARG (prefix argument) is specified, folder checkings are skipped." (interactive "P") - (or wl-init (wl-load-profile)) - (unwind-protect - (wl-init arg) - (wl-plugged-init (wl-folder arg)) - (sit-for 0)) - (unwind-protect - (unless arg - (run-hooks 'wl-auto-check-folder-pre-hook) - (wl-folder-auto-check) - (run-hooks 'wl-auto-check-folder-hook)) - (unless arg (wl-biff-start)) - (run-hooks 'wl-hook))) + (unless wl-init + (wl-load-profile) + (wl-folder-init) + (elmo-init)) + (let (demo-buf check) + (unless wl-init + (if wl-demo (setq demo-buf (wl-demo))) + (setq check t)) + (wl-init) + (condition-case obj + (progn + (if check + (progn + (message "Checking environment...") + (wl-check-environment arg) + (message "Checking environment...done") + (message "Checking type of variables...") + (wl-check-variables) + (wl-check-variables-2) + (message "Checking type of variables...done"))) + (let ((inhibit-quit t)) + (wl-plugged-init (wl-folder arg))) + (unless arg + (run-hooks 'wl-auto-check-folder-pre-hook) + (wl-folder-auto-check) + (run-hooks 'wl-auto-check-folder-hook)) + (unless arg (wl-biff-start))) + (error + (if (buffer-live-p demo-buf) + (kill-buffer demo-buf)) + (signal (car obj)(cdr obj))) + (quit)) + (if (buffer-live-p demo-buf) + (kill-buffer demo-buf))) + (run-hooks 'wl-hook)) + +(defvar wl-delete-startup-frame-function nil) + +;;;###autoload +(defun wl-other-frame (&optional arg) + "Pop up a frame to read messages via Wanderlust." + (interactive) + (if wl-folder-use-frame + (wl arg) + (let ((focusing-functions (append '(raise-frame select-frame) + (if (fboundp 'x-focus-frame) + '(x-focus-frame) + '(focus-frame)))) + (folder (get-buffer wl-folder-buffer-name)) + window frame wl-folder-use-frame) + (if (and folder + (setq window (get-buffer-window folder t)) + (window-live-p window) + (setq frame (window-frame window))) + (progn + (while focusing-functions + (funcall (car focusing-functions) frame) + (setq focusing-functions (cdr focusing-functions))) + (wl arg)) + (setq frame (make-frame)) + (while focusing-functions + (funcall (car focusing-functions) frame) + (setq focusing-functions (cdr focusing-functions))) + (setq wl-delete-startup-frame-function + `(lambda () + (setq wl-delete-startup-frame-function nil) + (let ((frame ,frame)) + (if (eq (selected-frame) frame) + (delete-frame frame))))) + (wl arg))))) ;; Define some autoload functions WL might use. (eval-and-compile @@ -801,6 +903,8 @@ If ARG (prefix argument) is specified, folder checkings are skipped." wl-fldmgr-save-folders wl-fldmgr-set-petname wl-fldmgr-sort wl-fldmgr-subscribe wl-fldmgr-subscribe-region wl-fldmgr-unsubscribe wl-fldmgr-unsubscribe-region wl-fldmgr-yank ) + ("wl-acap" wl-acap-init) + ("wl-acap" :interactive t wl-acap-store) ("wl-fldmgr" (wl-fldmgr-mode-map keymap) wl-fldmgr-add-entity-hashtb)