From 50e87247bc89cd4eead8633be07a758798831042 Mon Sep 17 00:00:00 2001 From: teranisi Date: Mon, 20 Aug 2001 15:40:38 +0000 Subject: [PATCH] * INSTALL, INSTALL.ja: Update. * wl-vars.el (wl-cs-noconv): Ignore nemacs. (wl-cs-autoconv): Ditto. (wl-cs-local): Ditto. (wl-use-scoring): Ditto. (wl-mime-charset): Ditto. (wl-folder-check-async): Ditto. * wl.el (toplevel): Ignore nemacs and tm. (wl-exit): Ditto. * wl-summary.el (wl-summary-setup-mouse): Ignore nemacs. (wl-summary-mode-map): Added binding for `wl-addrmgr'. (wl-summary-edit-addresses-subr): Use wl-address-add-or-change instead of wl-address-petname-add-or-change. (wl-summary-edit-addresses-subr): Use wl-address-delete instead of wl-address-petname-delete. * wl-util.el (wl-as-coding-system): Ignore nemacs. * wl-mime.el (wl-draft-preview-message): Kill raw preview buffer if error occured. * wl-message.el (require): Remove tm support. * wl-highlight.el (defin-hilit, defun-hilit2): Eliminated. * wl-folder.el (wl-folder-setup-mouse): Ignore nemacs. (wl-folder-jump-to-current-entity): Ditto. (wl-folder-mode-map): Added binding for `wl-addrmgr'. * wl-e21.el (wl-draft-key-setup): Replaced binding (C-cC-a)for `wl-draft-insert-x-face-field' to `wl-addrmgr'. Changed binding for `wl-draft-insert-x-face-field' to C-cC-x. * wl-mule.el (wl-draft-key-setup): Ditto. * wl-xmas.el (wl-draft-key-setup): Ditto. * wl-draft.el (toplevel): Added autoload setting for wl-addrmgr. (wl-draft-std11-parse-addresses): New function. (wl-draft-parse-mailbox-list): Use it. (wl-draft): Ignore nemacs. (wl-draft-reedit): Ditto. * wl-addrmgr.el: New file. (Original is wl-rcpt.el written by "Kitamoto Tsuyoshi ". Thanks Kitamoto-san.) * wl-address.el (wl-address-make-address-list): Modified parsing process. (wl-address-delete): Renamed from `wl-address-petname-delete'; Modify wl-address-list too. (wl-address-add-or-change): Renamed from `wl-address-petname-add-or-change'; Rewote for wl-addrmgr. * WL-CFG: Removed nemacs setting example. * WL-MK (config-wl-package-subr): Ignore nemacs. * WL-ELS: Ignore tm and nemacs. (WL-MODULES): Added wl-addrmgr. --- ChangeLog | 9 + INSTALL | 27 +-- INSTALL.ja | 30 +-- WL-CFG | 9 - WL-ELS | 23 +- WL-MK | 3 +- elmo/ChangeLog | 6 + elmo/elmo-util.el | 10 + elmo/elmo-vars.el | 1 - wl/ChangeLog | 59 +++++ wl/tm-wl.el | 317 ------------------------- wl/wl-address.el | 143 ++++++----- wl/wl-addrmgr.el | 669 ++++++++++++++++++++++++++++++++++++++++++++++++++++ wl/wl-draft.el | 27 ++- wl/wl-e21.el | 3 +- wl/wl-folder.el | 31 +-- wl/wl-highlight.el | 54 ++--- wl/wl-message.el | 7 +- wl/wl-mime.el | 36 +-- wl/wl-mule.el | 3 +- wl/wl-nemacs.el | 154 ------------ wl/wl-summary.el | 33 +-- wl/wl-util.el | 8 +- wl/wl-vars.el | 15 +- wl/wl-xmas.el | 3 +- wl/wl.el | 28 +-- 26 files changed, 936 insertions(+), 772 deletions(-) delete mode 100644 wl/tm-wl.el create mode 100644 wl/wl-addrmgr.el delete mode 100644 wl/wl-nemacs.el diff --git a/ChangeLog b/ChangeLog index 44496ff..a0ec6da 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,12 @@ +2001-08-21 Yuuichi Teranishi + + * WL-CFG: Removed nemacs setting example. + + * WL-MK (config-wl-package-subr): Ignore nemacs. + + * WL-ELS: Ignore tm and nemacs. + (WL-MODULES): Added wl-addrmgr. + 2001-07-12 Yuuichi Teranishi * WL-MK (config-wl-package-subr): Check smtp.el version. diff --git a/INSTALL b/INSTALL index fd8539f..256789c 100644 --- a/INSTALL +++ b/INSTALL @@ -8,11 +8,9 @@ Select MIME Module ================== - Before installing Wanderlust, please install either of the following - MIME modules. SEMI is recommended because it's more functional. + Before installing Wanderlust, please install the following MIME modules. SEMI (1.14.1 or later) - tm (8.7 or later) SEMI requires APEL and FLIM packages. For each Emacsen, Recommended combination of MIME module package following. @@ -43,15 +41,6 @@ Select MIME Module http://www.jpl.org/elips/INSTALL-SEMI-ja.html -(e) Emacs 19.28 or earlier (Mule 2.3, Nemacs) - - APEL 10.3, CLIME 1.14.0, tm 8.8 - - If you use Mule based on Emacs 19.28 or earlier, please install tm. - SEMI does not support Emacs 19.28 or earlier. You need upgrade APEL - and CLIME. - - Install MIME Module =================== @@ -61,9 +50,6 @@ Install MIME Module FLIM: ftp://ftp.m17n.org/pub/mule/flim/ CLIME: SEMI: ftp://ftp.m17n.org/pub/mule/semi/ - tm: http://cvs.m17n.org/tomo/comp/emacsen/tm/tm-8/ - -(a) SEMI Please install APEL, FLIM(CLIME), and SEMI, in that order. Generally, 'make install' will do the job. To get full information, please refer @@ -76,17 +62,6 @@ Install MIME Module APEL 10.2, Chao 1.14.1, REMI 1.14.2 APEL 10.2, SLIM 1.14.3, EMY 1.13.9 -(b) tm - - The tm, whose version is 8.7 or later, is recommended. To get full - information, please refer README.en within package. - - tm-8.8 or earlier makes following error while compiling Wanderlust. - - Use tm-8.x with APEL 10.2 or later. - - In this case, please install APEL 10.2 or later. - Installation ============ diff --git a/INSTALL.ja b/INSTALL.ja index e13e30d..697e583 100644 --- a/INSTALL.ja +++ b/INSTALL.ja @@ -8,12 +8,10 @@ MIME用モジュールの選択 ====================== - Wanderlust を使うためには、以下のどちらかの MIME 用モジュールをインス - トールしておく必要があります。機能が充実している SEMI の使用をお勧めし - ます。 + Wanderlust を使うためには、以下の MIME 用モジュールをインス + トールしておく必要があります。 SEMI (1.14.1 以上) - tm (8.7 以上) SEMI には APEL, FLIM と呼ばれるパッケージも必要です。主な Emacsen につ いて推奨される APEL, FLIM, SEMI の組合せを以下に示します。 @@ -43,14 +41,6 @@ MIME用モジュールの選択 http://www.jpl.org/elips/INSTALL-SEMI-ja.html -(e) Emacs 19.28 以前 (Mule 2.3, Nemacs) - - APEL 10.3, CLIME 1.14.0, tm 8.8 - - SEMI は動きませんので、tm をインストールしてください。APEL, CLIME を最 - 新版に入れ替える必要もあります。 - - MIME用モジュールのインストール ============================== @@ -60,9 +50,6 @@ MIME用モジュールのインストール FLIM: ftp://ftp.m17n.org/pub/mule/flim/ CLIME: SEMI: ftp://ftp.m17n.org/pub/mule/semi/ - tm: http://cvs.m17n.org/tomo/comp/emacsen/tm/tm-8/ - -(a) SEMI のインストール APEL, FLIM(CLIME), SEMI の順にインストールしてください。基本的にすべて make install の実行で済むはずです。 @@ -79,19 +66,6 @@ MIME用モジュールのインストール APEL 10.2, Chao 1.14.1, REMI 1.14.2 APEL 10.2, SLIM 1.14.3, EMY 1.13.9 -(b) tm のインストール - - tm 8.7 以降のバージョンが必要です。詳しいインストールの方法はパッケー - ジに添付されているドキュメント(README.en)を参照してください。 - - tm 8.8 以前のバージョンでは、 - - Use tm-8.x with APEL 10.2 or later - - というエラーがでることがあります。この場合、APEL 10.2 以降をイ - ンストールしてください。 - - 通常のインストール ================== diff --git a/WL-CFG b/WL-CFG index fe45958..aa852e1 100644 --- a/WL-CFG +++ b/WL-CFG @@ -1,15 +1,6 @@ ;;; -*- emacs-lisp -*- ;;; Configuration file for installation. -;; load-path setting example for Nemacs with tm. -;(setq load-path (append -; (list "/usr/local/lib/nemacs/local.lisp/apel" -; "/usr/local/lib/nemacs/local.lisp/flim" -; "/usr/local/lib/nemacs/local.lisp/mu" -; "/usr/local/lib/nemacs/local.lisp/tm" -; "/usr/local/lib/nemacs/local.lisp/") -; load-path)) - ;; load-path setting example for Mule with SEMI. ;(setq load-path (append ; (list "/usr/local/share/mule/site-lisp/apel" diff --git a/WL-ELS b/WL-ELS index 7b88c2c..2759bc1 100644 --- a/WL-ELS +++ b/WL-ELS @@ -8,7 +8,7 @@ ;;; generic modules (defconst WL-MODULES '( wl wl-folder wl-summary wl-message - wl-vars wl-draft wl-util wl-version wl-address + wl-vars wl-draft wl-util wl-version wl-address wl-addrmgr wl-highlight wl-demo wl-refile wl-thread wl-fldmgr wl-expire wl-template wl-score )) @@ -32,8 +32,6 @@ ((featurep 'xemacs) (setq WL-MODULES (append WL-MODULES (list 'wl-dnd 'wl-xmas))) (setq ELMO-MODULES (append (list 'elmo-database) ELMO-MODULES))) - ((fboundp 'nemacs-version) - (setq WL-MODULES (append WL-MODULES (list 'wl-nemacs)))) ((and (boundp 'emacs-major-version) (>= emacs-major-version 21)) (setq WL-MODULES (append WL-MODULES (list 'wl-e21)))) ((featurep 'mule) @@ -52,23 +50,12 @@ (add-to-list 'ELMO-MODULES 'elmo-shimbun)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; tm-8 / SEMI - -(if (module-installed-p 'mime-view) - (progn - (defconst wl-use-semi t) - (setq WL-MODULES (append WL-MODULES (list 'wl-mime))) - (setq ELMO-MODULES (append ELMO-MODULES (list 'elmo-mime)))) - (defconst wl-use-semi nil) - (setq WL-MODULES (append WL-MODULES (list 'tm-wl)))) +;;; SEMI +(setq WL-MODULES (append WL-MODULES (list 'wl-mime))) +(setq ELMO-MODULES (append ELMO-MODULES (list 'elmo-mime))) (if (not (module-installed-p 'luna)) - (if wl-use-semi - (error "Use FLIM-1.13.2 or later and SEMI 1.13.7 or later.") - (if (module-installed-p 'product) - (error "Use tm-8.x with APEL 10.2 or later.") - ;; tm but luna is not installed (tm7?) - (error "Use tm-8.x.")))) + (error "Use FLIM-1.13.2 or later and SEMI 1.13.7 or later.")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Utils diff --git a/WL-MK b/WL-MK index 777e5e3..e0d05d5 100644 --- a/WL-MK +++ b/WL-MK @@ -104,8 +104,7 @@ ;; smtp.el version check. (require 'smtp) (if (not (fboundp 'smtp-send-buffer)) - (error "Please install FLIM 1.14.0 or later.")) - (princ (concat "\nMIME module is " (if wl-use-semi "SEMI" "tm-8") ".\n")))) + (error "Please install FLIM 1.14.0 or later.")))) (defun config-wl-pixmap-dir (&optional packagedir) "Examine pixmap directory where icon files should go." diff --git a/elmo/ChangeLog b/elmo/ChangeLog index 341192f..d274f6a 100644 --- a/elmo/ChangeLog +++ b/elmo/ChangeLog @@ -1,3 +1,9 @@ +2001-08-20 Yuuichi Teranishi + + * elmo-vars.el (elmo-use-semi): Eliminated. + + * elmo-util.el (elmo-string-assoc-all): New function. + 2001-08-16 Hiroya Murata * elmo-mime.el (elmo-mime-display-as-is-internal): Put text diff --git a/elmo/elmo-util.el b/elmo/elmo-util.el index 1b41b8f..d7e5dfd 100644 --- a/elmo/elmo-util.el +++ b/elmo/elmo-util.el @@ -1262,6 +1262,16 @@ But if optional argument AUTO is non-nil, DEFAULT is returned." (throw 'loop a)) (setq alist (cdr alist)))))) +(defun elmo-string-assoc-all (key alist) + (let (matches) + (while alist + (if (string= key (car (car alist))) + (setq matches + (cons (car alist) + matches))) + (setq alist (cdr alist))) + matches)) + (defun elmo-string-rassoc (key alist) (let (a) (catch 'loop diff --git a/elmo/elmo-vars.el b/elmo/elmo-vars.el index cb4d666..54b987d 100644 --- a/elmo/elmo-vars.el +++ b/elmo/elmo-vars.el @@ -138,7 +138,6 @@ If function, return value of function.") (defvar elmo-path-sep "/" "*Path separator.") (defvar elmo-plugged t) -(defvar elmo-use-semi nil) (defvar elmo-no-subject "(No Subject in original.)" "*A string used when no subject field exists.") diff --git a/wl/ChangeLog b/wl/ChangeLog index d9dadd6..a3feed7 100644 --- a/wl/ChangeLog +++ b/wl/ChangeLog @@ -1,3 +1,61 @@ +2001-08-21 Yuuichi Teranishi + + * wl-vars.el (wl-cs-noconv): Ignore nemacs. + (wl-cs-autoconv): Ditto. + (wl-cs-local): Ditto. + (wl-use-scoring): Ditto. + (wl-mime-charset): Ditto. + (wl-folder-check-async): Ditto. + + * wl.el (toplevel): Ignore nemacs and tm. + (wl-exit): Ditto. + + * wl-summary.el (wl-summary-setup-mouse): Ignore nemacs. + (wl-summary-mode-map): Added binding for `wl-addrmgr'. + (wl-summary-edit-addresses-subr): Use wl-address-add-or-change + instead of wl-address-petname-add-or-change. + (wl-summary-edit-addresses-subr): Use wl-address-delete + instead of wl-address-petname-delete. + + * wl-util.el (wl-as-coding-system): Ignore nemacs. + + * wl-mime.el (wl-draft-preview-message): Kill raw preview buffer + if error occured. + + * wl-message.el (require): Remove tm support. + + * wl-highlight.el (defin-hilit, defun-hilit2): Eliminated. + + * wl-folder.el (wl-folder-setup-mouse): Ignore nemacs. + (wl-folder-jump-to-current-entity): Ditto. + (wl-folder-mode-map): Added binding for `wl-addrmgr'. + + * wl-e21.el (wl-draft-key-setup): Replaced binding (C-cC-a)for + `wl-draft-insert-x-face-field' to `wl-addrmgr'. + Changed binding for `wl-draft-insert-x-face-field' to C-cC-x. + + * wl-mule.el (wl-draft-key-setup): Ditto. + + * wl-xmas.el (wl-draft-key-setup): Ditto. + + * wl-draft.el (toplevel): Added autoload setting for wl-addrmgr. + (wl-draft-std11-parse-addresses): New function. + (wl-draft-parse-mailbox-list): Use it. + (wl-draft): Ignore nemacs. + (wl-draft-reedit): Ditto. + + * wl-addrmgr.el: New file. + (Original is wl-rcpt.el written by + "Kitamoto Tsuyoshi ". + Thanks Kitamoto-san.) + + * wl-address.el (wl-address-make-address-list): Modified parsing + process. + (wl-address-delete): Renamed from `wl-address-petname-delete'; + Modify wl-address-list too. + (wl-address-add-or-change): Renamed from + `wl-address-petname-add-or-change'; Rewote for wl-addrmgr. + 2001-08-15 YAMASHITA Junji * wl-highlight.el (wl-highlight-summary-current-line): @@ -3406,3 +3464,4 @@ * wl-draft.el (wl-draft): Put category property on mail-header-separator. + \ No newline at end of file diff --git a/wl/tm-wl.el b/wl/tm-wl.el deleted file mode 100644 index 565f823..0000000 --- a/wl/tm-wl.el +++ /dev/null @@ -1,317 +0,0 @@ -;;; wl-mime.el -- tm implementations of MIME processing on Wanderlust. - -;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi - -;; Author: Yuuichi Teranishi -;; Keywords: mail, net news - -;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen). - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. -;; - -;;; Commentary: -;; - -;;; Code: -;; - -(autoload 'mime/editor-mode "tm-edit" nil t) -(autoload 'mime/edit-again "tm-edit" nil t) - -(eval-when-compile (require 'tm-edit)) - -(defalias 'wl-draft-editor-mode 'mime/editor-mode) - -(defun wl-draft-decode-message-in-buffer (&optional default-content-type) - (when default-content-type - (insert "Content-type: " default-content-type "\n") - (insert "\n")) - (mime-editor::edit-again 'code-conversion)) - -(defun wl-draft-yank-current-message-entity () - "Yank currently displayed message entity. -By setting following-method as yank-content." - (let ((wl-draft-buffer (current-buffer)) - (mime-viewer/following-method-alist - (list (cons 'wl-message-original-mode - (function wl-draft-yank-to-draft-buffer))))) - (if (get-buffer (wl-current-message-buffer)) - (save-excursion - (save-restriction - (set-buffer (wl-current-message-buffer)) - (setq mime::preview/mother-buffer nil) - (widen) - (mime-viewer/follow-content)))))) - -(defmacro wl-draft-enclose-digest-region (beg end) - (` (mime-editor/enclose-region "digest" (, beg) (, end)))) - -(defun wl-draft-preview-message () - (interactive) - (let* (recipients-message - (config-exec-flag wl-draft-config-exec-flag) - (mime-viewer/content-header-filter-hook 'wl-highlight-headers) - (mime-viewer/ignored-field-regexp "^:$") - (mime-editor/translate-buffer-hook - (append - (list - (function - (lambda () - (let ((wl-draft-config-exec-flag config-exec-flag)) - (run-hooks 'wl-draft-send-hook) - (setq recipients-message - (concat "Recipients: " - (mapconcat - 'identity - (wl-draft-deduce-address-list - (current-buffer) - (point-min) - (save-excursion - (goto-char (point-min)) - (re-search-forward - (concat "^" - (regexp-quote mail-header-separator) - "$") - nil t) - (point))) - ", "))))))) - mime-editor/translate-buffer-hook))) - (mime-editor/preview-message) - (let ((buffer-read-only nil)) - (when wl-highlight-body-too - (wl-highlight-body)) - (run-hooks 'wl-draft-preview-message-hook)) - (message recipients-message))) - -(defmacro wl-draft-caesar-region (beg end) - (` (tm:caesar-region))) - -(defalias 'wl-draft-insert-message 'mime-editor/insert-message) - -(defalias 'wl-draft-insert-mail 'mime-editor/insert-mail) - -;;; Message - -(defun wl-message-decode-mode (outbuf inbuf) - (let ((mime-viewer/content-header-filter-hook 'wl-highlight-headers)) - (mime/viewer-mode nil nil nil inbuf outbuf))) - -(defun wl-message-decode-with-all-header (outbuf inbuf) - (let ((mime-viewer/ignored-field-regexp "^:$") - (mime-viewer/content-header-filter-hook 'wl-highlight-headers)) - (mime/viewer-mode nil nil nil inbuf outbuf))) - -(defun wl-message-delete-mime-out-buf () - (let (mime-out-buf mime-out-win) - (if (setq mime-out-buf (get-buffer mime/output-buffer-name)) - (if (setq mime-out-win (get-buffer-window mime-out-buf)) - (delete-window mime-out-win))))) - -(defun wl-message-request-partial (folder number) - (elmo-set-work-buf - (elmo-read-msg-no-cache folder number (current-buffer)) - (mime/parse-message nil nil))) - -(defalias 'wl-message-read 'mime-viewer/scroll-up-content) -(defalias 'wl-message-next-content 'mime-viewer/next-content) -(defalias 'wl-message-prev-content 'mime-viewer/previous-content) -(defalias 'wl-message-play-content 'mime-viewer/play-content) -(defalias 'wl-message-extract-content 'mime-viewer/extract-content) -(defalias 'wl-message-quit 'mime-viewer/quit) -(defalias 'wl-message-button-dispatcher-internal - 'tm:button-dispatcher) - -;;; Summary -(defun wl-summary-burst-subr (children target number) - ;; returns new number. - (let (content-type message-entity granch) - (while children - (setq content-type (mime::content-info/type (car children))) - (if (string-match "multipart" content-type) - (setq number (wl-summary-burst-subr - (mime::content-info/children (car children)) - target - number)) - (when (string= "message/rfc822" (downcase content-type)) - (message (format "Bursting...%s" (setq number (+ 1 number)))) - (setq message-entity - (car (mime::content-info/children (car children)))) - (save-restriction - (narrow-to-region (mime::content-info/point-min message-entity) - (mime::content-info/point-max message-entity)) - (elmo-append-msg target - (buffer-substring (point-min) (point-max)) - (std11-field-body "Message-ID"))))) - (setq children (cdr children))))) - -(defun wl-summary-burst () - (interactive) - (let ((raw-buf (wl-message-get-original-buffer)) - target - children message-entity content-type) - (save-excursion - (setq target wl-summary-buffer-folder-name) - (while (not (elmo-folder-writable-p target)) - (setq target - (wl-summary-read-folder wl-default-folder "to extract to "))) - (wl-summary-set-message-buffer-or-redisplay) - (set-buffer raw-buf) - (setq children (mime::content-info/children mime::article/content-info)) - (message "Bursting...") - (when children - (wl-summary-burst-subr children target 0)) - (message "Bursting...done")) - (if (elmo-folder-plugged-p target) - (elmo-commit target)) - (wl-summary-sync-update3))) - -;; internal variable. -(defvar wl-mime-save-dir nil "Last saved directory.") -;;; Yet another save method. -(defun wl-mime-save-content (beg end cal) - (goto-char beg) - (let* ((name - (save-restriction - (narrow-to-region beg end) - (mime-article/get-filename cal))) - (encoding (cdr (assq 'encoding cal))) - (filename (read-file-name "Save to file: " - (expand-file-name - (or name ".") - (or wl-mime-save-dir - wl-tmp-dir)))) - tmp-buf) - (while (file-directory-p filename) - (setq filename (read-file-name "Please set filename (not directory): " - filename))) - (if (file-exists-p filename) - (or (yes-or-no-p (format "File %s exists. Save anyway? " filename)) - (error "Not saved"))) - (setq wl-mime-save-dir (file-name-directory filename)) - (setq tmp-buf (generate-new-buffer (file-name-nondirectory filename))) - (re-search-forward "\n\n") - (append-to-buffer tmp-buf (match-end 0) end) - (save-excursion - (set-buffer tmp-buf) - (mime-decode-region (point-min)(point-max) encoding) - (as-binary-output-file (write-file filename)) - (kill-buffer tmp-buf)))) - -;;; Yet another combine method. -(defun wl-mime-combine-message/partial-pieces (beg end cal) - (interactive) - (let* (folder - (msgdb (save-excursion - (set-buffer wl-message-buffer-cur-summary-buffer) - (setq folder wl-summary-buffer-folder-name) - wl-summary-buffer-msgdb)) - (mime-viewer/content-header-filter-hook 'wl-highlight-headers) - (id (cdr (assoc "id" cal))) - (mother mime::article/preview-buffer) - (target (cdr (assq 'major-mode cal))) - (article-buffer (buffer-name (current-buffer))) - (subject-buf (eval (cdr (assq 'summary-buffer-exp cal)))) - subject-id overviews - (root-dir (expand-file-name - (concat "m-prts-" (user-login-name)) mime/tmp-dir)) - full-file) - (setq root-dir (concat root-dir "/" (replace-as-filename id))) - (setq full-file (concat root-dir "/FULL")) - (if (null target) - (error "%s is not supported" target)) - (if (or (file-exists-p full-file) - (not (y-or-n-p "Merge partials?"))) - (mime-article/decode-message/partial beg end cal) - (message "Merging...") - (let (cinfo the-id parameters) - (setq subject-id - (eword-decode-string - (decode-mime-charset-string - (std11-field-body "Subject") - wl-summary-buffer-mime-charset))) - (if (string-match "[0-9\n]+" subject-id) - (setq subject-id (substring subject-id 0 (match-beginning 0)))) - (setq overviews (elmo-msgdb-get-overview msgdb)) - (catch 'tag - (while overviews - (when (string-match - (regexp-quote subject-id) - (elmo-msgdb-overview-entity-get-subject - (car overviews))) - (setq cinfo - (wl-message-request-partial - folder - (elmo-msgdb-overview-entity-get-number (car overviews)))) - (setq parameters (mime::content-info/parameters cinfo)) - (setq the-id (assoc-value "id" parameters)) - (if (string= the-id id) - (progn - (set-buffer elmo-work-buf-name) - (setq mime::article/preview-buffer - (get-buffer wl-message-buf-name)) - (mime-article/decode-message/partial - (point-min)(point-max) parameters) - (if (file-exists-p full-file) - (throw 'tag nil))))) - (setq overviews (cdr overviews))) - (message "Not all partials found.")))))) - -(defun wl-mime-setup () - (require 'tm-view) - (set-alist 'mime-viewer/quitting-method-alist - 'wl-message-original-mode 'wl-message-exit) - (set-alist 'mime-viewer/over-to-previous-method-alist - 'wl-message-original-mode 'wl-message-exit) - (set-alist 'mime-viewer/over-to-next-method-alist - 'wl-message-original-mode 'wl-message-exit) - (add-hook 'wl-summary-redisplay-hook 'wl-message-delete-mime-out-buf) - (add-hook 'wl-message-exit-hook 'wl-message-delete-mime-out-buf) - (set-atype 'mime/content-decoding-condition - '((type . "message/partial") - (method . wl-message-combine-message/partial-pieces) - (major-mode . wl-message-original-mode) - (summary-buffer-exp . wl-summary-buffer-name))) - (set-atype 'mime/content-decoding-condition - '((mode . "extract") - (method . wl-mime-save-content) - (major-mode . wl-message-original-mode)) - 'remove - '((method "tm-file" nil 'file 'type 'encoding 'mode 'name) - (mode . "extract")) - 'replacement) - (set-alist 'mime-viewer/following-method-alist - 'wl-message-original-mode - (function wl-message-follow-current-entity)) - - (set-alist 'mime-editor/message-inserter-alist - 'wl-draft-mode (function wl-draft-insert-current-message)) - (set-alist 'mime-editor/mail-inserter-alist - 'wl-draft-mode (function wl-draft-insert-get-message)) - (set-alist 'mime-editor/split-message-sender-alist - 'wl-draft-mode - (cdr (assq 'mail-mode - mime-editor/split-message-sender-alist))) - (setq mime-viewer/code-converter-alist - (append - (list (cons 'wl-message-original-mode 'mime-charset/decode-buffer)) - mime-viewer/code-converter-alist)) - (defvar-maybe mime::preview/mother-buffer nil)) - -(require 'product) -(product-provide (provide 'tm-wl) (require 'wl-version)) - -;;; tm-wl.el ends here diff --git a/wl/wl-address.el b/wl/wl-address.el index 2dc1ced..19dcb26 100644 --- a/wl/wl-address.el +++ b/wl/wl-address.el @@ -529,25 +529,25 @@ Refresh `wl-address-list', `wl-address-completion-list', and (wl-address-expand-aliases alist 0) (nreverse alist) ; return value ))) - + (defun wl-address-make-address-list (path) (if (and path (file-readable-p path)) (elmo-set-work-buf - (let (ret - (coding-system-for-read wl-cs-autoconv)) - (insert-file-contents path) - (goto-char (point-min)) - (while (not (eobp)) - (if (looking-at - "^\\([^#\n][^ \t\n]+\\)[ \t]+\"\\(.*\\)\"[ \t]+\"\\(.*\\)\"[ \t]*.*$") - (setq ret - (wl-append-element - ret - (list (wl-match-buffer 1) - (wl-match-buffer 2) - (wl-match-buffer 3))))) - (forward-line)) - ret)))) + (let (ret + (coding-system-for-read wl-cs-autoconv)) + (insert-file-contents path) + (goto-char (point-min)) + (while (not (eobp)) + (if (looking-at + "^\\([^#\n][^ \t\n]+\\)[ \t]+\\(\".*\"\\)[ \t]+\\(\".*\"\\)[ \t]*.*$") + (setq ret + (wl-append-element + ret + (list (wl-match-buffer 1) + (read (wl-match-buffer 2)) + (read (wl-match-buffer 3)))))) + (forward-line)) + ret)))) (defun wl-address-get-petname-1 (string) (let ((address (downcase (wl-address-header-extract-address string)))) @@ -630,70 +630,67 @@ Group list contents is not included." (setq sequence (cdr sequence))))) address-string)) -(defun wl-address-petname-delete (the-email) - "Delete petname in `wl-address-file'." - (let* ( (tmp-buf (get-buffer-create " *wl-petname-tmp*")) - (output-coding-system - (mime-charset-to-coding-system wl-mime-charset))) - (set-buffer tmp-buf) - (message "Deleting Petname...") - (erase-buffer) - (insert-file-contents wl-address-file) - (delete-matching-lines (concat "^[ \t]*" the-email)) - (write-region (point-min) (point-max) - wl-address-file nil 'no-msg) - (message "Deleting Petname...done") - (kill-buffer tmp-buf))) - - -(defun wl-address-petname-add-or-change (the-email - default-petname - default-realname - &optional change-petname) - "Add petname to `wl-address-file', if not registerd. +(defun wl-address-delete (the-email) + "Delete address entry in the `wl-address-file'." + (let ((output-coding-system + (mime-charset-to-coding-system wl-mime-charset))) + (with-temp-buffer + (message "Deleting Address...") + (insert-file-contents wl-address-file) + (delete-matching-lines (concat "^[ \t]*" the-email)) + (write-region (point-min) (point-max) + wl-address-file nil 'no-msg) + ;; Delete entries. + (dolist (entry (elmo-string-assoc-all the-email wl-address-list)) + (setq wl-address-list (delete entry wl-address-list))) + (elmo-set-hash-val the-email nil wl-address-petname-hash) + (message "Deleting Address...done")))) + +(defun wl-address-add-or-change (address + &optional default-realname + change-address) + "Add address entry to `wl-address-file', if not registerd. If already registerd, change it." - (let (the-realname the-petname) - - ;; setup output "petname" - ;; if null petname'd, let default-petname be the petname. - (setq the-petname - (read-from-minibuffer (format "Petname: ") default-petname)) - (if (string= the-petname "") - (setq the-petname (or default-petname the-email))) - - ;; setup output "realname" + (let ((entry (assoc address wl-address-list)) + the-realname the-petname new-addr addr-changed) (setq the-realname - (read-from-minibuffer (format "Real Name: ") default-realname)) -;;; (if (string= the-realname "") -;;; (setq the-realname default-petname)) - + (read-from-minibuffer "Real Name: " (or default-realname + (nth 2 entry)))) + (setq the-petname (read-from-minibuffer "Petname: " + (or (nth 1 entry) + the-realname))) + (when change-address + (setq new-addr (read-from-minibuffer "E-Mail: " address)) + (if (and (not (string= address new-addr)) + (assoc new-addr wl-address-list)) + (error "'%s' already exists" new-addr))) ;; writing to ~/.address - (let ( (tmp-buf (get-buffer-create " *wl-petname-tmp*")) - (output-coding-system (mime-charset-to-coding-system wl-mime-charset))) - (set-buffer tmp-buf) - (message "Adding Petname...") - (erase-buffer) - (if (file-exists-p wl-address-file) - (insert-file-contents wl-address-file)) - (if (not change-petname) - ;; if only add - (progn - (goto-char (point-max)) - (if (and (> (buffer-size) 0) - (not (eq (char-after (1- (point-max))) ?\n))) - (insert "\n"))) - ;; if change - (if (re-search-forward (concat "^[ \t]*" the-email) nil t) + (let ((output-coding-system + (mime-charset-to-coding-system wl-mime-charset))) + (with-temp-buffer + (if (file-exists-p wl-address-file) + (insert-file-contents wl-address-file)) + (if (null entry) + ;; add + (progn + (goto-char (point-max)) + (if (and (> (buffer-size) 0) + (not (eq (char-after (1- (point-max))) ?\n))) + (insert "\n"))) + ;; override + (while (re-search-forward (concat "^[ \t]*" address) nil t) (delete-region (save-excursion (beginning-of-line) (point)) (save-excursion (end-of-line) (+ 1 (point)))))) - (insert (format "%s\t\"%s\"\t\"%s\"\n" - the-email the-petname the-realname)) - (write-region (point-min) (point-max) - wl-address-file nil 'no-msg) - (message "Adding Petname...done") - (kill-buffer tmp-buf)))) + (insert (format "%s\t%s\t%s\n" + (or new-addr address) + (prin1-to-string the-petname) + (prin1-to-string the-realname))) + (write-region (point-min) (point-max) + wl-address-file nil 'no-msg) + (wl-address-init) + (list (or new-addr address) the-petname the-realname))))) (require 'product) (product-provide (provide 'wl-address) (require 'wl-version)) diff --git a/wl/wl-addrmgr.el b/wl/wl-addrmgr.el new file mode 100644 index 0000000..dd5ba00 --- /dev/null +++ b/wl/wl-addrmgr.el @@ -0,0 +1,669 @@ +;;; wl-addrmgr.el -- Address manager for Wanderlust. + +;; Copyright (C) 2001 Kitamoto Tsuyoshi +;; Copyright (C) 2001 Yuuichi Teranishi + +;; Author: Kitamoto Tsuyoshi +;; Yuuichi Teranishi +;; Keywords: mail, net news + +;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen). + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. +;; + +;;; Commentary: +;; Edit To:, Cc:, Bcc: fields interactively from E-Mail address list +;; on ~/.address file. + +;;; Code: +;; + +(require 'wl-address) +(require 'wl-draft) + +;; Variables +(defgroup wl-addrmgr nil + "Wanderlust Address manager." + :prefix "wl-" + :group 'wl) + +(defcustom wl-addrmgr-buffer-lines 10 + "*Buffer lines for ADDRMGR buffer for draft." + :type 'integer + :group 'wl-addrmgr) + +(defcustom wl-addrmgr-default-sort-key 'realname + "Default element for sort." + :type '(choice '(address realname petname none)) + :group 'wl-addrmgr) + +(defcustom wl-addrmgr-default-sort-order 'ascending + "Default element for sort." + :type '(choice '(ascending descending)) + :group 'wl-addrmgr) + +(defcustom wl-addrmgr-realname-width 17 + "Width for realname." + :type 'integer + :group 'wl-addrmgr) + +(defcustom wl-addrmgr-petname-width 10 + "Width for petname." + :type 'integer + :group 'wl-addrmgr) + +(defcustom wl-addrmgr-line-width 78 + "Width for each line." + :type 'integer + :group 'wl-addrmgr) + +(defcustom wl-addrmgr-realname-face 'wl-highlight-summary-normal-face + "Face for realname." + :type 'face + :group 'wl-addrmgr) + +(defcustom wl-addrmgr-petname-face 'wl-highlight-summary-unread-face + "Face for petname." + :type 'face + :group 'wl-addrmgr) + +(defcustom wl-addrmgr-address-face 'wl-highlight-summary-new-face + "Face for address." + :type 'face + :group 'wl-addrmgr) + +(defcustom wl-addrmgr-default-method 'local + "Default access method for address entries. +Defined by `wl-addrmgr-method-alist'." + :type 'symbol + :group 'wl-addrmgr) + +(defvar wl-addrmgr-buffer-name "Address") +(defvar wl-addrmgr-mode-map nil) + +(defvar wl-addrmgr-method-alist + '((local . (wl-addrmgr-local-list ; list address entries + wl-addrmgr-local-add ; add address entry + wl-addrmgr-local-edit ; edit address entry + wl-addrmgr-local-delete ; delete address entry + )))) + +;; buffer local variable. +(defvar wl-addrmgr-draft-buffer nil) +(defvar wl-addrmgr-unknown-list nil) +(defvar wl-addrmgr-sort-key nil) +(defvar wl-addrmgr-sort-order nil) +(defvar wl-addrmgr-method nil) +(defvar wl-addrmgr-list nil) +(defvar wl-addrmgr-method-name nil) + +(make-variable-buffer-local 'wl-addrmgr-draft-buffer) +(make-variable-buffer-local 'wl-addrmgr-unknown-list) +(make-variable-buffer-local 'wl-addrmgr-sort-key) +(make-variable-buffer-local 'wl-addrmgr-sort-order) +(make-variable-buffer-local 'wl-addrmgr-method) +(make-variable-buffer-local 'wl-addrmgr-list) +(make-variable-buffer-local 'wl-addrmgr-method-name) + +;;; Code + +(if wl-addrmgr-mode-map + nil + (setq wl-addrmgr-mode-map (make-sparse-keymap)) + (define-key wl-addrmgr-mode-map "<" 'wl-addrmgr-goto-top) + (define-key wl-addrmgr-mode-map ">" 'wl-addrmgr-goto-bottom) + (define-key wl-addrmgr-mode-map "t" 'wl-addrmgr-mark-set-to) + (define-key wl-addrmgr-mode-map "b" 'wl-addrmgr-mark-set-bcc) + (define-key wl-addrmgr-mode-map "c" 'wl-addrmgr-mark-set-cc) + (define-key wl-addrmgr-mode-map "u" 'wl-addrmgr-unmark) + (define-key wl-addrmgr-mode-map "x" 'wl-addrmgr-apply) + + (define-key wl-addrmgr-mode-map "\C-c\C-c" 'wl-addrmgr-apply) + + (define-key wl-addrmgr-mode-map "n" 'wl-addrmgr-next) + (define-key wl-addrmgr-mode-map "j" 'wl-addrmgr-next) + (define-key wl-addrmgr-mode-map "k" 'wl-addrmgr-prev) + (define-key wl-addrmgr-mode-map "p" 'wl-addrmgr-prev) + (define-key wl-addrmgr-mode-map [down] 'wl-addrmgr-next) + (define-key wl-addrmgr-mode-map [up] 'wl-addrmgr-prev) + + (define-key wl-addrmgr-mode-map "s" 'wl-addrmgr-sort) + + (define-key wl-addrmgr-mode-map "a" 'wl-addrmgr-add) + (define-key wl-addrmgr-mode-map "d" 'wl-addrmgr-delete) + (define-key wl-addrmgr-mode-map "e" 'wl-addrmgr-edit) + (define-key wl-addrmgr-mode-map "\n" 'wl-addrmgr-edit) + (define-key wl-addrmgr-mode-map "\r" 'wl-addrmgr-edit) + + (define-key wl-addrmgr-mode-map "q" 'wl-addrmgr-quit) + (define-key wl-addrmgr-mode-map "\C-c\C-k" 'wl-addrmgr-quit) + + (define-key wl-addrmgr-mode-map "C" 'wl-addrmgr-change-method) + + (define-key wl-addrmgr-mode-map "Z" 'wl-addrmgr-reload) + (define-key wl-addrmgr-mode-map "\C-c\C-l" 'wl-addrmgr-redraw)) + +(defun wl-addrmgr-mode () + "Major mode for Wanderlust address management. +See info under Wanderlust for full documentation. + +\\{wl-addrmgr-mode}" + (kill-all-local-variables) + (setq mode-name "Address" + major-mode 'wl-addrmgr-mode) + (wl-mode-line-buffer-identification + '("Wanderlust: Address (" wl-addrmgr-method-name ")")) + (use-local-map wl-addrmgr-mode-map) + (setq buffer-read-only t)) + +(defun wl-addrmgr-address-entry-list (field) + "Return address list." + (mapcar + (lambda (addr) + (cons (nth 1 (std11-extract-address-components addr)) + addr)) + (wl-parse-addresses + (mapconcat 'identity (elmo-multiple-fields-body-list (list field)) ",")))) + +;;;###autoload +(defun wl-addrmgr () + "Start an Address manager." + (interactive) + (let ((buffer (if (eq major-mode 'wl-draft-mode) (current-buffer))) + (already-list (list (cons 'to (wl-addrmgr-address-entry-list "to")) + (cons 'cc (wl-addrmgr-address-entry-list "cc")) + (cons 'bcc (wl-addrmgr-address-entry-list "bcc"))))) + (if (eq major-mode 'wl-draft-mode) + (if (get-buffer-window wl-addrmgr-buffer-name) + nil + (split-window (selected-window) + (- (window-height (selected-window)) + wl-addrmgr-buffer-lines)) + (select-window (next-window)) + ;; Non-nil means display-buffer should make new windows. + (let ((pop-up-windows nil)) + (switch-to-buffer + (get-buffer-create wl-addrmgr-buffer-name)))) + (switch-to-buffer (get-buffer-create wl-addrmgr-buffer-name))) + (set-buffer wl-addrmgr-buffer-name) + (wl-addrmgr-mode) + (unless wl-addrmgr-method + (setq wl-addrmgr-method wl-addrmgr-default-method + wl-addrmgr-method-name (symbol-name wl-addrmgr-default-method))) + (unless wl-addrmgr-sort-key + (setq wl-addrmgr-sort-key wl-addrmgr-default-sort-key)) + (unless wl-addrmgr-sort-order + (setq wl-addrmgr-sort-order wl-addrmgr-default-sort-order)) + (setq wl-addrmgr-draft-buffer buffer) + (setq wl-addrmgr-list (wl-addrmgr-list)) + (wl-addrmgr-draw already-list) + (setq wl-addrmgr-unknown-list already-list) + (wl-addrmgr-goto-top))) + +(defun wl-addrmgr-goto-top () + (interactive) + (goto-char (point-min)) + (forward-line 2) + (forward-char 4)) + +(defun wl-addrmgr-goto-bottom () + (interactive) + (goto-char (point-max)) + (beginning-of-line) + (forward-char 4)) + +(defun wl-addrmgr-reload () + "Reload addresses entries." + (interactive) + (setq wl-addrmgr-list (wl-addrmgr-list 'reload)) + (wl-addrmgr-redraw)) + +(defun wl-addrmgr-redraw () + "Redraw addresses entries." + (interactive) + (let ((rcpt (wl-addrmgr-mark-check))) + (wl-addrmgr-draw (list (cons 'to (nth 0 rcpt)) + (cons 'cc (nth 1 rcpt)) + (cons 'bcc (nth 2 rcpt))))) + (wl-addrmgr-goto-top)) + +(defun wl-addrmgr-sort-list (key list order) + (let ((pos (case key + (address 0) + (petname 1) + (realname 2))) + sorted) + (if pos + (progn + (setq sorted (sort list `(lambda (a b) (string< (nth ,pos a) + (nth ,pos b))))) + (if (eq order 'descending) + (nreverse sorted) + sorted)) + list))) + +(defun wl-addrmgr-insert-line (entry) + (let ((real (nth 2 entry)) + (pet (nth 1 entry)) + (addr (nth 0 entry)) + beg) + (insert " ") + (setq beg (point)) + (setq real (wl-set-string-width wl-addrmgr-realname-width real)) + (put-text-property 0 (length real) 'face + wl-addrmgr-realname-face + real) + (setq pet (wl-set-string-width wl-addrmgr-petname-width pet)) + (put-text-property 0 (length pet) 'face + wl-addrmgr-petname-face + pet) + (setq addr (copy-sequence addr)) + (put-text-property 0 (length addr) 'face + wl-addrmgr-address-face + addr) + (insert + (wl-set-string-width + (- wl-addrmgr-line-width 4) + (concat real " " pet " " addr))) + (put-text-property beg (point) 'wl-addrmgr-entry entry))) + +(defun wl-addrmgr-search-forward-address (address) + "Search forward from point for ADDRESS. +Return nil if no ADDRESS exists." + (let ((pos (point))) + (if (catch 'found + (while (not (eobp)) + (if (string= address (car (wl-addrmgr-address-entry))) + (throw 'found t) + (forward-line)))) + (point) + (goto-char pos) + nil))) + +(defun wl-addrmgr-draw (already-list) + "Show recipients mail addresses." + (save-excursion + (let ((buffer-read-only nil) + list field addrs beg real pet addr) + (erase-buffer) + (goto-char (point-min)) + (insert + "Mark " + (wl-set-string-width wl-addrmgr-realname-width + "Realname") + " " + (wl-set-string-width wl-addrmgr-petname-width + "Petname") + " Address\n") + (insert "---- " + (make-string wl-addrmgr-realname-width ?-) + " " + (make-string wl-addrmgr-petname-width ?-) + " ---------------") + (dolist (entry (wl-addrmgr-sort-list wl-addrmgr-sort-key + (copy-sequence wl-addrmgr-list) + wl-addrmgr-sort-order)) + (insert "\n") + (wl-addrmgr-insert-line entry)) + (set-buffer-modified-p nil) + (while already-list + (setq list (car already-list) + field (car list) + addrs (cdr list)) + (while addrs + (goto-char (point-min)) + (when (wl-addrmgr-search-forward-address (car (car addrs))) + (wl-addrmgr-mark-write field) + (setcdr list (delq (car addrs) (cdr list)))) + (setq addrs (cdr addrs))) + (setq already-list (cdr already-list)))))) + +(defun wl-addrmgr-next () + "Move cursor next line." + (interactive) + (end-of-line) + (let ((current (count-lines (point-min) (point))) + first) + (cond + ((<= current 2) + (when (setq first (next-single-property-change (point) 'wl-addrmgr-entry + nil)) + (goto-char first) + (beginning-of-line) + (forward-char 4))) + (t + (forward-line) + (beginning-of-line) + (forward-char 4))))) + +(defun wl-addrmgr-prev () + "Move cursor prev line." + (interactive) + (let ((current (count-lines (point-min) (point)))) + (cond + ((= current 3) + (beginning-of-line) + (forward-char 4)) + ((< current 3) + (goto-char (point-min)) + (forward-line 2) + (forward-char 4)) + (t + (forward-line -1) + (forward-char 4))))) + +(defun wl-addrmgr-quit-yes () + (if (and wl-addrmgr-draft-buffer + (buffer-live-p wl-addrmgr-draft-buffer) + (null (get-buffer-window wl-addrmgr-draft-buffer))) + (switch-to-buffer wl-addrmgr-draft-buffer) + (unless (one-window-p) + (delete-window))) + (kill-buffer wl-addrmgr-buffer-name)) + +(defun wl-addrmgr-quit () + "Exit from electric reference mode without inserting reference." + (interactive) + (let ((rcpt (wl-addrmgr-mark-check))) + (if (or (nth 0 rcpt) + (nth 1 rcpt) + (nth 2 rcpt)) + (when (y-or-n-p "There is marked address. Quit wl-addrmgr really? ") + (wl-addrmgr-quit-yes)) + (wl-addrmgr-quit-yes))) + (message "")) + +(defun wl-addrmgr-mark-set-to () + "Marking To: sign." + (interactive) + (wl-addrmgr-mark-write 'to) + (wl-addrmgr-next)) + +(defun wl-addrmgr-mark-set-cc () + "Marking Cc: sign." + (interactive) + (wl-addrmgr-mark-write 'cc) + (wl-addrmgr-next)) + +(defun wl-addrmgr-mark-set-bcc () + "Marking Bcc: sign." + (interactive) + (wl-addrmgr-mark-write 'bcc) + (wl-addrmgr-next)) + +(defun wl-addrmgr-unmark () + "Erase Marked sign." + (interactive) + (let ((entry (wl-addrmgr-address-entry)) + buffer-read-only) + (save-excursion + (beginning-of-line) + (delete-region (point) (progn (end-of-line)(point))) + (wl-addrmgr-insert-line entry)) + (set-buffer-modified-p nil) + (wl-addrmgr-next))) + +(defun wl-addrmgr-sort () + "Sort address entry." + (interactive) + (setq wl-addrmgr-sort-key (intern + (completing-read + (format "Sort By (%s): " + (symbol-name wl-addrmgr-sort-key)) + '(("address")("realname")("petname")("none")) + nil t nil nil + (symbol-name wl-addrmgr-sort-key)))) + (if (eq wl-addrmgr-sort-key 'none) + (wl-addrmgr-reload) + (setq wl-addrmgr-sort-order (intern + (completing-read + (format "Sort Order (%s): " + (symbol-name wl-addrmgr-sort-order)) + '(("ascending") ("descending")) + nil t nil nil + (symbol-name wl-addrmgr-sort-order)))) + (wl-addrmgr-redraw))) + +;;; Backend methods. +(defun wl-addrmgr-method-call (method &rest args) + (apply (intern (concat "wl-addrmgr-" + (symbol-name wl-addrmgr-method) + "-" (symbol-name method))) + args)) + +(defun wl-addrmgr-change-method () + (interactive) + (setq wl-addrmgr-method (intern + (setq wl-addrmgr-method-name + (completing-read + (format "Method (%s): " + (symbol-name wl-addrmgr-method)) + (mapcar (lambda (pair) + (list (symbol-name (car pair)))) + wl-addrmgr-method-alist) + nil t nil nil + (symbol-name wl-addrmgr-method))))) + (wl-addrmgr-redraw)) + +(defun wl-addrmgr-list (&optional reload) + "List address entries." + (wl-addrmgr-method-call 'list reload)) + +(defun wl-addrmgr-add () + "Add address entry." + (interactive) + (let ((entry (wl-addrmgr-method-call 'add))) + (if (eq wl-addrmgr-sort-key 'none) + (wl-addrmgr-reload) + (setq wl-addrmgr-list (cons entry wl-addrmgr-list)) + (wl-addrmgr-redraw)) + (message "Added `%s'." (wl-string (car entry))))) + +(defun wl-addrmgr-delete () + "Delete address entry." + (interactive) + (let ((addr (wl-string (car (wl-addrmgr-address-entry)))) + lines) + (when (and addr + (y-or-n-p (format "Delete '%s'? " addr))) + (setq lines (count-lines (point-min) (point))) + (wl-addrmgr-method-call 'delete addr) + (setq wl-addrmgr-list (delq (assoc addr wl-addrmgr-list) + wl-addrmgr-list)) + (wl-addrmgr-redraw) + (forward-line (- lines 2)) + (message "Deleted `%s'." addr)))) + +(defun wl-addrmgr-edit () + "Edit address entry." + (interactive) + (let ((orig (wl-addrmgr-address-entry)) + entry lines) + (setq entry (wl-addrmgr-method-call 'edit (wl-string (car orig)))) + (setq lines (count-lines (point-min) (point))) + (if (eq wl-addrmgr-sort-key 'none) + (wl-addrmgr-reload) + (setq wl-addrmgr-list (delq (assoc (car orig) wl-addrmgr-list) + wl-addrmgr-list) + wl-addrmgr-list (cons entry wl-addrmgr-list)) + (wl-addrmgr-redraw)) + (forward-line (- lines 1)) + (message "Modified `%s'." (wl-string (car entry))))) + +;;; local address book implementation. +(defun wl-addrmgr-local-list (reload) + (if (or (null wl-address-list) reload) + (wl-address-init)) + (copy-sequence wl-address-list)) + +(defun wl-addrmgr-local-add () + (wl-address-add-or-change nil nil 'addr-too)) + +(defun wl-addrmgr-local-edit (address) + (wl-address-add-or-change address nil 'addr-too)) + +(defun wl-addrmgr-local-delete (address) + (wl-address-delete address)) + +;;; LDAP implementation (Implement Me) + +;;; Operations. + +(defun wl-addrmgr-address-entry () + (save-excursion + (end-of-line) + (get-text-property (previous-single-property-change + (point) 'wl-addrmgr-entry nil + (progn + (beginning-of-line) + (point))) + 'wl-addrmgr-entry))) + +(defun wl-addrmgr-mark-write (&optional mark) + "Set MARK to the current address entry." + (save-excursion + (end-of-line) + (unless (< (count-lines (point-min) (point)) 3) + (let ((buffer-read-only nil) beg end) + (beginning-of-line) + (delete-char 4) + (insert (case mark + (to "To: ") + (cc "Cc: ") + (bcc "Bcc:") + (t " "))) + (insert (make-string (- 4 (current-column)) ? )) + (beginning-of-line) + (setq beg (point)) + (setq end (progn (end-of-line) + (point))) + (put-text-property beg end 'face nil) + (wl-highlight-message beg end nil)) + (set-buffer-modified-p nil) + (beginning-of-line) + (forward-char 4)))) + +(defun wl-addrmgr-apply () + (interactive) + (let ((rcpt (wl-addrmgr-mark-check 'full))) + (when (or (or (nth 0 rcpt) + (nth 1 rcpt) + (nth 2 rcpt)) + (or (cdr (assq 'to wl-addrmgr-unknown-list)) + (cdr (assq 'cc wl-addrmgr-unknown-list)) + (cdr (assq 'bcc wl-addrmgr-unknown-list)))) + (wl-addrmgr-apply-exec (wl-addrmgr-mark-check 'full))) + (wl-addrmgr-quit-yes))) + +(defun wl-addrmgr-mark-check (&optional full) + "Return list of recipients (TO CC BCC)." + (save-excursion ; save cursor POINT + (goto-char (point-min)) + (forward-line 2) + (let (to-list cc-list bcc-list mark addr realname) + (while (and (not (eobp)) + (re-search-forward "^\\([^ ]+:\\) " nil t)) + (setq mark (match-string 1)) + (setq addr (car (wl-addrmgr-address-entry))) + (setq realname (nth 2 (wl-addrmgr-address-entry))) + (cond + ((string= mark "To:") + (setq to-list (cons (if full (concat + (wl-address-quote-specials realname) + " <" addr">") + addr) + to-list))) + ((string= mark "Cc:") + (setq cc-list (cons (if full (concat + (wl-address-quote-specials realname) + " <" addr">") + addr) + cc-list))) + ((string= mark "Bcc:") + (setq bcc-list (cons (if full (concat + (wl-address-quote-specials realname) + " <" addr">") + addr) + bcc-list))))) + (list to-list cc-list bcc-list)))) + +(defun wl-addrmgr-apply-exec (rcpt) + (let ((to (nconc (nth 0 rcpt) (mapcar + 'cdr + (cdr (assq 'to wl-addrmgr-unknown-list))))) + (cc (nconc (nth 1 rcpt) (mapcar + 'cdr + (cdr (assq 'cc wl-addrmgr-unknown-list))))) + (bcc (nconc (nth 2 rcpt) (mapcar + 'cdr + (cdr (assq 'bcc wl-addrmgr-unknown-list))))) + from clist) + (setq clist (list (cons "Bcc" (if bcc (mapconcat 'identity bcc ",\n\t"))) + (cons "Cc" (if cc (mapconcat 'identity cc ",\n\t"))) + (cons "To" (if to (mapconcat 'identity to ",\n\t"))))) + (when (or (null wl-addrmgr-draft-buffer) + (not (buffer-live-p wl-addrmgr-draft-buffer))) + (setq wl-addrmgr-draft-buffer (save-window-excursion + (wl-draft) + (current-buffer)))) + (with-current-buffer wl-addrmgr-draft-buffer + (setq from (std11-field-body "From")) + (if from + (setq clist (append clist (list (cons "From" from))))) + (wl-addrmgr-mark-exec-sub clist)))) + +(defun wl-addrmgr-replace-field (field content) + "Insert FIELD with CONTENT to the top of the header fields." + (save-excursion + (save-restriction + (let ((case-fold-search t) + (inhibit-read-only t) ;; added by teranisi. + beg) + (std11-narrow-to-header mail-header-separator) + (goto-char (point-min)) + (while (re-search-forward (concat "^" (regexp-quote field) ":") nil t) + ;; delete field + (progn + (save-excursion + (beginning-of-line) + (setq beg (point))) + (re-search-forward "^[^ \t]" nil 'move) + (beginning-of-line) + (delete-region beg (point)))) + (when content + ;; add field to top. + (goto-char (point-min)) + (insert (concat field ": " content "\n"))))))) + +(defun wl-addrmgr-mark-exec-sub (list) + (dolist (pair list) + (wl-addrmgr-replace-field (car pair) (cdr pair))) + ;; from wl-template.el + ;; rehighlight + (if wl-highlight-body-too + (let ((beg (point-min)) + (end (point-max))) + (put-text-property beg end 'face nil) + (wl-highlight-message beg end t)))) + +;; beginning of the end +(require 'product) +(product-provide + (provide 'wl-addrmgr) + (require 'wl-version)) + +;;; wl-addrmgr.el ends here diff --git a/wl/wl-draft.el b/wl/wl-draft.el index d8f2e41..39c19f6 100644 --- a/wl/wl-draft.el +++ b/wl/wl-draft.el @@ -49,6 +49,9 @@ (defalias-maybe 'wl-init 'ignore) (defalias-maybe 'wl-draft-mode 'ignore)) +(eval-and-compile + (autoload 'wl-addrmgr "wl-addrmgr")) + (defvar wl-draft-buf-name "Draft") (defvar wl-draft-cite-function 'wl-default-draft-cite) (defvar wl-draft-buffer-file-name nil) @@ -813,6 +816,20 @@ to find out how to use this." msg-id-list)))) (nreverse msg-id-list))) +(defun wl-draft-std11-parse-addresses (lal) + (let ((ret (std11-parse-address lal))) + (if ret + (let ((dest (list (car ret)))) + (setq lal (cdr ret)) + (while (and (setq ret (std11-parse-ascii-token lal)) + (string-equal (cdr (assq 'specials (car ret))) ",") + (setq ret (std11-parse-address (cdr ret))) + ) + (setq dest (cons (car ret) dest)) + (setq lal (cdr ret))) + (if lal (error "Error while parsing address")) + (nreverse dest))))) + (defun wl-draft-parse-mailbox-list (field &optional remove-group-list) "Get mailbox list of FIELD from current buffer. The buffer is expected to be narrowed to just the headers of the message. @@ -832,7 +849,7 @@ from current buffer." (skip-chars-backward "\n") (setq seq (std11-lexical-analyze (buffer-substring-no-properties beg (point)))) - (setq addresses (std11-parse-addresses seq)) + (setq addresses (wl-draft-std11-parse-addresses seq)) (while addresses (cond ((eq (car (car addresses)) 'group) (setq has-group-list t) @@ -1389,9 +1406,7 @@ If optional argument is non-nil, current draft buffer is killed" (1- (point))) 'category 'mail-header-separator) (and body (insert body))) - (if wl-on-nemacs - (push-mark (point) t) - (push-mark (point) t t)) + (push-mark (point) t t) (as-binary-output-file (write-region (point-min)(point-max) wl-draft-buffer-file-name nil t)) @@ -1491,9 +1506,7 @@ If optional argument is non-nil, current draft buffer is killed" (goto-char (point-min)) (or (re-search-forward "\n\n" nil t) (search-forward (concat mail-header-separator "\n") nil t)) - (if wl-on-nemacs - (push-mark (point) t) - (push-mark (point) t t)) + (push-mark (point) t t) (write-region (point-min)(point-max) wl-draft-buffer-file-name nil t) (wl-draft-overload-functions) diff --git a/wl/wl-e21.el b/wl/wl-e21.el index 2ecf5dd..49ca7e8 100644 --- a/wl/wl-e21.el +++ b/wl/wl-e21.el @@ -595,7 +595,6 @@ Special commands: (defun wl-draft-key-setup () (define-key wl-draft-mode-map "\C-c\C-y" 'wl-draft-yank-original) (define-key wl-draft-mode-map "\C-c\C-s" 'wl-draft-send) - (define-key wl-draft-mode-map "\C-c\C-a" 'wl-draft-insert-x-face-field) (define-key wl-draft-mode-map "\C-c\C-c" 'wl-draft-send-and-exit) (define-key wl-draft-mode-map "\C-c\C-z" 'wl-draft-save-and-exit) (define-key wl-draft-mode-map "\C-c\C-k" 'wl-draft-kill) @@ -607,6 +606,8 @@ Special commands: (define-key wl-draft-mode-map "\C-c\C-e" 'wl-draft-config-exec) (define-key wl-draft-mode-map "\C-c\C-j" 'wl-template-select) (define-key wl-draft-mode-map "\C-c\C-p" 'wl-draft-preview-message) + (define-key wl-draft-mode-map "\C-c\C-x" 'wl-draft-insert-x-face-field) + (define-key wl-draft-mode-map "\C-c\C-a" 'wl-addrmgr) (define-key wl-draft-mode-map "\C-x\C-s" 'wl-draft-save) (define-key wl-draft-mode-map "\C-xk" 'wl-draft-mimic-kill-buffer)) diff --git a/wl/wl-folder.el b/wl/wl-folder.el index 6ab1592..74596e8 100644 --- a/wl/wl-folder.el +++ b/wl/wl-folder.el @@ -123,14 +123,12 @@ 'wl-folder-prev-unread) (define-key wl-folder-mode-map [(shift button5)] 'wl-folder-next-unread)) - (if wl-on-nemacs - (defun wl-folder-setup-mouse ()) - (defun wl-folder-setup-mouse () - (define-key wl-folder-mode-map [mouse-2] 'wl-folder-click) - (define-key wl-folder-mode-map [mouse-4] 'wl-folder-prev-entity) - (define-key wl-folder-mode-map [mouse-5] 'wl-folder-next-entity) - (define-key wl-folder-mode-map [S-mouse-4] 'wl-folder-prev-unread) - (define-key wl-folder-mode-map [S-mouse-5] 'wl-folder-next-unread)))) + (defun wl-folder-setup-mouse () + (define-key wl-folder-mode-map [mouse-2] 'wl-folder-click) + (define-key wl-folder-mode-map [mouse-4] 'wl-folder-prev-entity) + (define-key wl-folder-mode-map [mouse-5] 'wl-folder-next-entity) + (define-key wl-folder-mode-map [S-mouse-4] 'wl-folder-prev-unread) + (define-key wl-folder-mode-map [S-mouse-5] 'wl-folder-next-unread))) (if wl-folder-mode-map nil @@ -147,6 +145,7 @@ (define-key wl-folder-mode-map "w" 'wl-draft) (define-key wl-folder-mode-map "W" 'wl-folder-write-current-folder) (define-key wl-folder-mode-map "\C-c\C-o" 'wl-jump-to-draft-buffer) + (define-key wl-folder-mode-map "\C-c\C-a" 'wl-addrmgr) (define-key wl-folder-mode-map "rS" 'wl-folder-sync-region) (define-key wl-folder-mode-map "S" 'wl-folder-sync-current-entity) (define-key wl-folder-mode-map "rs" 'wl-folder-check-region) @@ -173,8 +172,7 @@ (define-key wl-folder-mode-map "<" 'beginning-of-buffer) (define-key wl-folder-mode-map ">" 'end-of-buffer) ;; wl-fldmgr - (unless wl-on-nemacs - (define-key wl-folder-mode-map "m" 'wl-fldmgr-mode-map)) + (define-key wl-folder-mode-map "m" 'wl-fldmgr-mode-map) (define-key wl-folder-mode-map "*" 'wl-fldmgr-make-multi) (define-key wl-folder-mode-map "+" 'wl-fldmgr-make-group) (define-key wl-folder-mode-map "|" 'wl-fldmgr-make-filter) @@ -651,15 +649,10 @@ Optional argument ARG is repeart count." ; (wl-highlight-folder-current-line) ))) ((setq fld-name (wl-folder-entity-name)) - (if wl-on-nemacs - (progn - (wl-folder-set-current-entity-id - (wl-folder-get-entity-from-buffer)) - (setq fld-name (wl-folder-get-realname fld-name))) - (wl-folder-set-current-entity-id - (get-text-property (point) 'wl-folder-entity-id)) - (setq fld-name (wl-folder-get-folder-name-by-id - wl-folder-buffer-cur-entity-id))) + (wl-folder-set-current-entity-id + (get-text-property (point) 'wl-folder-entity-id)) + (setq fld-name (wl-folder-get-folder-name-by-id + wl-folder-buffer-cur-entity-id)) (let ((summary-buf (wl-summary-get-buffer-create fld-name arg)) error-selecting) (if (or wl-stay-folder-window wl-summary-use-frame) diff --git a/wl/wl-highlight.el b/wl/wl-highlight.el index 1f7d6c1..5a1654c 100644 --- a/wl/wl-highlight.el +++ b/wl/wl-highlight.el @@ -40,8 +40,6 @@ (require 'wl-xmas)) (wl-on-emacs21 (require 'wl-e21)) - (wl-on-nemacs - (require 'wl-nemacs)) (t (require 'wl-mule))) (defun-maybe extent-begin-glyph (a)) @@ -720,30 +718,16 @@ wl-highlight-message-cited-text-9 wl-highlight-message-cited-text-10)) -(defmacro defun-hilit (name &rest everything-else) - "Define a function for highlight. Nemacs implementation is set as empty." - (if wl-on-nemacs - (` (defun (, name) nil nil)) - (` (defun (, name) (,@ everything-else))))) - -(defmacro defun-hilit2 (name &rest everything-else) - "Define a function for highlight w/o nemacs." - (if wl-on-nemacs - () ; noop - (` (defun (, name) (,@ everything-else))))) - (defmacro wl-delete-all-overlays () "Delete all momentary overlays." - (if wl-on-nemacs - nil - '(let ((overlays (overlays-in (point-min) (point-max))) - overlay) - (while (setq overlay (car overlays)) - (if (overlay-get overlay 'wl-momentary-overlay) - (delete-overlay overlay)) - (setq overlays (cdr overlays)))))) - -(defun-hilit wl-highlight-summary-displaying () + '(let ((overlays (overlays-in (point-min) (point-max))) + overlay) + (while (setq overlay (car overlays)) + (if (overlay-get overlay 'wl-momentary-overlay) + (delete-overlay overlay)) + (setq overlays (cdr overlays))))) + +(defun wl-highlight-summary-displaying () (interactive) (wl-delete-all-overlays) (let (bol eol ov) @@ -757,7 +741,7 @@ (overlay-put ov 'evaporate t) (overlay-put ov 'wl-momentary-overlay t)))) -(defun-hilit2 wl-highlight-folder-group-line (numbers) +(defun wl-highlight-folder-group-line (numbers) (end-of-line) (let ((eol (point)) bol) @@ -790,7 +774,7 @@ (put-text-property bol (match-end 0) 'face face))) (put-text-property bol eol 'face text-face))))) -(defun-hilit2 wl-highlight-summary-line-string (line mark temp-mark indent) +(defun wl-highlight-summary-line-string (line mark temp-mark indent) (let (fsymbol) (cond ((and (string= temp-mark "+") (member mark (list wl-summary-unread-cached-mark @@ -828,7 +812,7 @@ (if wl-use-highlight-mouse-line (put-text-property 0 (length line) 'mouse-face 'highlight line))) -(defun-hilit2 wl-highlight-summary-current-line (&optional smark regexp temp-too) +(defun wl-highlight-summary-current-line (&optional smark regexp temp-too) (interactive) (save-excursion (let ((inhibit-read-only t) @@ -909,7 +893,7 @@ (if wl-use-dnd (wl-dnd-set-drag-starter bol eol))))) -(defun-hilit2 wl-highlight-folder (start end) +(defun wl-highlight-folder (start end) "Highlight folder between start and end. Faces used: wl-highlight-folder-unknown-face unread messages @@ -939,7 +923,7 @@ Variables used: (wl-highlight-folder-current-line) (forward-line 1))))))) -(defun-hilit2 wl-highlight-folder-path (folder-path) +(defun wl-highlight-folder-path (folder-path) "Highlight current folder path...overlay" (save-excursion (wl-delete-all-overlays) @@ -963,17 +947,17 @@ Variables used: (overlay-put ov 'wl-momentary-overlay t)) (forward-line 1))))) -(defun-hilit2 wl-highlight-refile-destination-string (string) +(defun wl-highlight-refile-destination-string (string) (put-text-property 0 (length string) 'face 'wl-highlight-refile-destination-face string)) -(defun-hilit wl-highlight-summary-all () +(defun wl-highlight-summary-all () "For evaluation" (interactive) (wl-highlight-summary (point-min)(point-max))) -(defun-hilit2 wl-highlight-summary (start end) +(defun wl-highlight-summary (start end) "Highlight summary between start and end. Faces used: wl-highlight-summary-unread-face unread messages @@ -1070,14 +1054,14 @@ This function is defined for `window-scroll-functions'" (defun wl-highlight-body-all () (wl-highlight-message (point-min) (point-max) t t)) -(defun-hilit wl-highlight-body () +(defun wl-highlight-body () (let ((beg (or (save-excursion (goto-char (point-min)) (re-search-forward "^$" nil t)) (point-min))) (end (point-max))) (wl-highlight-message beg end t))) -(defun-hilit2 wl-highlight-body-region (beg end) +(defun wl-highlight-body-region (beg end) (wl-highlight-message beg end t t)) (defun wl-highlight-signature-search-simple (beg end) @@ -1120,7 +1104,7 @@ Returns start point of signature." (point))) ;; if no separator found, returns end. ))) -(defun-hilit2 wl-highlight-message (start end hack-sig &optional body-only) +(defun wl-highlight-message (start end hack-sig &optional body-only) "Highlight message headers between start and end. Faces used: wl-highlight-message-headers the part before the colon diff --git a/wl/wl-message.el b/wl/wl-message.el index 9e5665f..56621e0 100644 --- a/wl/wl-message.el +++ b/wl/wl-message.el @@ -35,11 +35,8 @@ (require 'elmo-mime) (eval-when-compile - (if wl-use-semi - (progn - (require 'wl-mime) - (require 'mime-view)) - (require 'tm-wl)) + (require 'wl-mime) + (require 'mime-view) (defalias-maybe 'event-window 'ignore) (defalias-maybe 'posn-window 'ignore) (defalias-maybe 'event-start 'ignore) diff --git a/wl/wl-mime.el b/wl/wl-mime.el index aac9672..0ddba0e 100644 --- a/wl/wl-mime.el +++ b/wl/wl-mime.el @@ -83,22 +83,26 @@ By setting following-method as yank-content." (let ((wl-draft-config-exec-flag config-exec-flag)) (run-hooks 'wl-draft-send-hook) (setq recipients-message - (concat "Recipients: " - (mapconcat - 'identity - (wl-draft-deduce-address-list - (current-buffer) - (point-min) - (save-excursion - (goto-char (point-min)) - (re-search-forward - (concat - "^" - (regexp-quote mail-header-separator) - "$") - nil t) - (point))) - ", "))))))) + (condition-case err + (concat "Recipients: " + (mapconcat + 'identity + (wl-draft-deduce-address-list + (current-buffer) + (point-min) + (save-excursion + (goto-char (point-min)) + (re-search-forward + (concat + "^" + (regexp-quote mail-header-separator) + "$") + nil t) + (point))) + ", ")) + (error + (kill-buffer (current-buffer)) + (signal (car err) (cdr err))))))))) mime-edit-translate-buffer-hook))) (mime-edit-preview-message) (let ((buffer-read-only nil)) diff --git a/wl/wl-mule.el b/wl/wl-mule.el index a00456e..83748e8 100644 --- a/wl/wl-mule.el +++ b/wl/wl-mule.el @@ -143,7 +143,6 @@ Special commands: (defun wl-draft-key-setup () (define-key wl-draft-mode-map "\C-c\C-y" 'wl-draft-yank-original) - (define-key wl-draft-mode-map "\C-c\C-a" 'wl-draft-insert-x-face-field) (define-key wl-draft-mode-map "\C-c\C-s" 'wl-draft-send) (define-key wl-draft-mode-map "\C-c\C-c" 'wl-draft-send-and-exit) (define-key wl-draft-mode-map "\C-c\C-z" 'wl-draft-save-and-exit) @@ -157,6 +156,8 @@ Special commands: (define-key wl-draft-mode-map "\C-c\C-j" 'wl-template-select) (define-key wl-draft-mode-map "\C-c\C-p" 'wl-draft-preview-message) (define-key wl-draft-mode-map "\C-x\C-s" 'wl-draft-save) + (define-key wl-draft-mode-map "\C-c\C-a" 'wl-addrmgr) + (define-key wl-draft-mode-map "\C-c\C-x" 'wl-draft-insert-x-face-field) (define-key wl-draft-mode-map "\C-xk" 'wl-draft-mimic-kill-buffer)) (defun wl-draft-overload-menubar () diff --git a/wl/wl-nemacs.el b/wl/wl-nemacs.el deleted file mode 100644 index 112f46b..0000000 --- a/wl/wl-nemacs.el +++ /dev/null @@ -1,154 +0,0 @@ -;;; wl-nemacs.el -- Wanderlust modules for Nemacs. - -;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi - -;; Author: Yuuichi Teranishi -;; Keywords: mail, net news - -;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen). - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. -;; - -;;; Commentary: -;; - -;;; Code: -;; - -(defun wl-message-overload-functions () - (local-set-key "l" 'wl-message-toggle-disp-summary)) - -(defun wl-message-wheel-up (event) - (interactive "e")) -(defun wl-message-wheel-down (event) - (interactive "e")) - -(defun wl-highlight-folder-current-line (&optional numbers)) -(defun wl-highlight-folder-path (folder-path)) -(defun wl-highlight-summary (start end)) -(defun wl-highlight-folder-group-line (numbers)) -(defun wl-highlight-summary-line-string (line mark indent before-indent)) -(defun wl-highlight-body-region (beg end)) -(defun wl-highlight-message (start end hack-sig &optional body-only)) -(defun wl-highlight-summary-current-line (&optional smark regexp temp-too)) - -(defun wl-highlight-plugged-current-line ()) -(defun wl-plugged-set-folder-icon (folder string) - string) - -(defmacro wl-defface (face spec doc &rest args) - (` (defvar (, face) (, spec) (, doc)))) - -(defun wl-draft-mode-setup () - (defalias 'wl-draft-mode 'mail-mode)) -(defun wl-draft-key-setup ()) - -;; ??? -(defvar mime-article/kanji-code-alist - (list (cons t (mime-charset-to-coding-system default-mime-charset)))) - -(defun wl-draft-overload-functions () - (wl-mode-line-buffer-identification) - (local-set-key "\C-c\C-y" 'wl-draft-yank-original) - (local-set-key "\C-c\C-s" 'wl-draft-send) - (local-set-key "\C-c\C-a" 'wl-draft-insert-x-face-field) - (local-set-key "\C-c\C-c" 'wl-draft-send-and-exit) - (local-set-key "\C-c\C-z" 'wl-draft-save-and-exit) - (local-set-key "\C-c\C-k" 'wl-draft-kill) - (local-set-key "\C-l" 'wl-draft-highlight-and-recenter) - (local-set-key "\C-i" 'wl-complete-field-body-or-tab) - (local-set-key "\C-c\C-r" 'wl-draft-caesar-region) - (local-set-key "\M-t" 'wl-toggle-plugged) - (local-set-key "\C-c\C-o" 'wl-jump-to-draft-buffer) - (local-set-key "\C-c\C-e" 'wl-draft-config-exec) - (local-set-key "\C-c\C-j" 'wl-template-select) - (local-set-key "\C-c\C-p" 'wl-draft-preview-message) - (local-set-key "\C-x\C-s" 'wl-draft-save) - (local-set-key "\C-xk" 'wl-draft-mimic-kill-buffer)) - -;;; Emulations. - -(defvar-maybe user-mail-address nil) -(defvar-maybe mail-send-actions nil) -(defvar-maybe mail-default-headers nil) -(defvar-maybe mail-citation-hook nil) -(defvar-maybe mail-yank-hooks nil) -(defvar-maybe mail-mailer-swallows-blank-line nil) - -(defvar mail-send-actions nil) - -(defun-maybe mail-indent-citation () - "Modify text just inserted from a message to be cited. -The inserted text should be the region. -When this function returns, the region is again around the modified text. - -Normally, indent each nonblank line `mail-indentation-spaces' spaces. -However, if `mail-yank-prefix' is non-nil, insert that prefix on each line." - (let ((start (point))) - (mail-yank-clear-headers start (mark t)) - (if (null mail-yank-prefix) - (indent-rigidly start (mark t) mail-indentation-spaces) - (save-excursion - (goto-char start) - (while (< (point) (mark t)) - (insert mail-yank-prefix) - (forward-line 1)))))) - -(defun-maybe mail-yank-clear-headers (start end) - (save-excursion - (goto-char start) - (if (search-forward "\n\n" end t) - (save-restriction - (narrow-to-region start (point)) - (goto-char start) - (while (let ((case-fold-search t)) - (re-search-forward mail-yank-ignored-headers nil t)) - (beginning-of-line) - (delete-region (point) - (progn (re-search-forward "\n[^ \t]") - (forward-char -1) - (point)))))))) - -(defun wl-read-event-char () - "Get the next event." - ;; Nemacs does not have read-char-exclusive(). - (let ((event (read-char))) - (cons (and (numberp event) event) event))) - -(defun-maybe find-file-name-handler (filename operation)) - -(defmacro easy-menu-define (a b c d) - (` (defvar (, a) nil (, c)))) -(defmacro easy-menu-add (a) - (` nil)) - -(defun copy-face (a b)) -(defun make-face (a)) -(defun set-face-foreground (a b)) -(defun set-face-background (a b)) -(defun set-face-underline-p (a b)) -(defun set-face-font (a b)) - -;;; XXX cl's member() brings evil upon MIME-View. -;; cl is always called after poe-18, so `(require 'poe-18)' is -;; a dead duck... We MUST re-load it certainly. -(load-library "poe-18") - -(require 'product) -(product-provide (provide 'wl-nemacs) (require 'wl-version)) - -;;; wl-nemacs.el ends here diff --git a/wl/wl-summary.el b/wl/wl-summary.el index c6c6eac..7d7e245 100644 --- a/wl/wl-summary.el +++ b/wl/wl-summary.el @@ -363,14 +363,12 @@ (define-key wl-summary-mode-map [(shift button5)] 'wl-summary-down) (define-key wl-summary-mode-map 'button2 'wl-summary-click)) - (if wl-on-nemacs - (defun wl-summary-setup-mouse ()) - (defun wl-summary-setup-mouse () - (define-key wl-summary-mode-map [mouse-4] 'wl-summary-prev) - (define-key wl-summary-mode-map [mouse-5] 'wl-summary-next) - (define-key wl-summary-mode-map [S-mouse-4] 'wl-summary-up) - (define-key wl-summary-mode-map [S-mouse-5] 'wl-summary-down) - (define-key wl-summary-mode-map [mouse-2] 'wl-summary-click)))) + (defun wl-summary-setup-mouse () + (define-key wl-summary-mode-map [mouse-4] 'wl-summary-prev) + (define-key wl-summary-mode-map [mouse-5] 'wl-summary-next) + (define-key wl-summary-mode-map [S-mouse-4] 'wl-summary-up) + (define-key wl-summary-mode-map [S-mouse-5] 'wl-summary-down) + (define-key wl-summary-mode-map [mouse-2] 'wl-summary-click))) (if wl-summary-mode-map () @@ -380,8 +378,7 @@ (define-key wl-summary-mode-map "<" 'wl-summary-display-top) (define-key wl-summary-mode-map ">" 'wl-summary-display-bottom) (define-key wl-summary-mode-map "\177" 'wl-summary-prev-page) - (unless wl-on-nemacs - (define-key wl-summary-mode-map [backspace] 'wl-summary-prev-page)) + (define-key wl-summary-mode-map [backspace] 'wl-summary-prev-page) (define-key wl-summary-mode-map "\r" 'wl-summary-next-line-content) (define-key wl-summary-mode-map "\C-m" 'wl-summary-next-line-content) (define-key wl-summary-mode-map "/" 'wl-thread-open-close) @@ -413,6 +410,7 @@ ;;;(define-key wl-summary-mode-map "e" 'wl-draft-open-file) (define-key wl-summary-mode-map "e" 'wl-summary-save) (define-key wl-summary-mode-map "\C-c\C-o" 'wl-jump-to-draft-buffer) + (define-key wl-summary-mode-map "\C-c\C-a" 'wl-addrmgr) (define-key wl-summary-mode-map "H" 'wl-summary-redisplay-all-header) (define-key wl-summary-mode-map "M" 'wl-summary-redisplay-no-mime) (define-key wl-summary-mode-map "B" 'wl-summary-burst) @@ -1164,31 +1162,29 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (eq char ?\r) (eq char ? )) ;; Change Addresses - (wl-address-petname-add-or-change + (wl-address-add-or-change the-email - (elmo-get-hash-val the-email wl-address-petname-hash) (wl-address-header-extract-realname (cdr (assoc (let ((completion-ignore-case t) comp) (setq comp (try-completion the-email wl-address-completion-list)) (if (equal comp t) the-email comp)) - wl-address-completion-list))) t) + wl-address-completion-list)))) "edited") ((eq char ?d) ;; Delete Addresses (if (y-or-n-p (format "Delete '%s'? " the-email)) (progn - (wl-address-petname-delete the-email) + (wl-address-delete the-email) "deleted") (message "") nil)) (t (message "") nil))) ;; Add Petname - (wl-address-petname-add-or-change - the-email name-in-addr name-in-addr) + (wl-address-add-or-change the-email name-in-addr) "added")) (defun wl-summary-edit-addresses (&optional addr-str) @@ -3258,11 +3254,6 @@ If optional argument NUMBER is specified, mark message specified by NUMBER." (insert folder) (set-buffer-modified-p nil)))) -;; override. -(when wl-on-nemacs - (defun wl-summary-print-destination (msg-num &optional folder)) - (defun wl-summary-remove-destination ())) - (defsubst wl-summary-get-mark (number) "Return a temporal mark of message specified by NUMBER." (or (and (memq number wl-summary-buffer-delete-list) "D") diff --git a/wl/wl-util.el b/wl/wl-util.el index 9d689a8..4556c9a 100644 --- a/wl/wl-util.el +++ b/wl/wl-util.el @@ -282,13 +282,7 @@ If HACK-ADDRESSES is t, then the strings are considered to be mail addresses, (defmacro wl-as-coding-system (coding-system &rest body) (` (let ((file-coding-system-for-read (, coding-system)) (file-coding-system (, coding-system))) - (,@ body)))) - (if wl-on-nemacs - (defmacro wl-as-coding-system (coding-system &rest body) - (` (let ((default-kanji-fileio-code (, coding-system)) - (kanji-fileio-code (, coding-system)) - kanji-expected-code) - (,@ body)))))))) + (,@ body))))))) (defmacro wl-as-mime-charset (mime-charset &rest body) (` (wl-as-coding-system (mime-charset-to-coding-system (, mime-charset)) diff --git a/wl/wl-vars.el b/wl/wl-vars.el index f55d3d5..a84eebd 100644 --- a/wl/wl-vars.el +++ b/wl/wl-vars.el @@ -97,33 +97,30 @@ (defconst wl-on-emacs21 (and (not wl-on-xemacs) (>= emacs-major-version 21))) -(defconst wl-on-nemacs (fboundp 'nemacs-version)) - (defconst wl-on-mule (featurep 'mule)) (defconst wl-on-mule3 (and wl-on-mule (or wl-on-xemacs (> emacs-major-version 19)))) +(defconst wl-on-nemacs nil) ; backward compatibility. + (eval-when-compile (defun-maybe locate-data-directory (a))) (defvar wl-cs-noconv (cond (wl-on-mule3 'binary) (wl-on-mule '*noconv*) - (wl-on-nemacs 0) (t nil))) (defvar wl-cs-autoconv (cond (wl-on-mule3 'undecided) (wl-on-mule '*autoconv*) - (wl-on-nemacs 2) ; junet... (t nil))) (defvar wl-cs-local (cond (wl-on-mule3 'junet) (wl-on-mule '*junet*) - (wl-on-nemacs 2) (t nil))) (defvar wl-cs-cache wl-cs-local) @@ -786,7 +783,7 @@ This variable is local to the summary buffers." :type '(repeat (string :tag "Mark")) :group 'wl-score) -(defcustom wl-use-scoring (not wl-on-nemacs) +(defcustom wl-use-scoring t "*If non-nil, enable scoring." :type 'boolean :group 'wl-pref) @@ -1281,9 +1278,7 @@ with wl-highlight-folder-many-face." :group 'wl-summary :group 'wl-pref) -(defcustom wl-mime-charset (if wl-on-nemacs - 'iso-2022-jp - 'x-ctext) +(defcustom wl-mime-charset 'x-ctext "*MIME Charset for summary and message." :type 'symbol :group 'wl-summary @@ -1679,7 +1674,7 @@ If TYPE is nil, do nothing for duplicated messages." :type 'boolean :group 'wl-folder) -(defcustom wl-folder-check-async (not wl-on-nemacs) +(defcustom wl-folder-check-async t "*Check the folder asynchronous." :type 'boolean :group 'wl-folder) diff --git a/wl/wl-xmas.el b/wl/wl-xmas.el index 7612bcd..94348c5 100644 --- a/wl/wl-xmas.el +++ b/wl/wl-xmas.el @@ -497,7 +497,6 @@ Special commands: (defun wl-draft-key-setup () (define-key wl-draft-mode-map "\C-c\C-y" 'wl-draft-yank-original) (define-key wl-draft-mode-map "\C-c\C-s" 'wl-draft-send) - (define-key wl-draft-mode-map "\C-c\C-a" 'wl-draft-insert-x-face-field) (define-key wl-draft-mode-map "\C-c\C-c" 'wl-draft-send-and-exit) (define-key wl-draft-mode-map "\C-c\C-z" 'wl-draft-save-and-exit) (define-key wl-draft-mode-map "\C-c\C-k" 'wl-draft-kill) @@ -510,6 +509,8 @@ Special commands: (define-key wl-draft-mode-map "\C-c\C-j" 'wl-template-select) (define-key wl-draft-mode-map "\C-c\C-p" 'wl-draft-preview-message) (define-key wl-draft-mode-map "\C-x\C-s" 'wl-draft-save) + (define-key wl-draft-mode-map "\C-c\C-a" 'wl-addrmgr) + (define-key wl-draft-mode-map "\C-c\C-x" 'wl-draft-insert-x-face-field) (define-key wl-draft-mode-map "\C-xk" 'wl-draft-mimic-kill-buffer)) (defun wl-draft-overload-functions () diff --git a/wl/wl.el b/wl/wl.el index 872ed32..21e0669 100644 --- a/wl/wl.el +++ b/wl/wl.el @@ -50,8 +50,6 @@ (require 'wl-xmas)) (wl-on-emacs21 (require 'wl-e21)) - (wl-on-nemacs - (require 'wl-nemacs)) (t (require 'wl-mule))) @@ -72,11 +70,8 @@ (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) @@ -169,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)) @@ -665,8 +658,7 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'." (> (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. ) @@ -676,17 +668,11 @@ Entering Plugged mode calls the value of `wl-plugged-mode-hook'." (unless (featurep 'mime-setup) (require 'mime-setup)) (setq elmo-plugged wl-plugged) - (unless wl-on-nemacs - (add-hook 'kill-emacs-hook 'wl-save-status)) + (add-hook 'kill-emacs-hook 'wl-save-status) (wl-address-init) (wl-draft-setup) (wl-refile-alist-setup) - (if wl-use-semi - (progn - (require 'wl-mime) - (setq elmo-use-semi t)) - (require 'tm-wl) - (setq elmo-use-semi nil)) + (require 'wl-mime) ;; defined above. (wl-mime-setup) (fset 'wl-summary-from-func-internal -- 1.7.10.4