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