wl/wl-addrmgr.el

   1 ;;; wl-addrmgr.el --- Address manager for Wanderlust.
   2
   3 ;; Copyright (C) 2001 Kitamoto Tsuyoshi <tsuyoshi.kitamoto@city.sapporo.jp>
   4 ;; Copyright (C) 2001 Yuuichi Teranishi <teranisi@gohome.org>
   5
   6 ;; Author: Kitamoto Tsuyoshi <tsuyoshi.kitamoto@city.sapporo.jp>
   7 ;;         Yuuichi Teranishi <teranisi@gohome.org>
   8 ;; Keywords: mail, net news
   9
  10 ;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen).
  11
  12 ;; This program is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16 ;;
  17 ;; This program is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21 ;;
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26 ;;
  27
  28 ;;; Commentary:
  29 ;;   Edit To:, Cc:, Bcc: fields interactively from E-Mail address list
  30 ;;   on ~/.address file.
  31
  32 ;;; Code:
  33 ;;
  34
  35 (require 'wl-address)
  36 (require 'wl-draft)
  37
  38 ;; Variables
  39 (defgroup wl-addrmgr nil
  40   "Wanderlust Address manager."
  41   :prefix "wl-"
  42   :group 'wl)
  43
  44 (defcustom wl-addrmgr-buffer-lines 10
  45   "*Buffer lines for ADDRMGR buffer for draft."
  46   :type 'integer
  47   :group 'wl-addrmgr)
  48
  49 (defcustom wl-addrmgr-default-sort-key 'realname
  50   "Default element for sort."
  51   :type '(choice '(address realname petname none))
  52   :group 'wl-addrmgr)
  53
  54 (defcustom wl-addrmgr-default-sort-order 'ascending
  55   "Default element for sort."
  56   :type '(choice '(ascending descending))
  57   :group 'wl-addrmgr)
  58
  59 (defcustom wl-addrmgr-realname-width 17
  60   "Width for realname."
  61   :type 'integer
  62   :group 'wl-addrmgr)
  63
  64 (defcustom wl-addrmgr-petname-width 10
  65   "Width for petname."
  66   :type 'integer
  67   :group 'wl-addrmgr)
  68
  69 (defcustom wl-addrmgr-line-width 78
  70   "Width for each line."
  71   :type 'integer
  72   :group 'wl-addrmgr)
  73
  74 (defcustom wl-addrmgr-realname-face 'wl-highlight-summary-normal-face
  75   "Face for realname."
  76   :type 'face
  77   :group 'wl-addrmgr)
  78
  79 (defcustom wl-addrmgr-petname-face 'wl-highlight-summary-unread-face
  80   "Face for petname."
  81   :type 'face
  82   :group 'wl-addrmgr)
  83
  84 (defcustom wl-addrmgr-address-face 'wl-highlight-summary-new-face
  85   "Face for address."
  86   :type 'face
  87   :group 'wl-addrmgr)
  88
  89 (defcustom wl-addrmgr-default-method 'local
  90   "Default access method for address entries."
  91   :type 'symbol
  92   :group 'wl-addrmgr)
  93
  94 (defvar wl-addrmgr-buffer-name "Address")
  95 (defvar wl-addrmgr-mode-map nil)
  96 (defvar wl-addrmgr-method-list '(local))
  97
  98 ;; buffer local variable.
  99 (defvar wl-addrmgr-draft-buffer nil)
 100 (defvar wl-addrmgr-unknown-list nil)
 101 (defvar wl-addrmgr-sort-key nil)
 102 (defvar wl-addrmgr-sort-order nil)
 103 (defvar wl-addrmgr-method nil)
 104 (defvar wl-addrmgr-list nil)
 105 (defvar wl-addrmgr-method-name nil)
 106
 107 (make-variable-buffer-local 'wl-addrmgr-draft-buffer)
 108 (make-variable-buffer-local 'wl-addrmgr-unknown-list)
 109 (make-variable-buffer-local 'wl-addrmgr-sort-key)
 110 (make-variable-buffer-local 'wl-addrmgr-sort-order)
 111 (make-variable-buffer-local 'wl-addrmgr-method)
 112 (make-variable-buffer-local 'wl-addrmgr-list)
 113 (make-variable-buffer-local 'wl-addrmgr-method-name)
 114
 115 ;;; Code
 116
 117 (if wl-addrmgr-mode-map
 118     nil
 119   (setq wl-addrmgr-mode-map (make-sparse-keymap))
 120   (define-key wl-addrmgr-mode-map "<"    'wl-addrmgr-goto-top)
 121   (define-key wl-addrmgr-mode-map ">"    'wl-addrmgr-goto-bottom)
 122   (define-key wl-addrmgr-mode-map "t"    'wl-addrmgr-mark-set-to)
 123   (define-key wl-addrmgr-mode-map "b"    'wl-addrmgr-mark-set-bcc)
 124   (define-key wl-addrmgr-mode-map "c"    'wl-addrmgr-mark-set-cc)
 125   (define-key wl-addrmgr-mode-map "u"    'wl-addrmgr-unmark)
 126   (define-key wl-addrmgr-mode-map "x"    'wl-addrmgr-apply)
 127
 128   (define-key wl-addrmgr-mode-map "\C-c\C-c" 'wl-addrmgr-apply)
 129
 130   (define-key wl-addrmgr-mode-map "n"    'wl-addrmgr-next)
 131   (define-key wl-addrmgr-mode-map "j"    'wl-addrmgr-next)
 132   (define-key wl-addrmgr-mode-map "k"    'wl-addrmgr-prev)
 133   (define-key wl-addrmgr-mode-map "p"    'wl-addrmgr-prev)
 134   (define-key wl-addrmgr-mode-map [down] 'wl-addrmgr-next)
 135   (define-key wl-addrmgr-mode-map [up]   'wl-addrmgr-prev)
 136
 137   (define-key wl-addrmgr-mode-map "s"    'wl-addrmgr-sort)
 138
 139   (define-key wl-addrmgr-mode-map "a"    'wl-addrmgr-add)
 140   (define-key wl-addrmgr-mode-map "d"    'wl-addrmgr-delete)
 141   (define-key wl-addrmgr-mode-map "e"    'wl-addrmgr-edit)
 142   (define-key wl-addrmgr-mode-map "\n"    'wl-addrmgr-edit)
 143   (define-key wl-addrmgr-mode-map "\r"    'wl-addrmgr-edit)
 144
 145   (define-key wl-addrmgr-mode-map "q"    'wl-addrmgr-quit)
 146   (define-key wl-addrmgr-mode-map "\C-c\C-k" 'wl-addrmgr-quit)
 147
 148   (define-key wl-addrmgr-mode-map "C"    'wl-addrmgr-change-method)
 149
 150   (define-key wl-addrmgr-mode-map "Z"    'wl-addrmgr-reload)
 151   (define-key wl-addrmgr-mode-map "\C-c\C-l" 'wl-addrmgr-redraw))
 152
 153 (defun wl-addrmgr-mode ()
 154   "Major mode for Wanderlust address management.
 155 See info under Wanderlust for full documentation.
 156
 157 \\{wl-addrmgr-mode-map}"
 158   (kill-all-local-variables)
 159   (setq mode-name "Address"
 160         major-mode 'wl-addrmgr-mode)
 161   (wl-mode-line-buffer-identification
 162    '("Wanderlust: Address (" wl-addrmgr-method-name ")"))
 163   (use-local-map wl-addrmgr-mode-map)
 164   (setq buffer-read-only t))
 165
 166 (defun wl-addrmgr-address-entry-list (field)
 167   "Return address list."
 168   (mapcar
 169    (lambda (addr)
 170      (nth 1 (std11-extract-address-components addr)))
 171    (wl-parse-addresses
 172     (mapconcat 'identity (elmo-multiple-fields-body-list (list field)) ","))))
 173
 174 ;;;###autoload
 175 (defun wl-addrmgr ()
 176   "Start an Address manager."
 177   (interactive)
 178   (let ((buffer (if (eq major-mode 'wl-draft-mode) (current-buffer)))
 179         (already-list (list (cons 'to (wl-addrmgr-address-entry-list "to"))
 180                             (cons 'cc (wl-addrmgr-address-entry-list "cc"))
 181                             (cons 'bcc (wl-addrmgr-address-entry-list "bcc")))))
 182     (if (eq major-mode 'wl-draft-mode)
 183         (if (get-buffer-window wl-addrmgr-buffer-name)
 184             nil
 185           (split-window (selected-window)
 186                         (- (window-height (selected-window))
 187                            wl-addrmgr-buffer-lines))
 188           (select-window (next-window))
 189           ;;  Non-nil means display-buffer should make new windows.
 190           (let ((pop-up-windows nil))
 191             (switch-to-buffer
 192              (get-buffer-create wl-addrmgr-buffer-name))))
 193       (switch-to-buffer (get-buffer-create wl-addrmgr-buffer-name)))
 194     (set-buffer wl-addrmgr-buffer-name)
 195     (wl-addrmgr-mode)
 196     (unless wl-addrmgr-method
 197       (setq wl-addrmgr-method wl-addrmgr-default-method
 198             wl-addrmgr-method-name (symbol-name wl-addrmgr-default-method)))
 199     (unless wl-addrmgr-sort-key
 200       (setq wl-addrmgr-sort-key wl-addrmgr-default-sort-key))
 201     (unless wl-addrmgr-sort-order
 202       (setq wl-addrmgr-sort-order wl-addrmgr-default-sort-order))
 203     (setq wl-addrmgr-draft-buffer buffer)
 204     (setq wl-addrmgr-list (wl-addrmgr-list))
 205     (wl-addrmgr-draw already-list)
 206     (setq wl-addrmgr-unknown-list already-list)
 207     (wl-addrmgr-goto-top)))
 208
 209 (defun wl-addrmgr-goto-top ()
 210   (interactive)
 211   (goto-char (point-min))
 212   (forward-line 2)
 213   (condition-case nil
 214       (forward-char 4)
 215     (error)))
 216
 217 (defun wl-addrmgr-goto-bottom ()
 218   (interactive)
 219   (goto-char (point-max))
 220   (beginning-of-line)
 221   (forward-char 4))
 222
 223 (defun wl-addrmgr-reload ()
 224   "Reload addresses entries."
 225   (interactive)
 226   (setq wl-addrmgr-list (wl-addrmgr-list 'reload))
 227   (wl-addrmgr-redraw))
 228
 229 (defun wl-addrmgr-redraw ()
 230   "Redraw addresses entries."
 231   (interactive)
 232   (let ((rcpt (wl-addrmgr-mark-check)))
 233     (wl-addrmgr-draw (list (cons 'to (nth 0 rcpt))
 234                            (cons 'cc (nth 1 rcpt))
 235                            (cons 'bcc (nth 2 rcpt)))))
 236   (wl-addrmgr-goto-top))
 237
 238 (defun wl-addrmgr-sort-list (key list order)
 239   (let ((pos (case key
 240                (address 0)
 241                (petname 1)
 242                (realname 2)))
 243         sorted)
 244     (if pos
 245         (progn
 246           (setq sorted (sort list `(lambda (a b) (string< (nth ,pos a)
 247                                                           (nth ,pos b)))))
 248           (if (eq order 'descending)
 249               (nreverse sorted)
 250             sorted))
 251       list)))
 252
 253 (defun wl-addrmgr-insert-line (entry)
 254   (let ((real (nth 2 entry))
 255         (pet  (nth 1 entry))
 256         (addr (nth 0 entry))
 257         beg)
 258     (insert "     ")
 259     (setq beg (point))
 260     (setq real (wl-set-string-width wl-addrmgr-realname-width real))
 261     (put-text-property 0 (length real) 'face
 262                        wl-addrmgr-realname-face
 263                        real)
 264     (setq pet (wl-set-string-width wl-addrmgr-petname-width pet))
 265     (put-text-property 0 (length pet) 'face
 266                        wl-addrmgr-petname-face
 267                        pet)
 268     (setq addr (copy-sequence addr))
 269     (put-text-property 0 (length addr) 'face
 270                        wl-addrmgr-address-face
 271                        addr)
 272     (insert
 273      (wl-set-string-width
 274       (- wl-addrmgr-line-width 4)
 275       (concat real " " pet " " addr)))
 276     (put-text-property beg (point) 'wl-addrmgr-entry entry)))
 277
 278 (defun wl-addrmgr-search-forward-address (address)
 279   "Search forward from point for ADDRESS.
 280 Return nil if no ADDRESS exists."
 281   (let ((pos (point)))
 282     (if (catch 'found
 283             (while (not (eobp))
 284               (if (string= address (car (wl-addrmgr-address-entry)))
 285                   (throw 'found t)
 286                 (forward-line))))
 287         (point)
 288       (goto-char pos)
 289       nil)))
 290
 291 (defun wl-addrmgr-draw (already-list)
 292   "Show recipients mail addresses."
 293   (save-excursion
 294     (let ((buffer-read-only nil)
 295           list field addrs beg real pet addr)
 296       (erase-buffer)
 297       (goto-char (point-min))
 298       (insert
 299        "Mark "
 300        (wl-set-string-width wl-addrmgr-realname-width
 301                             "Realname")
 302        " "
 303        (wl-set-string-width wl-addrmgr-petname-width
 304                             "Petname")
 305        " Address\n")
 306       (insert "---- "
 307               (make-string wl-addrmgr-realname-width ?-)
 308               " "
 309               (make-string wl-addrmgr-petname-width ?-)
 310               " ---------------")
 311       (unless wl-addrmgr-list (insert "\n"))
 312       (dolist (entry (wl-addrmgr-sort-list wl-addrmgr-sort-key
 313                                            (copy-sequence wl-addrmgr-list)
 314                                            wl-addrmgr-sort-order))
 315         (insert "\n")
 316         (wl-addrmgr-insert-line entry))
 317       (set-buffer-modified-p nil)
 318       (while already-list
 319         (setq list (car already-list)
 320               field (car list)
 321               addrs (cdr list))
 322         (while addrs
 323           (goto-char (point-min))
 324           (when (wl-addrmgr-search-forward-address (car addrs))
 325             (wl-addrmgr-mark-write field)
 326             (setcdr list (delq (car addrs) (cdr list))))
 327           (setq addrs (cdr addrs)))
 328         (setq already-list (cdr already-list))))))
 329
 330 (defun wl-addrmgr-next ()
 331   "Move cursor next line."
 332   (interactive)
 333   (end-of-line)
 334   (let ((current (count-lines (point-min) (point)))
 335         first)
 336     (cond
 337      ((<= current 2)
 338       (when (setq first (next-single-property-change (point) 'wl-addrmgr-entry
 339                                                      nil))
 340         (goto-char first)
 341         (beginning-of-line)
 342         (forward-char 4)))
 343      (t
 344       (forward-line)
 345       (beginning-of-line)
 346       (forward-char 4)))))
 347
 348 (defun wl-addrmgr-prev ()
 349   "Move cursor prev line."
 350   (interactive)
 351   (let ((current (count-lines (point-min) (point))))
 352     (cond
 353      ((= current 3)
 354       (beginning-of-line)
 355       (forward-char 4))
 356      ((< current 3)
 357       (goto-char (point-min))
 358       (forward-line 2)
 359       (forward-char 4))
 360      (t
 361       (forward-line -1)
 362       (forward-char 4)))))
 363
 364 (defun wl-addrmgr-quit-yes ()
 365   (if (and wl-addrmgr-draft-buffer
 366            (buffer-live-p wl-addrmgr-draft-buffer)
 367            (null (get-buffer-window wl-addrmgr-draft-buffer)))
 368       (switch-to-buffer wl-addrmgr-draft-buffer)
 369     (unless (one-window-p)
 370       (delete-window)))
 371   (kill-buffer wl-addrmgr-buffer-name))
 372
 373 (defun wl-addrmgr-quit ()
 374   "Exit from electric reference mode without inserting reference."
 375   (interactive)
 376   (let ((rcpt (wl-addrmgr-mark-check)))
 377     (if (or (nth 0 rcpt)
 378             (nth 1 rcpt)
 379             (nth 2 rcpt))
 380         (when (y-or-n-p "There is marked address. Quit wl-addrmgr really? ")
 381           (wl-addrmgr-quit-yes))
 382       (wl-addrmgr-quit-yes)))
 383   (message ""))
 384
 385 (defun wl-addrmgr-mark-set-to ()
 386   "Marking To: sign."
 387   (interactive)
 388   (wl-addrmgr-mark-write 'to)
 389   (wl-addrmgr-next))
 390
 391 (defun wl-addrmgr-mark-set-cc ()
 392   "Marking Cc: sign."
 393   (interactive)
 394   (wl-addrmgr-mark-write 'cc)
 395   (wl-addrmgr-next))
 396
 397 (defun wl-addrmgr-mark-set-bcc ()
 398   "Marking Bcc: sign."
 399   (interactive)
 400   (wl-addrmgr-mark-write 'bcc)
 401   (wl-addrmgr-next))
 402
 403 (defun wl-addrmgr-unmark ()
 404   "Erase Marked sign."
 405   (interactive)
 406   (let ((entry (wl-addrmgr-address-entry))
 407         buffer-read-only)
 408     (save-excursion
 409       (beginning-of-line)
 410       (delete-region (point) (progn (end-of-line)(point)))
 411       (wl-addrmgr-insert-line entry))
 412     (set-buffer-modified-p nil)
 413     (wl-addrmgr-next)))
 414
 415 (defun wl-addrmgr-sort ()
 416   "Sort address entry."
 417   (interactive)
 418   (setq wl-addrmgr-sort-key (intern
 419                              (completing-read
 420                               (format "Sort By (%s): "
 421                                       (symbol-name wl-addrmgr-sort-key))
 422                               '(("address")("realname")("petname")("none"))
 423                               nil t nil nil
 424                               (symbol-name wl-addrmgr-sort-key))))
 425   (if (eq wl-addrmgr-sort-key 'none)
 426       (wl-addrmgr-reload)
 427     (setq wl-addrmgr-sort-order (intern
 428                                  (completing-read
 429                                   (format "Sort Order (%s): "
 430                                           (symbol-name wl-addrmgr-sort-order))
 431                                   '(("ascending") ("descending"))
 432                                   nil t nil nil
 433                                   (symbol-name wl-addrmgr-sort-order))))
 434     (wl-addrmgr-redraw)))
 435
 436 ;;; Backend methods.
 437 (defun wl-addrmgr-method-call (method &rest args)
 438   (apply (intern (concat "wl-addrmgr-"
 439                          (symbol-name wl-addrmgr-method)
 440                          "-" (symbol-name method)))
 441          args))
 442
 443 (defun wl-addrmgr-change-method ()
 444   (interactive)
 445   (setq wl-addrmgr-method (intern
 446                            (setq wl-addrmgr-method-name
 447                                  (completing-read
 448                                   (format "Method (%s): "
 449                                           (symbol-name wl-addrmgr-method))
 450                                   (mapcar (lambda (method)
 451                                             (list (symbol-name method)))
 452                                           wl-addrmgr-method-list)
 453                                   nil t nil nil
 454                                   (symbol-name wl-addrmgr-method)))))
 455   (wl-addrmgr-redraw))
 456
 457 (defun wl-addrmgr-list (&optional reload)
 458   "List address entries."
 459   (wl-addrmgr-method-call 'list reload))
 460
 461 (defun wl-addrmgr-add ()
 462   "Add address entry."
 463   (interactive)
 464   (let ((entry (wl-addrmgr-method-call 'add)))
 465     (if (eq wl-addrmgr-sort-key 'none)
 466         (wl-addrmgr-reload)
 467       (setq wl-addrmgr-list (cons entry wl-addrmgr-list))
 468       (wl-addrmgr-redraw))
 469     (message "Added `%s'." (wl-string (car entry)))))
 470
 471 (defun wl-addrmgr-delete ()
 472   "Delete address entry."
 473   (interactive)
 474   (let ((addr (wl-string (car (wl-addrmgr-address-entry))))
 475         lines)
 476     (when (and addr
 477                (y-or-n-p (format "Delete '%s'? " addr)))
 478       (setq lines (count-lines (point-min) (point)))
 479       (wl-addrmgr-method-call 'delete addr)
 480       (setq wl-addrmgr-list (delq (assoc addr wl-addrmgr-list)
 481                                   wl-addrmgr-list))
 482       (wl-addrmgr-redraw)
 483       (forward-line (- lines 2))
 484       (message "Deleted `%s'." addr))))
 485
 486 (defun wl-addrmgr-edit ()
 487   "Edit address entry."
 488   (interactive)
 489   (let ((orig (wl-addrmgr-address-entry))
 490         entry lines)
 491     (setq entry (wl-addrmgr-method-call 'edit (wl-string (car orig))))
 492     (setq lines (count-lines (point-min) (point)))
 493     (if (eq wl-addrmgr-sort-key 'none)
 494         (wl-addrmgr-reload)
 495       (setq wl-addrmgr-list (delq (assoc (car orig) wl-addrmgr-list)
 496                                   wl-addrmgr-list)
 497             wl-addrmgr-list (cons entry wl-addrmgr-list))
 498       (wl-addrmgr-redraw))
 499     (forward-line (- lines 1))
 500     (message "Modified `%s'." (wl-string (car entry)))))
 501
 502 ;;; local address book implementation.
 503 (defun wl-addrmgr-local-list (reload)
 504   (if (or (null wl-address-list) reload)
 505       (wl-address-init))
 506   (copy-sequence wl-address-list))
 507
 508 (defun wl-addrmgr-local-add ()
 509   (wl-address-add-or-change nil nil 'addr-too))
 510
 511 (defun wl-addrmgr-local-edit (address)
 512   (wl-address-add-or-change address nil 'addr-too))
 513
 514 (defun wl-addrmgr-local-delete (address)
 515   (wl-address-delete address))
 516
 517 ;;; LDAP implementation (Implement Me)
 518
 519 ;;; Operations.
 520
 521 (defun wl-addrmgr-address-entry ()
 522   (save-excursion
 523     (end-of-line)
 524     (get-text-property (previous-single-property-change
 525                         (point) 'wl-addrmgr-entry nil
 526                         (progn
 527                           (beginning-of-line)
 528                           (point)))
 529                        'wl-addrmgr-entry)))
 530
 531 (defun wl-addrmgr-mark-write (&optional mark)
 532   "Set MARK to the current address entry."
 533   (save-excursion
 534     (end-of-line)
 535     (unless (< (count-lines (point-min) (point)) 3)
 536       (let ((buffer-read-only nil) beg end)
 537         (beginning-of-line)
 538         (delete-char 4)
 539         (insert (case mark
 540                   (to "To: ")
 541                   (cc "Cc: ")
 542                   (bcc "Bcc:")
 543                   (t "    ")))
 544         (insert (make-string (- 4 (current-column)) ? ))
 545         (beginning-of-line)
 546         (setq beg (point))
 547         (setq end (progn (end-of-line)
 548                          (point)))
 549         (put-text-property beg end 'face nil)
 550         (wl-highlight-message beg end nil))
 551       (set-buffer-modified-p nil)
 552       (beginning-of-line)
 553       (forward-char 4))))
 554
 555 (defun wl-addrmgr-apply ()
 556   (interactive)
 557   (let ((rcpt (wl-addrmgr-mark-check 'full)))
 558     (when (or (or (nth 0 rcpt)
 559                   (nth 1 rcpt)
 560                   (nth 2 rcpt))
 561               (or (cdr (assq 'to wl-addrmgr-unknown-list))
 562                   (cdr (assq 'cc wl-addrmgr-unknown-list))
 563                   (cdr (assq 'bcc wl-addrmgr-unknown-list))))
 564       (wl-addrmgr-apply-exec (wl-addrmgr-mark-check 'full)))
 565     (wl-addrmgr-quit-yes)))
 566
 567 (defun wl-addrmgr-mark-check (&optional full)
 568   "Return list of recipients (TO CC BCC)."
 569   (save-excursion                       ; save cursor POINT
 570     (goto-char (point-min))
 571     (forward-line 2)
 572     (let (to-list cc-list bcc-list mark addr realname)
 573       (while (and (not (eobp))
 574                   (re-search-forward "^\\([^ ]+:\\) " nil t))
 575         (setq mark (match-string 1))
 576         (setq addr (car (wl-addrmgr-address-entry)))
 577         (setq realname (nth 2 (wl-addrmgr-address-entry)))
 578         (cond
 579          ((string= mark "To:")
 580           (setq to-list (cons (if full (concat
 581                                         (wl-address-quote-specials realname)
 582                                         " <" addr">")
 583                                 addr)
 584                               to-list)))
 585          ((string= mark "Cc:")
 586           (setq cc-list (cons (if full (concat
 587                                         (wl-address-quote-specials realname)
 588                                         " <" addr">")
 589                                 addr)
 590                               cc-list)))
 591          ((string= mark "Bcc:")
 592           (setq bcc-list (cons (if full (concat
 593                                          (wl-address-quote-specials realname)
 594                                          " <" addr">")
 595                                  addr)
 596                                bcc-list)))))
 597       (list to-list cc-list bcc-list))))
 598
 599 (defun wl-addrmgr-apply-exec (rcpt)
 600   (let ((to (nconc (nth 0 rcpt) (cdr (assq 'to wl-addrmgr-unknown-list))))
 601         (cc (nconc (nth 1 rcpt) (cdr (assq 'cc wl-addrmgr-unknown-list))))
 602         (bcc (nconc (nth 2 rcpt) (cdr (assq 'bcc wl-addrmgr-unknown-list))))
 603         from clist)
 604     (setq clist (list (cons "Bcc" (if bcc (mapconcat 'identity bcc ",\n\t")))
 605                       (cons "Cc" (if cc (mapconcat 'identity cc ",\n\t")))
 606                       (cons "To" (if to (mapconcat 'identity to ",\n\t")))))
 607     (when (or (null wl-addrmgr-draft-buffer)
 608               (not (buffer-live-p wl-addrmgr-draft-buffer)))
 609       (setq wl-addrmgr-draft-buffer (save-window-excursion
 610                                    (wl-draft)
 611                                    (current-buffer))))
 612     (with-current-buffer wl-addrmgr-draft-buffer
 613       (setq from (std11-field-body "From"))
 614       (if from
 615           (setq clist (append clist (list (cons "From" from)))))
 616       (wl-addrmgr-mark-exec-sub clist))))
 617
 618 (defun wl-addrmgr-replace-field (field content)
 619   "Insert FIELD with CONTENT to the top of the header fields."
 620   (save-excursion
 621     (save-restriction
 622       (let ((case-fold-search t)
 623             (inhibit-read-only t) ;; added by teranisi.
 624             beg)
 625         (std11-narrow-to-header mail-header-separator)
 626         (goto-char (point-min))
 627         (while (re-search-forward (concat "^" (regexp-quote field) ":") nil t)
 628           ;; delete field
 629           (progn
 630             (save-excursion
 631               (beginning-of-line)
 632               (setq beg (point)))
 633             (re-search-forward "^[^ \t]" nil 'move)
 634             (beginning-of-line)
 635             (delete-region beg (point))))
 636         (when content
 637           ;; add field to top.
 638           (goto-char (point-min))
 639           (insert (concat field ": " content "\n")))))))
 640
 641 (defun wl-addrmgr-mark-exec-sub (list)
 642   (dolist (pair list)
 643     (wl-addrmgr-replace-field (car pair) (cdr pair)))
 644   ;; from wl-template.el
 645   ;; rehighlight
 646   (if wl-highlight-body-too
 647       (let ((beg (point-min))
 648             (end (point-max)))
 649         (put-text-property beg end 'face nil)
 650         (wl-highlight-message beg end t))))
 651
 652 (require 'product)
 653 (product-provide (provide 'wl-addrmgr) (require 'wl-version))
 654
 655 ;;; wl-addrmgr.el ends here