* 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 <tsuyoshi.kitamoto@city.sapporo.jp>".
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.
+2001-08-21 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * 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 <teranisi@gohome.org>
* WL-MK (config-wl-package-subr): Check smtp.el version.
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.
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
===================
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
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
============
MIME\e$BMQ%b%8%e!<%k$NA*Br\e(B
======================
- Wanderlust \e$B$r;H$&$?$a$K$O!"0J2<$N$I$A$i$+$N\e(B MIME \e$BMQ%b%8%e!<%k$r%$%s%9\e(B
- \e$B%H!<%k$7$F$*$/I,MW$,$"$j$^$9!#5!G=$,=<<B$7$F$$$k\e(B SEMI \e$B$N;HMQ$r$*4+$a$7\e(B
- \e$B$^$9!#\e(B
+ Wanderlust \e$B$r;H$&$?$a$K$O!"0J2<$N\e(B MIME \e$BMQ%b%8%e!<%k$r%$%s%9\e(B
+ \e$B%H!<%k$7$F$*$/I,MW$,$"$j$^$9!#\e(B
SEMI (1.14.1 \e$B0J>e\e(B)
- tm (8.7 \e$B0J>e\e(B)
SEMI \e$B$K$O\e(B APEL, FLIM \e$B$H8F$P$l$k%Q%C%1!<%8$bI,MW$G$9!#<g$J\e(B Emacsen \e$B$K$D\e(B
\e$B$$$F?d>)$5$l$k\e(B APEL, FLIM, SEMI \e$B$NAH9g$;$r0J2<$K<($7$^$9!#\e(B
http://www.jpl.org/elips/INSTALL-SEMI-ja.html
-(e) Emacs 19.28 \e$B0JA0\e(B (Mule 2.3, Nemacs)
-
- APEL 10.3, CLIME 1.14.0, tm 8.8
-
- SEMI \e$B$OF0$-$^$;$s$N$G!"\e(Btm \e$B$r%$%s%9%H!<%k$7$F$/$@$5$$!#\e(BAPEL, CLIME \e$B$r:G\e(B
- \e$B?7HG$KF~$lBX$($kI,MW$b$"$j$^$9!#\e(B
-
-
MIME\e$BMQ%b%8%e!<%k$N%$%s%9%H!<%k\e(B
==============================
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 \e$B$N%$%s%9%H!<%k\e(B
APEL, FLIM(CLIME), SEMI \e$B$N=g$K%$%s%9%H!<%k$7$F$/$@$5$$!#4pK\E*$K$9$Y$F\e(B
make install \e$B$N<B9T$G:Q$`$O$:$G$9!#\e(B
APEL 10.2, Chao 1.14.1, REMI 1.14.2
APEL 10.2, SLIM 1.14.3, EMY 1.13.9
-(b) tm \e$B$N%$%s%9%H!<%k\e(B
-
- tm 8.7 \e$B0J9_$N%P!<%8%g%s$,I,MW$G$9!#>\$7$$%$%s%9%H!<%k$NJ}K!$O%Q%C%1!<\e(B
- \e$B%8$KE:IU$5$l$F$$$k%I%-%e%a%s%H\e(B(README.en)\e$B$r;2>H$7$F$/$@$5$$!#\e(B
-
- tm 8.8 \e$B0JA0$N%P!<%8%g%s$G$O!"\e(B
-
- Use tm-8.x with APEL 10.2 or later
-
- \e$B$H$$$&%(%i!<$,$G$k$3$H$,$"$j$^$9!#$3$N>l9g!"\e(BAPEL 10.2 \e$B0J9_$r%$\e(B
- \e$B%s%9%H!<%k$7$F$/$@$5$$!#\e(B
-
-
\e$BDL>o$N%$%s%9%H!<%k\e(B
==================
;;; -*- 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"
;;; 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
))
((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)
(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
;; 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."
+2001-08-20 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * elmo-vars.el (elmo-use-semi): Eliminated.
+
+ * elmo-util.el (elmo-string-assoc-all): New function.
+
2001-08-16 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
* elmo-mime.el (elmo-mime-display-as-is-internal): Put text
(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
(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.")
+2001-08-21 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * 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 <tsuyoshi.kitamoto@city.sapporo.jp>".
+ 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 <ysjj@unixuser.org>
* wl-highlight.el (wl-highlight-summary-current-line):
* wl-draft.el (wl-draft): Put category property on
mail-header-separator.
+\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0
\ No newline at end of file
+++ /dev/null
-;;; wl-mime.el -- tm implementations of MIME processing on Wanderlust.
-
-;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
-
-;; Author: Yuuichi Teranishi <teranisi@gohome.org>
-;; 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
(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))))
(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))
--- /dev/null
+;;; wl-addrmgr.el -- Address manager for Wanderlust.
+
+;; Copyright (C) 2001 Kitamoto Tsuyoshi <tsuyoshi.kitamoto@city.sapporo.jp>
+;; Copyright (C) 2001 Yuuichi Teranishi <teranisi@gohome.org>
+
+;; Author: Kitamoto Tsuyoshi <tsuyoshi.kitamoto@city.sapporo.jp>
+;; Yuuichi Teranishi <teranisi@gohome.org>
+;; 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
(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)
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.
(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)
(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))
(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)
(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)
(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))
'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
(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)
(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)
; (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)
(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))
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)
(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)
(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
(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)
(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
(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)
(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
(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)
(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
(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)
(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))
(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)
(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 ()
+++ /dev/null
-;;; wl-nemacs.el -- Wanderlust modules for Nemacs.
-
-;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
-
-;; Author: Yuuichi Teranishi <teranisi@gohome.org>
-;; 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
(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
()
(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)
;;;(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)
(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)
(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")
(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))
(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)
: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)
: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
: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)
(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)
(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 ()
(require 'wl-xmas))
(wl-on-emacs21
(require 'wl-e21))
- (wl-on-nemacs
- (require 'wl-nemacs))
(t
(require 'wl-mule)))
(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)
(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))
(> (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.
)
(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
projects / elisp / wanderlust.git / commitdiff