-;;; wl.el -- Wanderlust bootstrap.
+;;; wl.el --- Wanderlust bootstrap.
;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
;; Copyright (C) 1998,1999,2000 Masahiro MURATA <muse@ba2.so-net.ne.jp>
;;; 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)
(let ((doc (concat "*" (or doc ""))))
- (` (defvar (, symbol) (, value) (, doc))))))
+ `(defvar ,symbol ,value ,doc))))
(require 'wl-vars)
(require 'wl-util)
(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)
(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)
+ (require 'wl-spam))
(defun wl-plugged-init (&optional make-alist)
(setq elmo-plugged wl-plugged)
(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)
(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
;; flush queue!!
(elmo-dop-queue-flush)
- (unless queue-flush-only (wl-biff-start))
+ (unless queue-flush-only
+ (when wl-biff-check-folder-list
+ (wl-biff-check-folders)
+ (wl-biff-start)))
(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))
;;; 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 25 "smtp")))
;;(cons elmo-pop-before-smtp-port "pop3")
(defconst wl-plugged-switch-variables
(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))
(setq buffer-read-only t)
(run-hooks 'wl-plugged-mode-hook))
-(defmacro wl-plugged-string (plugged &optional time)
- (` (if (, time) wl-plugged-auto-off
- (if (, plugged) wl-plugged-plug-on wl-plugged-plug-off))))
+(defun wl-plugged-string (plugged &optional time)
+ (if time
+ wl-plugged-auto-off
+ (if plugged
+ wl-plugged-plug-on
+ wl-plugged-plug-off)))
-(defmacro wl-plugged-server-indent ()
- (` (make-string wl-plugged-server-indent ? )))
+(defun wl-plugged-server-indent ()
+ (make-string wl-plugged-server-indent (string-to-char " ")))
(defun wl-plugged-set-variables ()
(setq wl-plugged-sending-queue-alist
(wl-plugged-dop-queue-info))
(setq wl-plugged-alist
(sort (copy-sequence elmo-plugged-alist)
- '(lambda (a b)
- (string< (caar a) (caar b))))))
+ (lambda (a b)
+ (string< (caar a) (caar b))))))
(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
(if (> len 1)
(format ": %d msgs (" len)
(format ": %d msg (" len))
- (mapconcat (function int-to-string) (cdr qinfo) ",")
+ (mapconcat (function number-to-string) (cdr qinfo) ",")
")")))
(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)))))
+ (setq dop-queue (sort elmo-dop-queue (lambda (a 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)))
+;;; (setq count (1+ count))
+ (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))
(let ((operations (cdr qinfo))
(column (or column wl-plugged-queue-status-column)))
(mapconcat
- '(lambda (folder-ope)
- (concat (wl-plugged-set-folder-icon
- (car folder-ope)
- (wl-folder-get-petname (car folder-ope)))
- "("
- (mapconcat
- '(lambda (ope)
+ (lambda (folder-ope)
+ (concat (wl-plugged-set-folder-icon
+ (car folder-ope)
+ (wl-folder-get-petname (car 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))))
- (cdr folder-ope) ",")
- ")"))
+ (nreverse shrinked) ","))
+ ")"))
operations
(concat "\n" (wl-set-string-width column "")))))
(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
(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)))
;; port plug
(setq line
(format "%s[%s]%s"
- (make-string wl-plugged-port-indent ? )
+ (make-string wl-plugged-port-indent (string-to-char " "))
(wl-plugged-string plugged time)
(cond
((stringp port)
(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)
(defun wl-plugged-redrawing-switch (indent switch &optional time)
(beginning-of-line)
(when (re-search-forward
- (format "^%s\\[\\([^]]+\\)\\]" (make-string indent ? )))
+ (format "^%s\\[\\([^]]+\\)\\]"
+ (make-string indent (string-to-char " "))))
(goto-char (match-beginning 1))
(delete-region (match-beginning 1) (match-end 1))
(insert (wl-plugged-string switch time))
(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 ()
(/ (frame-height) 2)
(window-height)))
window-lines lines)
- (save-excursion
- (set-buffer (get-buffer-create wl-plugged-buf-name))
+ (with-current-buffer (get-buffer-create wl-plugged-buf-name)
(wl-plugged-mode)
(buffer-disable-undo (current-buffer))
(delete-windows-on (current-buffer))
(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))
(save-excursion
(beginning-of-line)
(cond
- ;; swtich variable
+ ;; switch variable
((bobp)
(let (variable switch name)
(goto-char cur-point)
(when (and (not (bobp))
- (not (eq (char-before) ? )))
+ (not (eq (char-before) (string-to-char " "))))
(if (re-search-backward " [^ ]+" nil t)
(forward-char 1)
(re-search-backward "^[^ ]+" nil t)))
(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-number (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
(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)
(defun wl-plugged-exit ()
(interactive)
- (setq ;;elmo-plugged-alist wl-plugged-alist
- wl-plugged wl-plugged-switch
+ (setq wl-plugged wl-plugged-switch
+;;; elmo-plugged-alist wl-plugged-alist
wl-plugged-alist nil
wl-plugged-sending-queue-alist nil
wl-plugged-dop-queue-alist nil)
(wl-save-status 'keep-summary)
(run-hooks 'wl-save-hook))
+(defun wl-execute-temp-marks ()
+ "Execute temporary marks in summary buffers."
+ (interactive)
+ (let ((summaries (wl-collect-summary)))
+ (while summaries
+ (with-current-buffer (car summaries)
+ (wl-summary-exec-with-confirmation)
+ (wl-summary-save-status))
+ (setq summaries (cdr summaries)))))
+
(defun wl-save-status (&optional keep-summary)
(message "Saving summary and folder status...")
- (let (summary-buf)
- (save-excursion
- (let ((summaries (wl-collect-summary)))
- (while summaries
- (set-buffer (car summaries))
+ (save-excursion
+ (let ((summaries (wl-collect-summary)))
+ (while summaries
+ (with-current-buffer (car summaries)
(unless keep-summary
(wl-summary-cleanup-temp-marks))
- (wl-summary-save-status keep-summary)
+ (wl-summary-save-view)
+ (elmo-folder-commit wl-summary-buffer-elmo-folder)
(unless keep-summary
- (kill-buffer (car summaries)))
- (setq summaries (cdr summaries))))))
+ (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)
+ (and (featurep 'wl-spam) (wl-spam-save-status))
+ (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)
+ (elmo-clear-signal-slots)
(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)
+ (elmo-passwd-alist-clear)
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-sort-command)
+ (wl-summary-define-mark-action)
+ (dolist (spec wl-summary-flag-alist)
+ (set-face-foreground
+ (make-face (intern
+ (format "wl-highlight-summary-%s-flag-face" (car spec))))
+ (nth 1 spec)))
+ (setq elmo-get-folder-function #'wl-folder-make-elmo-folder
+ elmo-progress-callback-function #'wl-progress-callback-function)
+ (setq elmo-no-from wl-summary-no-from-message)
+ (setq elmo-no-subject wl-summary-no-subject-message)
+ (elmo-global-flags-initialize (mapcar 'car wl-summary-flag-alist))
+ (elmo-connect-signal
+ nil
+ 'message-number-changed
+ 'wl-draft
+ (elmo-define-signal-handler (listener folder old-number new-number)
+ (dolist (buffer (wl-collect-draft))
+ (with-current-buffer buffer
+ (wl-draft-buffer-change-number old-number new-number)))
+ (wl-draft-rename-saved-config old-number new-number))
+ (elmo-define-signal-filter (listener folder old-number new-number)
+ (and folder
+ (string= (elmo-folder-name-internal folder) wl-draft-folder))))
+ (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)))
+ (unless (elmo-folder-exists-p draft-folder)
(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 "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 "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.")))))
;;;###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)
+ (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)))
+ (unless arg
+ (run-hooks 'wl-auto-check-folder-pre-hook)
+ (wl-folder-auto-check)
+ (run-hooks 'wl-auto-check-folder-hook)))
+ (error
+ (if (buffer-live-p demo-buf)
+ (kill-buffer demo-buf))
+ (signal (car obj)(cdr obj)))
+ (quit))
+ (when wl-biff-check-folder-list
+ (unless arg (wl-biff-check-folders))
+ (wl-biff-start))
+ (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
- ;; This little mapcar goes through the list below and marks the
+ ;; This little mapc goes through the list below and marks the
;; symbols in question as autoloaded functions.
- (mapcar
- (function
- (lambda (package)
- (let ((interactive (nth 1 (memq ':interactive package))))
- (mapcar
- (function
- (lambda (function)
- (let (keymap)
- (when (consp function)
- (setq keymap (car (memq 'keymap function)))
- (setq function (car function)))
- (autoload function (car package) nil interactive keymap))))
- (if (eq (nth 1 package) ':interactive)
- (cdddr package)
- (cdr package))))))
+ (mapc
+ (lambda (package)
+ (let ((interactive (nth 1 (memq ':interactive package))))
+ (mapc
+ (lambda (function)
+ (let (keymap)
+ (when (consp function)
+ (setq keymap (car (memq 'keymap function)))
+ (setq function (car function)))
+ (autoload function (car package) nil interactive keymap)))
+ (if (eq (nth 1 package) ':interactive)
+ (cdddr package)
+ (cdr package)))))
'(("wl-fldmgr" :interactive t
wl-fldmgr-access-display-all wl-fldmgr-access-display-normal
wl-fldmgr-add wl-fldmgr-clear-cut-entity-list wl-fldmgr-copy
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)
wl-score-change-score-file wl-score-edit-current-scores
wl-score-edit-file wl-score-flush-cache wl-summary-rescore
wl-score-set-mark-below wl-score-set-expunge-below
- wl-summary-increase-score wl-summary-lower-score ))))
+ wl-summary-increase-score wl-summary-lower-score )
+ ("wl-draft" wl-draft-rename-saved-config))))
;; for backward compatibility
(defalias 'wl-summary-from-func-petname 'wl-summary-default-from)
projects / elisp / wanderlust.git / blobdiff