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