1 ;; -*- mode: Emacs-Lisp; mode: rainbow; -*-
3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4 ;; This program is free software: you can redistribute it and/or modify ;;
5 ;; it under the terms of the version 3 of the GNU General Public License ;;
6 ;; as published by the Free Software Foundation. ;;
8 ;; This program is distributed in the hope that it will be useful, but ;;
9 ;; WITHOUT ANY WARRANTY; without even the implied warranty of ;;
10 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;
11 ;; General Public License for more details. ;;
13 ;; You should have received a copy of the GNU General Public License ;;
14 ;; along with this program. If not, see <http://www.gnu.org/licenses/>. ;;
16 ;; Written by and Copyright (C) Francois Fleuret ;;
17 ;; Contact <francois@fleuret.org> for comments & bug reports ;;
18 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
20 (setq-default vm-summary-show-threads t)
22 ;; (setq vm-preview-lines nil)
24 ;; (setq vm-auto-displayed-mime-content-types '("text"));; "multipart"));; "image/xpm"
26 (setq vm-mime-thumbnail-max-geometry nil)
28 (setq vm-auto-displayed-mime-content-types '(
37 (setq vm-startup-message-displayed t ;; Yes, we already saw it, no need to insist
39 vm-skip-deleted-messages nil
40 vm-skip-read-messages nil
42 ;; vm-jump-to-new-messages nil
43 vm-startup-with-summary t
44 ;; vm-preview-read-messages t
46 vm-auto-get-new-mail t
47 vm-circular-folders nil
48 vm-confirm-new-folders t
51 vm-summary-thread-indent-level 1
52 ;; vm-summary-uninteresting-senders-arrow "->"
53 ;; vm-summary-uninteresting-senders-arrow "►"
54 vm-summary-uninteresting-senders-arrow ">"
55 ;; vm-summary-uninteresting-senders-arrow "➔"
56 ;; vm-summary-uninteresting-senders-arrow "➤"
58 vm-included-text-prefix " > "
59 vm-forwarding-digest-type "mime"
60 vm-mime-attachment-save-directory "~/misc/attachments"
62 vm-frame-per-folder nil
63 vm-frame-per-summary nil
64 vm-mime-yank-attachments nil
66 ;; vm-mime-7bit-composition-charset "latin-1"
67 vm-mime-8bit-composition-charset "iso-8859-1"
68 ;; vm-mime-8bit-composition-charset "utf-8"
69 ;; browse-url-mozilla-program "iceweasel"
70 vm-netscape-program browse-url-mozilla-program
71 ;; vm-coding-system-priorities '(utf-8)
72 ;; mail-from-style nil
73 ;; mail-complete-style nil
75 ;; vm-summary-format " %*%A %-3.3m %2d %5US %I%UA %s\n"
76 vm-summary-format " %*%a %-3.3m %2d %5US %I%UA %s\n"
77 ;; vm-highlighted-header-regexp "From:\\|Subject:\\|Cc:\\|To:\\|Bcc:\\|Reply-To:"
78 vm-highlighted-header-regexp "From:\\|Subject:\\|Reply-To:"
80 vm-auto-folder-case-fold-search t
82 vm-keep-sent-messages nil
83 vm-delete-after-saving t
84 vm-delete-after-archiving t
86 vm-forwarding-subject-format "(forwarded from %F) %s"
87 vm-in-reply-to-format nil
88 vm-included-text-attribution-format "\nOn %w, %m %d, %y (%h), %F wrote:\n\n"
89 ;; vm-included-text-attribution-format "\nOn %w, %m %d, at %H, you wrote:\n\n"
90 vm-reply-subject-prefix "Re: "
93 mail-specify-envelope-from t
95 bbdb/mail-auto-create-p nil
96 bbdb-send-mail-style 'vm
100 ;; (add-to-list 'vm-visible-headers "From " t)
101 (add-to-list 'vm-visible-headers "Reply-To:" t)
102 ;; (add-to-list 'vm-visible-headers "X-Mailer:" t)
103 ;; (add-to-list 'vm-visible-headers "X-from-in-bbdb:" t)
104 ;; (add-to-list 'vm-visible-headers "Return-Path:")
106 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
107 ;; Mime-related stuff
111 ;; vm-auto-displayed-mime-content-types '("text/plain" "text" "image" "multipart")
112 ;; vm-display-using-mime t
113 ;; vm-coding-system-priorities '(iso-8859-1 iso-8859-15 utf-8)
115 vm-infer-mime-types t
116 vm-mime-use-image-strips nil
117 vm-mime-base64-decoder-program "base64"
118 vm-mime-base64-decoder-switches '("-d")
119 vm-mime-base64-encoder-program "base64"
120 vm-mime-base64-encoder-switches '()
122 ;; vm-auto-displayed-mime-content-types '(
129 ;; vm-auto-displayed-mime-content-type-exceptions '("text/html")
131 vm-mime-internal-content-types '(
139 ;; To force it to be converted to plain text
140 ;; vm-mime-internal-content-type-exceptions '("text/html")
142 vm-mime-external-content-types-alist '(
143 ("application/x-dvi" "xdvi")
144 ("image/postscript" "gv")
145 ("application/pdf" "xpdf")
146 ;; ("application/pdf" "epdfview")
147 ("application/postscript" "gv")
150 ;; ("text/html" "iceweasel")
155 (require 'vm-rfaddons)
157 (setq vm-mime-default-face-charsets t)
158 ;; (add-to-list 'vm-mime-default-face-charsets "utf-8")
160 ;; (add-to-list 'vm-mime-default-face-charsets "iso-8859-1")
161 ;; (add-to-list 'vm-mime-default-face-charsets "Windows-1251")
162 ;; (add-hook 'vm-mail-send-hook 'ff/vm-remove-non-7bits-in-headers)
163 (add-hook 'vm-mail-send-hook 'vm-mime-encode-headers)
164 (add-hook 'vm-mail-send-hook 'vm-mail-check-recipients)
165 (add-hook 'vm-reply-hook (lambda () (set-buffer-modified-p nil)))
167 (add-to-list 'vm-mime-attachment-auto-type-alist '(".*" . "application/octet-stream") t)
169 ;; (add-to-list 'vm-mime-type-converter-alist '("text/html" "text/plain" "cat"))
170 ;; (add-to-list 'vm-mime-type-converter-alist '("text/html" "text/plain" "lynx -nolist -force_html -dump -stdin"))
172 ;; (add-to-list 'vm-mime-type-converter-alist
173 ;; '("text/html" "text/plain"
174 ;; "w3m -cols 75 -graph -dump -T text/html"
177 ;; (add-to-list 'vm-mime-type-converter-alist
178 ;; '("text/html" "text/plain"
179 ;; "html2text -style pretty -nobs"
182 ;; (add-to-list 'vm-mime-type-converter-alist
183 ;; '("text/html" "text/plain"
187 (add-to-list 'vm-mime-type-converter-alist
188 '("image" "image/xpm"
189 "/usr/bin/convert -geometry 640x480 - xpm:-"))
191 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
193 ;; (defun ff/vm-remove-properties () (interactive)
195 ;; (goto-char (point-min))
196 ;; (re-search-forward (concat "^" mail-header-separator "$"))
197 ;; (set-text-properties (point) (point-max) nil)
201 ;; (add-hook 'vm-mail-send-hook 'ff/vm-remove-properties)
203 ;; (defun ff/vm-mime-save-all-files (&optional delete)
204 ;; "Save all the mail attachments. With delete argument, remove
205 ;; the attachement from mail."
207 ;; (let ((vm-mime-delete-after-saving delete))
208 ;; (while (and (vm-mime-reader-map-save-file)
209 ;; (condition-case nil (vm-move-to-next-button 1)
213 (defun ff/vm-mime-save-file (&optional delete)
214 "Save the current attachement. With delete argument, remove the
215 attachement from mail."
217 (let ((vm-mime-delete-after-saving delete))
218 (vm-mime-reader-map-save-file))
219 (condition-case nil (vm-move-to-next-button 1) (error (message "No more attachment"))))
221 ;; (define-key vm-summary-mode-map [(r)] 'vm-reply-include-text)
222 ;; (define-key vm-summary-mode-map [(R)] 'vm-followup-include-text)
224 (define-key vm-summary-mode-map [(control o)] 'ff/vm-mime-save-file)
226 (define-key vm-summary-mode-map [(control t)]
227 (lambda () (interactive)
228 (vm-toggle-threads-display)
229 (unless vm-summary-show-threads
230 (vm-sort-messages "date"))))
232 (defun ff/vm-select-thread-for-next-command () (interactive)
233 (vm-mark-thread-subtree)
234 (vm-next-command-uses-marks))
236 (define-key vm-summary-mode-map "T" 'ff/vm-select-thread-for-next-command)
238 (defun ff/vm-attach-file-or-dir
240 "Attaches the file or recursively the content of the directory with
241 `vm-mime-attach-file'."
242 (interactive "fFile or directory: ")
245 (goto-char (point-max))
247 (if (file-regular-p dir)
248 (vm-mime-attach-file dir (vm-mime-default-type-from-filename dir))
249 (if (file-directory-p dir)
252 (when (not (string-match "^\\." (car x)))
253 (ff/vm-attach-file-or-dir
255 (unless (string-match "/$" dir) "/")
257 (directory-files-and-attributes dir)
260 (error "Can attach only files and directories")
263 (define-key vm-mail-mode-map [(control c) (control a)] 'ff/vm-attach-file-or-dir)
265 ;; Found no other way to avoid displaying the icones
267 (defun vm-mime-set-image-stamp-for-type (e type))
269 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
272 (defun vm-summary-function-A (message)
273 (let* ((from (vm-su-from message)))
274 (if (string-match vm-summary-uninteresting-senders from)
275 (concat vm-summary-uninteresting-senders-arrow " " (ff/explicit-name (vm-su-to message)))
276 (ff/explicit-name from))))
278 (defun vm-summary-function-S (&optional message)
279 (let ((s (string-to-int (vm-su-byte-count message))))
281 (propertize (concat (int-to-string (/ s 1024)) "k")
286 (defun ff/vm-delete-and-go-down () (interactive)
288 (vm-delete-message 1)
289 (condition-case nil (vm-next-message-no-skip 1) (error nil)))
291 (defun ff/vm-expunge-folder ()
292 (unless vm-folder-read-only (vm-expunge-folder)))
294 (add-hook 'vm-quit-hook 'ff/vm-expunge-folder)
295 (add-hook 'vm-quit-hook 'bbdb-save-db)
296 (add-hook 'vm-retrieved-spooled-mail-hook 'display-time-update)
298 (ff/configure-faces '((ff/summary-highlight-face :background "yellow"
302 (setq vm-summary-highlight-face 'ff/summary-highlight-face)
304 (define-key vm-summary-mode-map [(K)] 'ff/vm-delete-and-go-down)
306 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
307 ;; Activate the required modes and authorize the commenting
309 (defun ff/prepare-mail-mode ()
310 (bbdb-define-all-aliases)
315 ;; (setq fill-paragraph-function 'mail-mode-fill-paragraph)
317 ;; Since I set the comment prefix, I have to tell the filling
318 ;; functions not to use it
320 ;; ******************* removed Aug 23
321 ;; (setq fill-paragraph-handle-comment nil)
322 ;; ;; (when message-yank-prefix
323 (set (make-local-variable 'comment-start) vm-included-text-prefix)
324 ;; (set (make-local-variable 'comment-start-skip)
325 ;; (concat "^\\(" (regexp-quote vm-included-text-prefix) "\\)"))
329 (add-hook 'mail-mode-hook 'ff/prepare-mail-mode)
330 ;; (add-hook 'mail-mode-hook 'orgtbl-mode)
332 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
333 ;; To have a slightly darker background for headers
336 ;; '((ff/mail-header-face :background "#c8c8ff"))
337 '((ff/mail-header-face :foreground "blue4"))
340 (defun ff/colorize-headers () (interactive)
341 (let ((inhibit-read-only t))
343 (goto-char (point-min))
344 (while (vm-match-header)
345 (goto-char (vm-matched-header-end)))
347 ;; (vm-matched-header-contents-start)
348 ;; (vm-matched-header-contents-end)
351 '(face ff/mail-header-face)
355 (defadvice vm-highlight-headers (after ff/colorize-headers nil activate)
356 (ff/colorize-headers))
358 (defun ff/highlight-important-words ()
359 (let ((inhibit-read-only t))
361 (goto-char (point-min))
362 (while (re-search-forward "Fleuret" nil t)
363 (message "%d-%d" (match-beginning 0) (match-end 0))
364 ;; (add-text-properties (match-beginning 0) (match-end 0)
365 ;; '(face (:background "red"))
370 ;; (add-hook 'vm-select-message-hook 'ff/highlight-important-words)
372 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
373 ;; I want to have a file associated to every mail I am writing
375 (defcustom ff/vm-mail-draft-directory "~/"
376 "Where to save mail drafts with VM")
378 (defun ff/associate-file-to-vm-mail-buffer ()
379 "Associate the current buffer to a file whose name is built from the current time."
380 (unless (buffer-file-name)
381 (set-visited-file-name (format
383 ff/vm-mail-draft-directory
385 "%04Y%02m%02d-%02H%02M%02S"
387 (set-buffer-modified-p nil)))
389 (add-hook 'mail-setup-hook 'ff/associate-file-to-vm-mail-buffer)
391 (defun ff/mail-header-field (field) (interactive)
392 "Grab the value of a certain field from the mail header."
393 (let ((s "no-subject"))
395 (goto-char (point-min))
396 (let ((l (re-search-forward (concat "^" mail-header-separator "$") nil t)))
398 (goto-char (point-min))
399 (when (re-search-forward (concat "^" field ": ") l t nil)
400 (setq s (buffer-substring-no-properties (point) (point-at-eol))))
406 (defun ff/dissociate-file-from-vm-mail-buffer ()
407 "Save the file under a new name and set the associated file to nil."
408 (let ((bn (buffer-file-name)))
410 (set-visited-file-name
411 (concat (file-name-directory bn)
413 (file-name-nondirectory bn)
415 (replace-regexp-in-string "[^a-zA-Z0-9]+" "_"
416 (ff/mail-header-field "Subject"))
419 (set-visited-file-name nil))
423 (defun ff/find-file-in-vm-mail-mode (filename) (interactive)
424 ;; No easy way to activate vm-mail-mode, so we create such a
425 ;; buffer, erase its content and insert the file
427 (when (file-exists-p filename)
429 (insert-file filename))
430 (set-visited-file-name filename)
431 (set-buffer-modified-p nil)
432 ;; (run-hooks find-file-hooks)
433 (when (functionp 'alarm-vc-check) (alarm-vc-check))
434 ;; Move the cursor at a convenient location
435 (when (re-search-forward (concat "^" mail-header-separator "$") nil t)
436 (if (re-search-forward "^-- $" nil t)
442 ;; All this mess to activate the vm-mail-mode when loading a file
443 ;; looking like a mail draft. Did I miss something ?
445 (defadvice find-file (around ff/find-file-or-mail
446 (filename &optional wildcards)
449 (interactive "FFind file: \np")
451 (if (string-match "^\\(mail\\|sent\\)-[^/]+$"
452 (file-name-nondirectory filename))
454 (if (find-buffer-visiting filename)
455 (switch-to-buffer (find-buffer-visiting filename))
456 (ff/find-file-in-vm-mail-mode filename))
460 (setq ff/vm-mail-draft-directory "~/private/drafts")
462 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
463 ;; Check there are no missing attachment (the idea comes from
464 ;; http://home.cc.gatech.edu/eaganj/MailApp) and no leading "From"
465 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
467 (defcustom ff/check-vm-attachement-regexp "attach"
468 "*A mail whose body matches this regular expression should contain
471 (defun ff/check-vm-attachment ()
472 (when (save-excursion
473 (goto-char (point-min))
474 (and (re-search-forward "\\[ATTACHMENT" nil t)
475 (not (get-text-property (point) 'vm-mime-object))))
476 (error "Buggy attachment"))
479 (save-excursion (goto-char (point-min))
480 (re-search-forward ff/check-vm-attachement-regexp nil t))
481 (not (save-excursion (goto-char (point-min))
482 (re-search-forward "\\[ATTACHMENT" nil t)))
483 (not (y-or-n-p "An attachment seems to be missing, send message ? ")))
484 (error "You refer to an unexisting attachment."))
488 ;; You can not have a line starting with "From:" in a pure text
489 ;; mail. The smtp server would add a leading character to prevent it.
491 (defun ff/check-no-leading-from ()
492 (and (let ((case-fold-search nil))
494 (goto-char (point-min))
495 (re-search-forward (concat "^" mail-header-separator "$"))
496 (re-search-forward "^From " nil t)))
497 (not (y-or-n-p "There is a leading ``From '', send message ? "))
498 (error "There is a leading ``From ''.")))
500 ;; An attempt at limiting excess wording in sent mails
502 (defface ff/strong-words
503 '((t (:background "red")))
504 "The face to highlight upper caps, exclamation marks and such.")
506 (defun ff/max-in-a-row (overlay regexp max)
507 (let ((case-fold-search nil))
509 (goto-char (point-min))
510 (re-search-forward (concat "^" mail-header-separator "$"))
511 (when (and (re-search-forward regexp nil t nil)
512 (>= (- (match-end 0) (match-beginning 0)) max))
513 (move-overlay overlay (match-beginning 0) (match-end 0))
516 (defun ff/check-no-excess-wording () (interactive)
517 (let ((overlay (make-overlay 0 0)))
518 (overlay-put overlay 'face 'media/current-tune-face)
520 (or (ff/max-in-a-row overlay "[A-Z\?\!][A-Z\?\! ]+[A-Z\?\!]" 6)
521 (ff/max-in-a-row overlay "[\?\!]+" 2)
523 (not (y-or-n-p "That does not look good. Send message ? ")))))
524 (delete-overlay overlay)
525 (when err (error "Good idea. Chill out a bit.")))
528 (defun ff/check-badly-encoded-address () (interactive)
529 (let (bodysep bad-adr)
531 (goto-char (point-min))
532 (search-forward mail-header-separator)
533 (setq bodysep (vm-marker (match-beginning 0)))
534 (goto-char (point-min))
535 (setq bad-adr (re-search-forward "[^<a-zA-Z_0-9\-\. \n\t]+[^ \n]*@" nil t))
536 (when (and bad-adr (< bad-adr bodysep))
537 (error "There is an invalid address in the header (%s)"
541 (add-hook 'vm-mail-send-hook 'ff/check-vm-attachment)
542 (add-hook 'vm-mail-send-hook 'ff/check-no-leading-from)
543 (add-hook 'vm-mail-send-hook 'ff/check-no-excess-wording)
544 (add-hook 'vm-mail-send-hook 'flyspell-mode-off)
545 ;; Append so that it happens after the mime encoding
546 ;; (add-hook 'vm-mail-send-hook 'ff/check-badly-encoded-address t)
547 ;; Append this hook so that it runs after all other checks
548 (add-hook 'vm-mail-send-hook 'ff/dissociate-file-from-vm-mail-buffer t)
550 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
551 ;; If we can, encrypt!
553 (add-hook 'vm-mode-hook 'mc-install-read-mode)
554 (add-hook 'vm-summary-mode-hook 'mc-install-read-mode)
555 (add-hook 'vm-virtual-mode-hook 'mc-install-read-mode)
556 (add-hook 'vm-mail-mode-hook 'mc-install-write-mode)
558 ;; (defun ff/encrypt-mail-if-possible () (interactive)
559 ;; (condition-case nil (mc-encrypt)
562 ;; (add-hook 'vm-mail-send-hook 'ff/encrypt-mail-if-possible t)
564 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
567 ;; Move through important points in the mail ("To:" field, "Subject:"
568 ;; field and the end of the body)
570 (defun ff/goto-next-mail-field () (interactive)
571 (let ((field (save-excursion
573 (re-search-backward (concat "\\(^[a-zA-Z\-]*: \\|^" mail-header-separator "$\\)") nil t)
576 (cond ((string= field "To: ")
578 (re-search-forward "Subject: ")
581 ((string= field "Subject: ")
582 (re-search-forward (concat "^" mail-header-separator "$"))
583 (if (re-search-forward "^-- $" nil t)
588 (t (beginning-of-buffer)
589 (re-search-forward "^To: ")
591 (re-search-forward "^[a-zA-Z\-]*: ")
595 ;; (define-key vm-mail-mode-map [(control tab)] 'ff/goto-next-mail-field)
596 (define-key vm-mail-mode-map [(iso-lefttab)] 'ff/goto-next-mail-field)
597 ;; (define-key vm-mail-mode-map [(shift iso-lefttab)] 'mail-mode-smart-tab)
598 (define-key vm-mail-mode-map [(shift iso-lefttab)] 'bbdb-complete-name)
600 ;; The definition of "\t" is forced through a hook defined in
601 ;; vm-init.el, so I add mine. This is ugly.
603 (add-hook 'mail-setup-hook
604 '(lambda () (local-set-key "\t" 'ff/goto-next-mail-field))
607 (substitute-key-definition 'next-line 'mail-abbrev-next-line vm-mail-mode-map global-map)
608 (substitute-key-definition 'end-of-buffer 'mail-abbrev-end-of-buffer vm-mail-mode-map global-map)
610 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
611 ;; I rarely edit two mails at the same time, and it makes sense to
612 ;; come back to the one currently being edited with the same function
614 (defun ff/first-buffer-in-mode (l m)
616 (if (eq (save-excursion
617 (set-buffer (car l)) major-mode) m)
619 (ff/first-buffer-in-mode (cdr l) m))))
621 (defun ff/compose-mail (&optional force-new)
622 "Cycles through an existing buffers with major mode `mail-mode',
623 or invoke `vm-compose-mail' if none can be found or if FORCE-NEW
626 (when (eq major-mode 'mail-mode) (bury-buffer))
627 (let ((buf (and (not force-new)
628 (ff/first-buffer-in-mode (buffer-list) 'mail-mode))))
629 (if buf (switch-to-buffer buf)
632 (define-key global-map [(control x) (m)] 'ff/compose-mail)
634 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
640 (when (load "bbdb-vm" t)
642 (defun ff/mail-aliases-from-bbdb ()
643 "Creates automatically mail aliases from the bbdb records. For
644 instance, someone in bbdb named \"Paul Smith\" would generate an alias
645 'pm'. Does not replace existing aliases."
647 (let* ((records (bbdb-records)))
649 (let* ((record (car records))
650 (name (concat (elt record 0) " " (elt record 1)))
651 (email (car (elt record 6)))
652 (alias (downcase (replace-regexp-in-string
653 "\\([a-zA-Z]?\\)[^- ]*[- ]*" "\\1" name))))
654 (if (and (> (length alias) 1)
655 ;; Do not overwrite an existing alias
656 (not (and mail-abbrevs (intern-soft alias mail-abbrevs))))
657 (define-mail-abbrev alias email))
658 (setq records (cdr records))))))
660 (when (>= emacs-major-version 22)
662 (ff/mail-aliases-from-bbdb))