-;;; 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 'mime-setup)
(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 ((summaries (wl-collect-summary)))
(while summaries
(set-buffer (pop summaries))
- (elmo-folder-commit wl-summary-buffer-elmo-folder)
- (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
(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 "")))))
(save-excursion
(beginning-of-line)
(cond
- ;; swtich variable
+ ;; switch variable
((bobp)
(let (variable switch name)
(goto-char cur-point)
(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))
(with-current-buffer (car summaries)
(unless keep-summary
(wl-summary-cleanup-temp-marks))
- (wl-summary-save-view keep-summary)
+ (wl-summary-save-view)
(elmo-folder-commit wl-summary-buffer-elmo-folder)
(unless keep-summary
(kill-buffer (car summaries))))
(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)
(list wl-folder-buffer-name
wl-plugged-buf-name)
"\\|")))
- (if (and wl-folder-use-frame
- (> (length (visible-frame-list)) 1))
- (delete-frame))
+ (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)
(remove-hook 'kill-emacs-hook 'wl-save-status)
t)
(defun wl-init ()
(when (not wl-init)
+ (require 'mime-setup)
(setq elmo-plugged wl-plugged)
(add-hook 'kill-emacs-hook 'wl-save-status)
(wl-address-init)
(defun wl-check-environment (no-check-folder)
(unless wl-from (error "Please set `wl-from'"))
;; 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'"))
+ (let (from domain)
+ (if wl-message-id-use-wl-from
+ (if (and (setq from (wl-address-header-extract-address wl-from))
+ (string-match "^\\(.*\\)@\\(.*\\)$" from))
+ (setq domain (match-string 2 from))
+ (error "Please set `wl-from' to get valid Message-ID string."))
+ (setq domain
+ (or wl-message-id-domain
+ (if wl-local-domain
+ (concat (system-name) "." wl-local-domain)
+ (system-name)))))
+ (unless (string-match "[^.]\\.[^.]" domain)
+ (error "Please set `wl-local-domain' to get valid FQDN"))
+ (if (string-match "@" domain)
+ (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'")))
;; folders
(when (not no-check-folder)
(let ((draft-folder (wl-folder-get-elmo-folder wl-draft-folder))
(unless (elmo-folder-exists-p lost+found-folder)
(elmo-folder-create lost+found-folder)))
;; tmp dir
- (unless (file-exists-p wl-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-tmp-dir))
- (make-directory wl-tmp-dir)
+ 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.
(message "Checking environment...")
(wl-check-environment arg)
(message "Checking environment...done"))
- (error)
- (quit)))
+ ((error quit))))
+ (message "Checking type of variables...")
+ (wl-check-variables)
+ (wl-check-variables-2)
+ (message "Checking type of variables...done")
(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
+ (error
(if (buffer-live-p demo-buf)
(kill-buffer demo-buf))
+ (setq wl-init nil)
(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)
+ (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
projects / elisp / wanderlust.git / blobdiff