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   (let ((draft-buffer wl-addrmgr-draft-buffer))
 366     (if (and draft-buffer
 367              (buffer-live-p draft-buffer)
 368              (null (get-buffer-window draft-buffer 'visible)))
 369         (switch-to-buffer draft-buffer)
 370       (unless (one-window-p)
 371         (delete-window)))
 372     (kill-buffer wl-addrmgr-buffer-name)
 373     (if (and draft-buffer (not (one-window-p)))
 374         (switch-to-buffer-other-window draft-buffer))))
 375
 376 (defun wl-addrmgr-quit ()
 377   "Exit from electric reference mode without inserting reference."
 378   (interactive)
 379   (let ((rcpt (wl-addrmgr-mark-check)))
 380     (if (or (nth 0 rcpt)
 381             (nth 1 rcpt)
 382             (nth 2 rcpt))
 383         (when (y-or-n-p "There is marked address. Quit wl-addrmgr really? ")
 384           (wl-addrmgr-quit-yes))
 385       (wl-addrmgr-quit-yes)))
 386   (message ""))
 387
 388 (defun wl-addrmgr-mark-set-to ()
 389   "Marking To: sign."
 390   (interactive)
 391   (wl-addrmgr-mark-write 'to)
 392   (wl-addrmgr-next))
 393
 394 (defun wl-addrmgr-mark-set-cc ()
 395   "Marking Cc: sign."
 396   (interactive)
 397   (wl-addrmgr-mark-write 'cc)
 398   (wl-addrmgr-next))
 399
 400 (defun wl-addrmgr-mark-set-bcc ()
 401   "Marking Bcc: sign."
 402   (interactive)
 403   (wl-addrmgr-mark-write 'bcc)
 404   (wl-addrmgr-next))
 405
 406 (defun wl-addrmgr-unmark ()
 407   "Erase Marked sign."
 408   (interactive)
 409   (let ((entry (wl-addrmgr-address-entry))
 410         buffer-read-only)
 411     (save-excursion
 412       (beginning-of-line)
 413       (delete-region (point) (progn (end-of-line)(point)))
 414       (wl-addrmgr-insert-line entry))
 415     (set-buffer-modified-p nil)
 416     (wl-addrmgr-next)))
 417
 418 (defun wl-addrmgr-sort ()
 419   "Sort address entry."
 420   (interactive)
 421   (setq wl-addrmgr-sort-key (intern
 422                              (completing-read
 423                               (format "Sort By (%s): "
 424                                       (symbol-name wl-addrmgr-sort-key))
 425                               '(("address")("realname")("petname")("none"))
 426                               nil t nil nil
 427                               (symbol-name wl-addrmgr-sort-key))))
 428   (if (eq wl-addrmgr-sort-key 'none)
 429       (wl-addrmgr-reload)
 430     (setq wl-addrmgr-sort-order (intern
 431                                  (completing-read
 432                                   (format "Sort Order (%s): "
 433                                           (symbol-name wl-addrmgr-sort-order))
 434                                   '(("ascending") ("descending"))
 435                                   nil t nil nil
 436                                   (symbol-name wl-addrmgr-sort-order))))
 437     (wl-addrmgr-redraw)))
 438
 439 ;;; Backend methods.
 440 (defun wl-addrmgr-method-call (method &rest args)
 441   (apply (intern (concat "wl-addrmgr-"
 442                          (symbol-name wl-addrmgr-method)
 443                          "-" (symbol-name method)))
 444          args))
 445
 446 (defun wl-addrmgr-change-method ()
 447   (interactive)
 448   (setq wl-addrmgr-method (intern
 449                            (setq wl-addrmgr-method-name
 450                                  (completing-read
 451                                   (format "Method (%s): "
 452                                           (symbol-name wl-addrmgr-method))
 453                                   (mapcar (lambda (method)
 454                                             (list (symbol-name method)))
 455                                           wl-addrmgr-method-list)
 456                                   nil t nil nil
 457                                   (symbol-name wl-addrmgr-method)))))
 458   (wl-addrmgr-redraw))
 459
 460 (defun wl-addrmgr-list (&optional reload)
 461   "List address entries."
 462   (wl-addrmgr-method-call 'list reload))
 463
 464 (defun wl-addrmgr-add ()
 465   "Add address entry."
 466   (interactive)
 467   (let ((entry (wl-addrmgr-method-call 'add)))
 468     (if (eq wl-addrmgr-sort-key 'none)
 469         (wl-addrmgr-reload)
 470       (setq wl-addrmgr-list (cons entry wl-addrmgr-list))
 471       (wl-addrmgr-redraw))
 472     (message "Added `%s'." (wl-string (car entry)))))
 473
 474 (defun wl-addrmgr-delete ()
 475   "Delete address entry."
 476   (interactive)
 477   (let ((addr (wl-string (car (wl-addrmgr-address-entry))))
 478         lines)
 479     (when (and addr
 480                (y-or-n-p (format "Delete '%s'? " addr)))
 481       (setq lines (count-lines (point-min) (point)))
 482       (wl-addrmgr-method-call 'delete addr)
 483       (setq wl-addrmgr-list (delq (assoc addr wl-addrmgr-list)
 484                                   wl-addrmgr-list))
 485       (wl-addrmgr-redraw)
 486       (forward-line (- lines 2))
 487       (message "Deleted `%s'." addr))))
 488
 489 (defun wl-addrmgr-edit ()
 490   "Edit address entry."
 491   (interactive)
 492   (let ((orig (wl-addrmgr-address-entry))
 493         entry lines)
 494     (setq entry (wl-addrmgr-method-call 'edit (wl-string (car orig))))
 495     (setq lines (count-lines (point-min) (point)))
 496     (if (eq wl-addrmgr-sort-key 'none)
 497         (wl-addrmgr-reload)
 498       (setq wl-addrmgr-list (delq (assoc (car orig) wl-addrmgr-list)
 499                                   wl-addrmgr-list)
 500             wl-addrmgr-list (cons entry wl-addrmgr-list))
 501       (wl-addrmgr-redraw))
 502     (forward-line (- lines 1))
 503     (message "Modified `%s'." (wl-string (car entry)))))
 504
 505 ;;; local address book implementation.
 506 (defun wl-addrmgr-local-list (reload)
 507   (if (or (null wl-address-list) reload)
 508       (wl-address-init))
 509   (copy-sequence wl-address-list))
 510
 511 (defun wl-addrmgr-local-add ()
 512   (wl-address-add-or-change nil nil 'addr-too))
 513
 514 (defun wl-addrmgr-local-edit (address)
 515   (wl-address-add-or-change address nil 'addr-too))
 516
 517 (defun wl-addrmgr-local-delete (address)
 518   (wl-address-delete address))
 519
 520 ;;; LDAP implementation (Implement Me)
 521
 522 ;;; Operations.
 523
 524 (defun wl-addrmgr-address-entry ()
 525   (save-excursion
 526     (end-of-line)
 527     (get-text-property (previous-single-property-change
 528                         (point) 'wl-addrmgr-entry nil
 529                         (progn
 530                           (beginning-of-line)
 531                           (point)))
 532                        'wl-addrmgr-entry)))
 533
 534 (defun wl-addrmgr-mark-write (&optional mark)
 535   "Set MARK to the current address entry."
 536   (save-excursion
 537     (end-of-line)
 538     (unless (< (count-lines (point-min) (point)) 3)
 539       (let ((buffer-read-only nil) beg end)
 540         (beginning-of-line)
 541         (delete-char 4)
 542         (insert (case mark
 543                   (to "To: ")
 544                   (cc "Cc: ")
 545                   (bcc "Bcc:")
 546                   (t "    ")))
 547         (insert (make-string (- 4 (current-column)) ? ))
 548         (beginning-of-line)
 549         (setq beg (point))
 550         (setq end (progn (end-of-line)
 551                          (point)))
 552         (put-text-property beg end 'face nil)
 553         (wl-highlight-message beg end nil))
 554       (set-buffer-modified-p nil)
 555       (beginning-of-line)
 556       (forward-char 4))))
 557
 558 (defun wl-addrmgr-apply ()
 559   (interactive)
 560   (let ((rcpt (wl-addrmgr-mark-check 'full)))
 561     (when (or (or (nth 0 rcpt)
 562                   (nth 1 rcpt)
 563                   (nth 2 rcpt))
 564               (or (cdr (assq 'to wl-addrmgr-unknown-list))
 565                   (cdr (assq 'cc wl-addrmgr-unknown-list))
 566                   (cdr (assq 'bcc wl-addrmgr-unknown-list))))
 567       (wl-addrmgr-apply-exec (wl-addrmgr-mark-check 'full)))
 568     (wl-addrmgr-quit-yes)))
 569
 570 (defun wl-addrmgr-mark-check (&optional full)
 571   "Return list of recipients (TO CC BCC)."
 572   (save-excursion                       ; save cursor POINT
 573     (goto-char (point-min))
 574     (forward-line 2)
 575     (let (to-list cc-list bcc-list mark addr realname)
 576       (while (and (not (eobp))
 577                   (re-search-forward "^\\([^ ]+:\\) " nil t))
 578         (setq mark (match-string 1))
 579         (setq addr (car (wl-addrmgr-address-entry)))
 580         (setq realname (nth 2 (wl-addrmgr-address-entry)))
 581         (cond
 582          ((string= mark "To:")
 583           (setq to-list (cons
 584                          (if (and full
 585                                   (not (or (string= realname "")
 586                                            (string-match ".*:.*;$" addr))))
 587                              (concat
 588                               (wl-address-quote-specials realname)
 589                               " <" addr">")
 590                            addr)
 591                          to-list)))
 592          ((string= mark "Cc:")
 593           (setq cc-list (cons
 594                          (if (and full
 595                                   (not (or (string= realname "")
 596                                            (string-match ".*:.*;$" addr))))
 597                              (concat
 598                               (wl-address-quote-specials realname)
 599                               " <" addr">")
 600                            addr)
 601                          cc-list)))
 602          ((string= mark "Bcc:")
 603           (setq bcc-list (cons
 604                           (if (and full
 605                                    (not (or (string= realname "")
 606                                             (string-match ".*:.*;$" addr))))
 607                               (concat
 608                                (wl-address-quote-specials realname)
 609                                " <" addr">")
 610                             addr)
 611                           bcc-list)))))
 612       (list to-list cc-list bcc-list))))
 613
 614 (defun wl-addrmgr-apply-exec (rcpt)
 615   (let ((to (nconc (nth 0 rcpt) (cdr (assq 'to wl-addrmgr-unknown-list))))
 616         (cc (nconc (nth 1 rcpt) (cdr (assq 'cc wl-addrmgr-unknown-list))))
 617         (bcc (nconc (nth 2 rcpt) (cdr (assq 'bcc wl-addrmgr-unknown-list))))
 618         from clist)
 619     (setq clist (list (cons "Bcc" (if bcc (mapconcat 'identity bcc ",\n\t")))
 620                       (cons "Cc" (if cc (mapconcat 'identity cc ",\n\t")))
 621                       (cons "To" (if to (mapconcat 'identity to ",\n\t")))))
 622     (when (or (null wl-addrmgr-draft-buffer)
 623               (not (buffer-live-p wl-addrmgr-draft-buffer)))
 624       (setq wl-addrmgr-draft-buffer (save-window-excursion
 625                                       (call-interactively 'wl-draft)
 626                                       (current-buffer))))
 627     (with-current-buffer wl-addrmgr-draft-buffer
 628       (setq from (std11-field-body "From"))
 629       (if from
 630           (setq clist (append clist (list (cons "From" from)))))
 631       (wl-addrmgr-mark-exec-sub clist))))
 632
 633 (defun wl-addrmgr-replace-field (field content)
 634   "Insert FIELD with CONTENT to the top of the header fields."
 635   (save-excursion
 636     (save-restriction
 637       (let ((case-fold-search t)
 638             (inhibit-read-only t) ;; added by teranisi.
 639             beg)
 640         (std11-narrow-to-header mail-header-separator)
 641         (goto-char (point-min))
 642         (while (re-search-forward (concat "^" (regexp-quote field) ":") nil t)
 643           ;; delete field
 644           (progn
 645             (save-excursion
 646               (beginning-of-line)
 647               (setq beg (point)))
 648             (re-search-forward "^[^ \t]" nil 'move)
 649             (beginning-of-line)
 650             (delete-region beg (point))))
 651         (when content
 652           ;; add field to top.
 653           (goto-char (point-min))
 654           (insert (concat field ": " content "\n")))))))
 655
 656 (defun wl-addrmgr-mark-exec-sub (list)
 657   (dolist (pair list)
 658     (wl-addrmgr-replace-field (car pair) (cdr pair)))
 659   ;; from wl-template.el
 660   ;; rehighlight
 661   (if wl-highlight-body-too
 662       (let ((beg (point-min))
 663             (end (point-max)))
 664         (put-text-property beg end 'face nil)
 665         (wl-highlight-message beg end t))))
 666
 667 (require 'product)
 668 (product-provide (provide 'wl-addrmgr) (require 'wl-version))
 669
 670 ;;; wl-addrmgr.el ends here