-;;; wl-address.el -- Tiny address management for Wanderlust.
+;;; wl-address.el --- Tiny address management for Wanderlust.
-;; Copyright 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
-;; Shun-ichi GOTO <gotoh@taiyo.co.jp>
-;; Takeshi Chiba <chiba@d3.bs1.fc.nec.co.jp>
+;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
+;; Copyright (C) 1998,1999,2000 Shun-ichi GOTO <gotoh@taiyo.co.jp>
+;; Copyright (C) 1998,1999,2000 Takeshi Chiba <chiba@d3.bs1.fc.nec.co.jp>
;; Author: Yuuichi Teranishi <teranisi@gohome.org>
;; Shun-ichi GOTO <gotoh@taiyo.co.jp>
;;
;;; Commentary:
-;;
+;;
;;; Code:
-;;
+;;
(require 'wl-util)
(require 'wl-vars)
values nil)
(setq values (cdr values)))))
ret))
-
+
(defun wl-ldap-get-value-list (type entry)
""
(cdr (assoc type entry)))
(defun wl-ldap-make-filter (pat type-list)
"Make RFC1558 quiery filter for PAT from ATTR-LIST.
Each are \"OR\" combination, and PAT is beginning-match."
- (concat "(&(objectclass=person)(|"
+ (concat "(&(objectclass=" wl-ldap-objectclass ")(|"
(mapconcat (lambda (x) (format "(%s=%s*)" x pat)) ; fixed format
type-list
"")
(setq type (car (car entry))
values (mapcar (function wl-ldap-alias-safe-string)
(cdr (car entry)))
+ values (elmo-flatten values)
entry (cdr entry))
(if (string-match "::?$" type)
(setq type (substring type 0 (match-beginning 0))))
(defun wl-ldap-alias-safe-string (str)
"Modify STR for alias.
Replace space/tab in STR into '_' char.
-Replace '@' in STR into '/' char."
+Replace '@' in STR into list of mailbox and sub-domains."
(while (string-match "[^_a-zA-Z0-9+@%.!\\-/]+" str)
(setq str (concat (substring str 0 (match-beginning 0))
"_"
(substring str (match-end 0)))))
(if (string-match "\\(@\\)[^/@]+" str)
- (setq str (concat (substring str 0 (match-beginning 1))
- "/"
- (substring str (match-end 1)))))
+ (setq str (split-string str "[@\\.]")))
str)
(defun wl-ldap-register-dn-string (hash dn &optional str dn-list)
(if (string-match "[a-z]+=\\(.*\\)" str)
(wl-ldap-alias-safe-string
(wl-match-string 1 str))))
- (split-string dn ",")))))
+ (split-string dn "[ \t]*,[ \t]*")))))
+ (setq dn-list (elmo-flatten dn-list))
;; prepare candidate for uniq str
(if str
(setq str (concat str wl-ldap-alias-sep (car dn-list))
(completing-read "To: " cl)
(read-string "To: "))))
-(defun wl-address-quote-specials (word)
- "Make quoted string of WORD if needed."
- (if (assq 'specials (std11-lexical-analyze word))
- (prin1-to-string word)
- word))
+(defalias 'wl-address-quote-specials 'elmo-address-quote-specials)
(defun wl-address-make-completion-list (address-list)
(let (addr-tuple cl)
(if (null cl)
nil
(setq completion
- (let ((completion-ignore-case t))
- (try-completion pattern cl)))
+ (let ((completion-ignore-case t))
+ (try-completion pattern cl)))
(cond ((eq completion t)
(let ((alias (assoc pattern cl)))
(if alias
(let ((list (sort (all-completions pattern cl) 'string<)))
(wl-complete-window-show list)))))))
-(defvar wl-address-init-func 'wl-local-address-init)
+(defvar wl-address-init-function 'wl-local-address-init)
(defun wl-address-init ()
- "Call `wl-address-init-func'."
- (funcall wl-address-init-func))
+ "Call `wl-address-init-function'."
+ (funcall wl-address-init-function))
(defun wl-local-address-init ()
"Reload `wl-address-file'.
(when (< nest-count 5)
(let (expn-str new-expn-str expn new-expn(n 0) (expanded nil))
(while (setq expn-str (cdr (nth n alist)))
- (setq new-expn-str nil)
- (while (string-match "^[ \t]*\\([^,]+\\)" expn-str)
- (setq expn (elmo-match-string 1 expn-str))
+ (setq new-expn-str nil)
+ (while (string-match "^[ \t]*\\([^,]+\\)" expn-str)
+ (setq expn (elmo-match-string 1 expn-str))
(setq expn-str (wl-string-delete-match expn-str 0))
- (if (string-match "^[ \t,]+" expn-str)
+ (if (string-match "^[ \t,]+" expn-str)
(setq expn-str (wl-string-delete-match expn-str 0)))
- (if (string-match "[ \t,]+$" expn)
+ (if (string-match "[ \t,]+$" expn)
(setq expn (wl-string-delete-match expn 0)))
- (setq new-expn (cdr (assoc expn alist)))
- (if new-expn
- (setq expanded t))
- (setq new-expn-str (concat new-expn-str (and new-expn-str ", ")
- (or new-expn expn))))
- (when new-expn-str
- (setcdr (nth n alist) new-expn-str))
- (setq n (1+ n)))
+ (setq new-expn (cdr (assoc expn alist)))
+ (if new-expn
+ (setq expanded t))
+ (setq new-expn-str (concat new-expn-str (and new-expn-str ", ")
+ (or new-expn expn))))
+ (when new-expn-str
+ (setcdr (nth n alist) new-expn-str))
+ (setq n (1+ n)))
(and expanded
- (wl-address-expand-aliases alist (1+ nest-count))))))
+ (wl-address-expand-aliases alist (1+ nest-count))))))
(defun wl-address-make-alist-from-alias-file (file)
(elmo-set-work-buf
(while (re-search-forward ",$" nil t)
(end-of-line)
(forward-char 1)
- (delete-backward-char 1))
+ (delete-backward-char 1))
(goto-char (point-min))
(while (re-search-forward "^\\([^#;\n][^:]+\\):[ \t]*\\(.*\\)$" nil t)
(setq alias (wl-match-buffer 1)
(wl-address-expand-aliases alist 0)
(nreverse alist) ; return value
)))
-
+
(defun wl-address-make-address-list (path)
(if (and path (file-readable-p path))
(elmo-set-work-buf
- (let (ret
- (coding-system-for-read wl-cs-autoconv))
- (insert-file-contents path)
- (goto-char (point-min))
- (while (not (eobp))
- (if (looking-at
- "^\\([^#\n][^ \t\n]+\\)[ \t]+\"\\(.*\\)\"[ \t]+\"\\(.*\\)\"[ \t]*.*$")
- (setq ret
- (wl-append-element
- ret
- (list (wl-match-buffer 1)
- (wl-match-buffer 2)
- (wl-match-buffer 3)))))
- (forward-line))
- ret))))
-
-(defsubst wl-address-get-petname-1 (string)
+ (let (ret
+ (coding-system-for-read wl-cs-autoconv))
+ (insert-file-contents path)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (if (looking-at
+ "^\\([^#\n][^ \t\n]+\\)[ \t]+\\(\".*\"\\)[ \t]+\\(\".*\"\\)[ \t]*.*$")
+ (setq ret
+ (wl-append-element
+ ret
+ (list (wl-match-buffer 1)
+ (read (wl-match-buffer 2))
+ (read (wl-match-buffer 3))))))
+ (forward-line))
+ ret))))
+
+(defun wl-address-get-petname-1 (string)
(let ((address (downcase (wl-address-header-extract-address string))))
(elmo-get-hash-val address wl-address-petname-hash)))
e.g. \"m-sakura@ccs.mt.nec.co.jp (Mine Sakurai)\"
-> \"m-sakura@ccs.mt.nec.co.jp\"."
(cond ((string-match ".*<\\([^>]*\\)>" str) ; .* to extract last <>
- (wl-match-string 1 str))
- ((string-match "\\([^ \t\n]*@[^ \t\n]*\\)" str)
(wl-match-string 1 str))
- (t str)))
+ ((string-match "\\([^ \t\n]*@[^ \t\n]*\\)" str)
+ (wl-match-string 1 str))
+ (t str)))
(defsubst wl-address-header-extract-realname (str)
"Extracts a real name from STR and return it.
e.g. \"Mr. bar <hoge@foo.com>\"
-> \"Mr. bar\"."
(cond ((string-match "\\(.*[^ \t]\\)[ \t]*<[^>]*>" str)
- (wl-match-string 1 str))
- (t "")))
+ (wl-match-string 1 str))
+ (t "")))
(defmacro wl-address-concat-token (string token)
(` (cond
(setq sequence (cdr sequence)))))
address-string))
-(defun wl-address-petname-delete (the-email)
- "Delete petname in `wl-address-file'."
- (let* ( (tmp-buf (get-buffer-create " *wl-petname-tmp*"))
- (output-coding-system
- (mime-charset-to-coding-system wl-mime-charset)))
- (set-buffer tmp-buf)
- (message "Deleting Petname...")
- (erase-buffer)
- (insert-file-contents wl-address-file)
- (delete-matching-lines (concat "^[ \t]*" the-email))
- (write-region (point-min) (point-max)
- wl-address-file nil 'no-msg)
- (message "Deleting Petname...done")
- (kill-buffer tmp-buf)))
-
-
-(defun wl-address-petname-add-or-change (the-email
- default-petname
- default-realname
- &optional change-petname)
- "Add petname to `wl-address-file', if not registerd.
+(defun wl-address-delete (the-email)
+ "Delete address entry in the `wl-address-file'."
+ (let ((output-coding-system
+ (mime-charset-to-coding-system wl-mime-charset)))
+ (with-temp-buffer
+ (message "Deleting Address...")
+ (insert-file-contents wl-address-file)
+ (delete-matching-lines (concat "^[ \t]*" the-email))
+ (write-region (point-min) (point-max)
+ wl-address-file nil 'no-msg)
+ ;; Delete entries.
+ (dolist (entry (elmo-string-assoc-all the-email wl-address-list))
+ (setq wl-address-list (delete entry wl-address-list)))
+ (elmo-set-hash-val the-email nil wl-address-petname-hash)
+ (message "Deleting Address...done"))))
+
+(defun wl-address-add-or-change (address
+ &optional default-realname
+ change-address)
+ "Add address entry to `wl-address-file', if not registerd.
If already registerd, change it."
- (let (the-realname the-petname)
-
- ;; setup output "petname"
- ;; if null petname'd, let default-petname be the petname.
- (setq the-petname
- (read-from-minibuffer (format "Petname: ") default-petname))
- (if (string= the-petname "")
- (setq the-petname (or default-petname the-email)))
-
- ;; setup output "realname"
+ (let ((entry (assoc address wl-address-list))
+ the-realname the-petname new-addr addr-changed)
(setq the-realname
- (read-from-minibuffer (format "Real Name: ") default-realname))
-;;; (if (string= the-realname "")
-;;; (setq the-realname default-petname))
-
+ (read-from-minibuffer "Real Name: " (or default-realname
+ (nth 2 entry))))
+ (setq the-petname (read-from-minibuffer "Petname: "
+ (or (nth 1 entry)
+ the-realname)))
+ (when change-address
+ (setq new-addr (read-from-minibuffer "E-Mail: " address))
+ (if (and (not (string= address new-addr))
+ (assoc new-addr wl-address-list))
+ (error "'%s' already exists" new-addr)))
;; writing to ~/.address
- (let ( (tmp-buf (get-buffer-create " *wl-petname-tmp*"))
- (output-coding-system (mime-charset-to-coding-system wl-mime-charset)))
- (set-buffer tmp-buf)
- (message "Adding Petname...")
- (erase-buffer)
- (if (file-exists-p wl-address-file)
- (insert-file-contents wl-address-file))
- (if (not change-petname)
- ;; if only add
- (progn
- (goto-char (point-max))
- (if (and (> (buffer-size) 0)
- (not (eq (char-after (1- (point-max))) ?\n)))
- (insert "\n")))
- ;; if change
- (if (re-search-forward (concat "^[ \t]*" the-email) nil t)
+ (let ((output-coding-system
+ (mime-charset-to-coding-system wl-mime-charset)))
+ (with-temp-buffer
+ (if (file-exists-p wl-address-file)
+ (insert-file-contents wl-address-file))
+ (if (null entry)
+ ;; add
+ (progn
+ (goto-char (point-max))
+ (if (and (> (buffer-size) 0)
+ (not (eq (char-after (1- (point-max))) ?\n)))
+ (insert "\n")))
+ ;; override
+ (while (re-search-forward (concat "^[ \t]*" address) nil t)
(delete-region (save-excursion (beginning-of-line)
(point))
(save-excursion (end-of-line)
(+ 1 (point))))))
- (insert (format "%s\t\"%s\"\t\"%s\"\n"
- the-email the-petname the-realname))
- (write-region (point-min) (point-max)
- wl-address-file nil 'no-msg)
- (message "Adding Petname...done")
- (kill-buffer tmp-buf))))
+ (insert (format "%s\t%s\t%s\n"
+ (or new-addr address)
+ (prin1-to-string the-petname)
+ (prin1-to-string the-realname)))
+ (write-region (point-min) (point-max)
+ wl-address-file nil 'no-msg)
+ (wl-address-init)
+ (list (or new-addr address) the-petname the-realname)))))
(require 'product)
(product-provide (provide 'wl-address) (require 'wl-version))
projects / elisp / wanderlust.git / blobdiff