X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl.el;h=b449773a822bf99b862da4d6ce6b6870350a94b2;hb=b9521e198d3bedd260d45af2b00ad9177a097e2e;hp=1a3566bf74e56b9f86613cc3cddc513a0ff0085c;hpb=806725e3db0748ddc973ba045053a6681e840287;p=elisp%2Fwanderlust.git diff --git a/wl/wl.el b/wl/wl.el index 1a3566b..b449773 100644 --- a/wl/wl.el +++ b/wl/wl.el @@ -1,8 +1,10 @@ -;;; wl.el -- Wanderlust bootstrap. +;;; wl.el --- Wanderlust bootstrap. -;; Copyright 1998,1999,2000 Yuuichi Teranishi +;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi +;; Copyright (C) 1998,1999,2000 Masahiro MURATA ;; Author: Yuuichi Teranishi +;; Masahiro MURATA ;; Keywords: mail, net news ;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen). @@ -29,10 +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) @@ -41,18 +45,15 @@ (require 'wl-vars) (require 'wl-util) -(require 'wl-version) (cond (wl-on-xemacs (require 'wl-xmas)) (wl-on-emacs21 (require 'wl-e21)) - (wl-on-nemacs - (require 'wl-nemacs)) (t (require 'wl-mule))) -(provide 'wl) ; circular dependency +(provide 'wl) ; circular dependency (require 'wl-folder) (require 'wl-summary) (require 'wl-thread) @@ -66,13 +67,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) @@ -95,7 +94,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) @@ -103,35 +102,36 @@ (let ((summaries (wl-collect-summary))) (while summaries (set-buffer (pop summaries)) - (wl-summary-msgdb-save) - ;; msgdb is saved, but cache is not saved yet. + (elmo-folder-commit wl-summary-buffer-elmo-folder) (wl-summary-set-message-modified)))) (setq wl-biff-check-folders-running nil) (if wl-plugged (progn ;; flush queue!! (elmo-dop-queue-flush) + (unless queue-flush-only (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)) (force-mode-line-update t)) ;;; 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 @@ -164,10 +164,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)) @@ -230,7 +228,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 @@ -262,28 +261,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)) @@ -311,7 +322,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 @@ -331,8 +342,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))) @@ -368,7 +380,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) @@ -414,6 +427,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 () @@ -443,7 +457,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)) @@ -466,7 +480,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) @@ -485,27 +499,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 @@ -525,7 +542,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) @@ -598,7 +615,8 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'." (defun wl-save () "Save summary and folder status." (interactive) - (wl-save-status 'keep-summary)) + (wl-save-status 'keep-summary) + (run-hooks 'wl-save-hook)) (defun wl-save-status (&optional keep-summary) (message "Saving summary and folder status...") @@ -606,94 +624,74 @@ 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 keep-summary) + (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) - (message "Saving summary and folder status...done.")) + (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)) + (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)) - (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)) + (setq elmo-no-from wl-summary-no-from-message) + (setq elmo-no-subject wl-summary-no-subject-message) + (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'")) + ;; Message-ID (unless (string-match "[^.]\\.[^.]" (or wl-message-id-domain (if wl-local-domain (concat (system-name) @@ -706,54 +704,87 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'." "." 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'")) + ;; 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)) + (trash-folder (wl-folder-get-elmo-folder wl-trash-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 trash-folder) + (if (y-or-n-p + (format "Trash Folder %s does not exist, create it? " + wl-trash-folder)) + (elmo-folder-create trash-folder) + (error "Trash Folder is not created"))) + (unless (elmo-folder-exists-p lost+found-folder) + (elmo-folder-create lost+found-folder))) + ;; tmp dir + (unless (file-exists-p wl-tmp-dir) (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"))) - (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))) - (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-tmp-dir)) + (make-directory wl-tmp-dir) + (error "Temp directory is not created")))))) ;;;###autoload (defun wl (&optional arg) "Start Wanderlust -- Yet Another Message Interface On Emacsen. -If prefix argument is specified, folder checkings are skipped." +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 + (condition-case nil + (progn + (message "Checking environment...") + (wl-check-environment arg) + (message "Checking environment...done")) + (error) + (quit))) + (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)) ;; Define some autoload functions WL might use. (eval-and-compile @@ -784,6 +815,8 @@ If 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)