vm

   1 ;; -*- mode: Emacs-Lisp; mode: rainbow; -*-
   2
   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.                         ;;
   7 ;;                                                                       ;;
   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.                              ;;
  12 ;;                                                                       ;;
  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/>.  ;;
  15 ;;                                                                       ;;
  16 ;; Written by and Copyright (C) Francois Fleuret                         ;;
  17 ;; Contact < francois@fleuret.org > for comments & bug reports             ;;
  18 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  19
  20 (setq-default vm-summary-show-threads t)
  21
  22 (setq vm-startup-message-displayed t ;; Yes, we already saw it, no need to insist
  23       vm-use-menus nil
  24       vm-skip-deleted-messages nil
  25       vm-skip-read-messages nil
  26       vm-use-toolbar nil
  27       ;; vm-jump-to-new-messages nil
  28       vm-startup-with-summary t
  29       ;; vm-preview-read-messages t
  30       vm-preview-lines nil
  31       vm-auto-get-new-mail t
  32       vm-circular-folders nil
  33       vm-confirm-new-folders t
  34       vm-mutable-windows t
  35       vm-mutable-frames nil
  36       vm-summary-thread-indent-level 1
  37       vm-summary-uninteresting-senders-arrow "->"
  38       vm-summary-arrow "> "
  39       vm-included-text-prefix " > "
  40       vm-forwarding-digest-type "mime"
  41       vm-mime-attachment-save-directory "~/"
  42       vm-use-toolbar nil
  43       vm-frame-per-folder nil
  44       vm-frame-per-summary nil
  45       vm-mime-yank-attachments nil
  46
  47       ;; vm-mime-7bit-composition-charset "latin-1"
  48       vm-mime-8bit-composition-charset "iso-8859-1"
  49       ;; vm-mime-8bit-composition-charset "utf-8"
  50       ;; browse-url-mozilla-program "iceweasel"
  51       vm-netscape-program browse-url-mozilla-program
  52       ;; vm-coding-system-priorities '(utf-8)
  53       ;; mail-from-style nil
  54       ;; mail-complete-style nil
  55
  56       ;; vm-summary-format " %*%A %-3.3m %2d %5US %I%UA  %s\n"
  57       vm-summary-format " %*%a %-3.3m %2d %5US %I%UA  %s\n"
  58       ;; vm-highlighted-header-regexp "From:\\|Subject:\\|Cc:\\|To:\\|Bcc:\\|Reply-To:"
  59       vm-highlighted-header-regexp "From:\\|Subject:"
  60
  61       vm-auto-folder-case-fold-search t
  62
  63       vm-keep-sent-messages nil
  64       vm-delete-after-saving t
  65       vm-delete-after-archiving t
  66
  67       vm-forwarding-subject-format "(forwarded from %F) %s"
  68       vm-in-reply-to-format nil
  69       vm-included-text-attribution-format "\nOn %w, %m %d, %y (%h), %F wrote:\n\n"
  70       ;; vm-included-text-attribution-format "\nOn %w, %m %d, at %H, you wrote:\n\n"
  71       vm-reply-subject-prefix "Re: "
  72
  73       mail-signature t
  74       mail-specify-envelope-from t
  75
  76       bbdb/mail-auto-create-p nil
  77       bbdb-send-mail-style 'vm
  78
  79       )
  80
  81 ;; (add-to-list 'vm-visible-headers "Reply-To:" t)
  82 ;; (add-to-list 'vm-visible-headers "X-Mailer:" t)
  83 ;; (add-to-list 'vm-visible-headers "X-from-in-bbdb:" t)
  84 ;; (add-to-list 'vm-visible-headers "Return-Path:")
  85
  86 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  87 ;; Mime-related stuff
  88
  89 (setq
  90
  91  ;; vm-auto-displayed-mime-content-types '("text/plain" "text" "image" "multipart")
  92  ;; vm-display-using-mime t
  93  ;; vm-coding-system-priorities '(iso-8859-1 iso-8859-15 utf-8)
  94
  95  vm-infer-mime-types t
  96  vm-mime-use-image-strips nil
  97  vm-mime-base64-decoder-program "mimencode"
  98  vm-mime-base64-decoder-switches '("-u")
  99  vm-mime-base64-encoder-program "mimencode"
 100  vm-mime-base64-encoder-switches '()
 101
 102  vm-auto-displayed-mime-content-types '(
 103                                         ;; "plain text"
 104                                         "text"
 105                                         "multipart"
 106                                         "image/xpm"
 107                                         )
 108
 109  ;; vm-auto-displayed-mime-content-type-exceptions '("text/html")
 110
 111  vm-mime-internal-content-types '(
 112                                   "multipart"
 113                                   "text"
 114                                   ;; "plain text"
 115                                   ;; "plain text/utf8"
 116                                   "image/xpm"
 117                                   )
 118
 119  ;; To force it to be converted to plain text
 120  vm-mime-internal-content-type-exceptions '("text/html")
 121
 122  vm-mime-external-content-types-alist  '(
 123                                          ("application/x-dvi"      "xdvi")
 124                                          ("image/postscript"       "gv")
 125                                          ("application/pdf"        "xpdf")
 126                                          ;; ("application/pdf"        "epdfview")
 127                                          ("application/postscript" "gv")
 128                                          ;;("image"                  "feh")
 129                                          ("video"                  "mplayer")
 130                                          ;; ("text/html"             "iceweasel")
 131                                          )
 132
 133  )
 134
 135 (require 'vm-rfaddons)
 136
 137 ;; (add-to-list 'vm-mime-default-face-charsets  "utf-8")
 138
 139 (add-to-list 'vm-mime-default-face-charsets  "iso-8859-1")
 140 (add-hook 'vm-mail-send-hook 'vm-mime-encode-headers)
 141 (add-hook 'vm-mail-send-hook 'vm-mail-check-recipients)
 142 (add-hook 'vm-reply-hook (lambda () (set-buffer-modified-p nil)))
 143
 144 (add-to-list 'vm-mime-attachment-auto-type-alist '(".*" . "application/octet-stream") t)
 145
 146 ;; (add-to-list 'vm-mime-type-converter-alist '("text/html" "text/plain" "cat"))
 147 ;; (add-to-list 'vm-mime-type-converter-alist '("text/html" "text/plain" "lynx -nolist -force_html -dump -stdin"))
 148
 149 ;; (add-to-list 'vm-mime-type-converter-alist
 150 ;; '("text/html" "text/plain"
 151 ;; "w3m -cols 75 -graph -dump -T text/html"
 152 ;; ))
 153
 154 ;; (add-to-list 'vm-mime-type-converter-alist
 155              ;; '("text/html" "text/plain"
 156                ;; "html2text -style pretty -nobs"
 157                ;; ))
 158
 159 (add-to-list 'vm-mime-type-converter-alist
 160              '("text/html" "text/plain"
 161                "html2text.sh"
 162                ))
 163
 164 (add-to-list 'vm-mime-type-converter-alist
 165              '("image" "image/xpm"
 166                "/usr/bin/convert -geometry 640x480 - xpm:-"))
 167
 168 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 169
 170 ;; (defun ff/vm-remove-properties () (interactive)
 171 ;; (save-excursion
 172 ;; (goto-char (point-min))
 173 ;; (re-search-forward (concat "^" mail-header-separator "$"))
 174 ;; (set-text-properties (point) (point-max) nil)
 175 ;; )
 176 ;; )
 177
 178 ;; (add-hook 'vm-mail-send-hook 'ff/vm-remove-properties)
 179
 180 (defun ff/vm-mime-save-all-files (&optional delete)
 181   "Save all the mail attachments. With delete argument, remove
 182 the attachement from mail."
 183   (interactive "P")
 184   (let ((vm-mime-delete-after-saving delete))
 185     (while (and (vm-mime-reader-map-save-file)
 186                 (condition-case nil (vm-move-to-next-button 1)
 187                   (error nil)))))
 188   )
 189
 190 (defun ff/vm-mime-save-file (&optional delete)
 191   "Save the current attachement. With delete argument, remove the
 192 attachement from mail."
 193   (interactive "P")
 194   (let ((vm-mime-delete-after-saving delete))
 195     (vm-mime-reader-map-save-file))
 196   (condition-case nil (vm-move-to-next-button 1) (error (message "No more attachment"))))
 197
 198 ;; (define-key vm-summary-mode-map [(r)] 'vm-reply-include-text)
 199 ;; (define-key vm-summary-mode-map [(R)] 'vm-followup-include-text)
 200
 201 (define-key vm-summary-mode-map [(control o)] 'ff/vm-mime-save-file)
 202
 203 (define-key vm-summary-mode-map [(control t)]
 204   (lambda () (interactive)
 205     (vm-toggle-threads-display)
 206     (unless vm-summary-show-threads
 207       (vm-sort-messages "date"))))
 208
 209 (defun ff/vm-select-thread-for-next-command () (interactive)
 210   (vm-mark-thread-subtree)
 211   (vm-next-command-uses-marks))
 212
 213 (define-key vm-summary-mode-map "T" 'ff/vm-select-thread-for-next-command)
 214
 215 (defun ff/vm-attach-file-or-dir
 216   (&optional dir)
 217   "Attaches the file or recursively the content of the directory with
 218 `vm-mime-attach-file'."
 219   (interactive "fFile or directory: ")
 220
 221   (save-excursion
 222     (goto-char (point-max))
 223     (insert "\n")
 224     (if (file-regular-p dir)
 225         (vm-mime-attach-file dir (vm-mime-default-type-from-filename dir))
 226       (if (file-directory-p dir)
 227           (mapcar
 228            (lambda (x)
 229              (when (not (string-match "^\\." (car x)))
 230                (ff/vm-attach-file-or-dir
 231                 (concat dir
 232                         (unless (string-match "/$" dir) "/")
 233                         (car x)))))
 234            (directory-files-and-attributes dir)
 235            )
 236
 237         (error "Can attach only files and directories")
 238         ))))
 239
 240 (define-key vm-mail-mode-map [(control c) (control a)] 'ff/vm-attach-file-or-dir)
 241
 242 ;; Found no other way to avoid displaying the icones
 243 (load "vm-mime")
 244 (defun vm-mime-set-image-stamp-for-type (e type))
 245
 246 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 247 ;; Summary stuff
 248
 249 (defun vm-summary-function-A (message)
 250   (let* ((from (vm-su-from message)))
 251     (if (string-match vm-summary-uninteresting-senders from)
 252         (concat vm-summary-uninteresting-senders-arrow " " (ff/explicit-name (vm-su-to message)))
 253       (ff/explicit-name from))))
 254
 255 (defun vm-summary-function-S (&optional message)
 256   (let ((s (string-to-int (vm-su-byte-count message))))
 257     (if (> s 32768)
 258         (propertize (concat (int-to-string (/ s 1024)) "k") 'face 'bold)
 259       "")))
 260
 261 (defun ff/vm-delete-and-go-down () (interactive)
 262   ;; (vm-goto-message)
 263   (vm-delete-message 1)
 264   (condition-case nil (vm-next-message-no-skip 1) (error nil)))
 265
 266 (add-hook 'vm-quit-hook 'vm-expunge-folder)
 267 (add-hook 'vm-quit-hook 'bbdb-save-db)
 268 (add-hook 'vm-retrieved-spooled-mail-hook 'display-time-update)
 269
 270 (ff/configure-faces '((ff/summary-highlight-face :background "yellow"
 271                                                  ;; :weight 'bold
 272                                                  )))
 273
 274 (setq vm-summary-highlight-face 'ff/summary-highlight-face)
 275
 276 (define-key vm-summary-mode-map [(K)] 'ff/vm-delete-and-go-down)
 277
 278 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 279 ;; Activate the required modes and authorize the commenting
 280
 281 (defun ff/prepare-mail-mode ()
 282   (bbdb-define-all-aliases)
 283   (flyspell-mode)
 284   (auto-fill-mode)
 285   (mail-abbrevs-setup)
 286
 287   ;; (setq fill-paragraph-function 'mail-mode-fill-paragraph)
 288
 289   ;; Since I set the comment prefix, I have to tell the filling
 290   ;; functions not to use it
 291
 292   ;; ******************* removed Aug 23
 293   ;; (setq fill-paragraph-handle-comment nil)
 294   ;; ;; (when message-yank-prefix
 295   (set (make-local-variable 'comment-start) vm-included-text-prefix)
 296   ;; (set (make-local-variable 'comment-start-skip)
 297   ;; (concat "^\\(" (regexp-quote vm-included-text-prefix) "\\)"))
 298   ;; ;; )
 299   )
 300
 301 (add-hook 'mail-mode-hook 'ff/prepare-mail-mode)
 302 ;; (add-hook 'mail-mode-hook 'orgtbl-mode)
 303
 304 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 305 ;; To have a slightly darker background for headers
 306
 307 (ff/configure-faces
 308  '((ff/mail-header-face :background "#c8c8ff"))
 309  )
 310
 311 (defun ff/colorize-headers () (interactive)
 312   (let ((inhibit-read-only t))
 313     (save-excursion
 314       (goto-char (point-min))
 315       (while (vm-match-header)
 316         (goto-char (vm-matched-header-end)))
 317       (add-text-properties
 318        ;; (vm-matched-header-contents-start)
 319        ;; (vm-matched-header-contents-end)
 320        (point-min)
 321        (point-at-bol)
 322        '(face ff/mail-header-face)
 323        )
 324       )))
 325
 326 (defadvice vm-highlight-headers (after ff/colorize-headers nil activate)
 327   (ff/colorize-headers))
 328
 329 (defun ff/highlight-important-words ()
 330   (let ((inhibit-read-only t))
 331     (save-excursion
 332       (goto-char (point-min))
 333       (while (re-search-forward "Fleuret" nil t)
 334         (message "%d-%d"  (match-beginning 0) (match-end 0))
 335         ;; (add-text-properties (match-beginning 0) (match-end 0)
 336                              ;; '(face (:background "red"))
 337                              ;; )
 338         ))
 339     ))
 340
 341 ;; (add-hook 'vm-select-message-hook 'ff/highlight-important-words)
 342
 343 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 344 ;; I want to have a file associated to every mail I am writing
 345
 346 (defcustom ff/vm-mail-draft-directory "~/"
 347   "Where to save mail drafts with VM")
 348
 349 (defun ff/associate-file-to-vm-mail-buffer ()
 350   "Associate the current buffer to a file whose name is built from the current time."
 351   (unless (buffer-file-name)
 352     (set-visited-file-name (format
 353                             "%s/mail-%s"
 354                             ff/vm-mail-draft-directory
 355                             (format-time-string
 356                              "%04Y%02m%02d-%02H%02M%02S"
 357                              (current-time))))
 358     (set-buffer-modified-p nil)))
 359
 360 (add-hook 'mail-setup-hook 'ff/associate-file-to-vm-mail-buffer)
 361
 362 (defun ff/mail-header-field (field) (interactive)
 363   "Grab the value of a certain field from the mail header."
 364   (let ((s "no-subject"))
 365     (save-excursion
 366       (goto-char (point-min))
 367       (let ((l (re-search-forward (concat "^" mail-header-separator "$") nil t)))
 368         (when l
 369           (goto-char (point-min))
 370           (when (re-search-forward (concat "^" field ": ") l t nil)
 371             (setq s (buffer-substring-no-properties (point) (point-at-eol))))
 372           )
 373         )
 374       )
 375     s))
 376
 377 (defun ff/dissociate-file-from-vm-mail-buffer ()
 378   "Save the file under a new name and set the associated file to nil."
 379   (let ((bn (buffer-file-name)))
 380     (when bn
 381       (set-visited-file-name
 382        (concat (file-name-directory bn)
 383                "sent-"
 384                (file-name-nondirectory bn)
 385                "-"
 386                (replace-regexp-in-string "[^a-zA-Z0-9]+" "_"
 387                                          (ff/mail-header-field "Subject"))
 388                ))
 389       (save-buffer)
 390       (set-visited-file-name nil))
 391     )
 392   )
 393
 394 (defun ff/find-file-in-vm-mail-mode (filename) (interactive)
 395   ;; No easy way to activate vm-mail-mode, so we create such a
 396   ;; buffer, erase its content and insert the file
 397   (vm-compose-mail)
 398   (when (file-exists-p filename)
 399     (erase-buffer)
 400     (insert-file filename))
 401   (set-visited-file-name filename)
 402   (set-buffer-modified-p nil)
 403   ;; (run-hooks find-file-hooks)
 404   (when (functionp 'alarm-vc-check) (alarm-vc-check))
 405   ;; Move the cursor at a convenient location
 406   (when (re-search-forward (concat "^" mail-header-separator "$") nil t)
 407     (if (re-search-forward "^-- $" nil t)
 408         (previous-line 1)
 409       (next-line 1))
 410     (end-of-line))
 411   )
 412
 413 ;; All this mess to activate the vm-mail-mode when loading a file
 414 ;; looking like a mail draft. Did I miss something ?
 415
 416 (defadvice find-file (around ff/find-file-or-mail
 417                              (filename &optional wildcards)
 418                              activate)
 419
 420   (interactive "FFind file: \np")
 421
 422   (if (string-match "^\\(mail\\|sent\\)-[^/]+$"
 423                     (file-name-nondirectory filename))
 424
 425       (if (find-buffer-visiting filename)
 426           (switch-to-buffer (find-buffer-visiting filename))
 427         (ff/find-file-in-vm-mail-mode filename))
 428     ad-do-it
 429     ))
 430
 431 (setq ff/vm-mail-draft-directory "~/private/drafts")
 432
 433 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 434 ;; Check there are no missing attachment (the idea comes from
 435 ;; http://home.cc.gatech.edu/eaganj/MailApp) and no leading "From"
 436 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 437
 438 (defcustom ff/check-vm-attachement-regexp "attach"
 439   "*A mail whose body matches this regular expression should contain
 440 an attachment")
 441
 442 (defun ff/check-vm-attachment ()
 443   (when (save-excursion
 444           (goto-char (point-min))
 445           (and (re-search-forward "\\[ATTACHMENT" nil t)
 446                (not (get-text-property (point) 'vm-mime-object))))
 447     (error "Buggy attachment"))
 448
 449   (if (and
 450        (save-excursion (goto-char (point-min))
 451                        (re-search-forward ff/check-vm-attachement-regexp nil t))
 452        (not (save-excursion (goto-char (point-min))
 453                             (re-search-forward "\\[ATTACHMENT" nil t)))
 454        (not (y-or-n-p "An attachment seems to be missing, send message ? ")))
 455       (error "You refer to an unexisting attachment."))
 456
 457   )
 458
 459 ;; You can not have a line starting with "From:" in a pure text
 460 ;; mail. The smtp server would add a leading character to prevent it.
 461
 462 (defun ff/check-no-leading-from ()
 463   (and (let ((case-fold-search nil))
 464          (save-excursion
 465            (goto-char (point-min))
 466            (re-search-forward (concat "^" mail-header-separator "$"))
 467            (re-search-forward "^From " nil t)))
 468        (not (y-or-n-p "There is a leading ``From '', send message ? "))
 469        (error "There is a leading ``From ''.")))
 470
 471 ;; An attempt at limiting excess wording in sent mails
 472
 473 (defface ff/strong-words
 474   '((t (:background "red")))
 475   "The face to highlight upper caps, exclamation marks and such.")
 476
 477 (defun ff/max-in-a-row (overlay regexp max)
 478   (let ((case-fold-search nil))
 479     (save-excursion
 480       (goto-char (point-min))
 481       (re-search-forward (concat "^" mail-header-separator "$"))
 482       (when (and (re-search-forward regexp nil t nil)
 483                  (>= (- (match-end 0) (match-beginning 0)) max))
 484         (move-overlay overlay (match-beginning 0) (match-end 0))
 485         t))))
 486
 487 (defun ff/check-no-excess-wording () (interactive)
 488   (let ((overlay (make-overlay 0 0)))
 489     (overlay-put overlay 'face 'media/current-tune-face)
 490     (let ((err (and
 491                 (or (ff/max-in-a-row overlay "[A-Z\?\!][A-Z\?\! ]+[A-Z\?\!]" 6)
 492                     (ff/max-in-a-row overlay "[\?\!]+" 2)
 493                     )
 494                 (not (y-or-n-p "That does not look good. Send message ? ")))))
 495       (delete-overlay overlay)
 496       (when err (error "Good idea. Chill out a bit.")))
 497     ))
 498
 499 (defun ff/check-badly-encoded-address () (interactive)
 500   (let (bodysep bad-adr)
 501     (save-excursion
 502       (goto-char (point-min))
 503       (search-forward mail-header-separator)
 504       (setq bodysep (vm-marker (match-beginning 0)))
 505       (goto-char (point-min))
 506       (setq bad-adr (re-search-forward "[^<a-zA-Z_0-9\-\. \n\t]+[^ \n]*@" nil t))
 507       (when (and bad-adr (< bad-adr bodysep))
 508         (error "There is an invalid address in the header (%s)"
 509                (match-string 0)))))
 510   )
 511
 512 (add-hook 'vm-mail-send-hook 'ff/check-vm-attachment)
 513 (add-hook 'vm-mail-send-hook 'ff/check-no-leading-from)
 514 (add-hook 'vm-mail-send-hook 'ff/check-no-excess-wording)
 515 (add-hook 'vm-mail-send-hook 'flyspell-mode-off)
 516 ;; Append so that it happens after the mime encoding
 517 ;; (add-hook 'vm-mail-send-hook 'ff/check-badly-encoded-address t)
 518 ;; Append this hook so that it runs after all other checks
 519 (add-hook 'vm-mail-send-hook 'ff/dissociate-file-from-vm-mail-buffer t)
 520
 521 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 522 ;; If we can, encrypt!
 523
 524 ;; (defun ff/encrypt-mail-if-possible () (interactive)
 525 ;; (condition-case nil (mc-encrypt)
 526 ;; (error nil)))
 527
 528 ;; (add-hook 'vm-mail-send-hook 'ff/encrypt-mail-if-possible t)
 529
 530 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 531 ;; Composing a mail
 532
 533 ;; Move through important points in the mail ("To:" field, "Subject:"
 534 ;; field and the end of the body)
 535
 536 (defun ff/goto-next-mail-field () (interactive)
 537   (let ((field (save-excursion
 538                  (end-of-line)
 539                  (re-search-backward (concat "\\(^[a-zA-Z\-]*: \\|^" mail-header-separator "$\\)") nil t)
 540                  (match-string 1))))
 541
 542     (cond ((string= field "To: ")
 543            (expand-abbrev)
 544            (re-search-forward "Subject: ")
 545            (end-of-line))
 546
 547           ((string= field "Subject: ")
 548            (re-search-forward (concat "^" mail-header-separator "$"))
 549            (if (re-search-forward "^-- $" nil t)
 550                (previous-line 1)
 551              (next-line 1))
 552            (end-of-line))
 553
 554           (t (beginning-of-buffer)
 555              (re-search-forward "^To: ")
 556              (end-of-line)
 557              (re-search-forward "^[a-zA-Z\-]*: ")
 558              (beginning-of-line)
 559              (backward-char)))))
 560
 561 ;; (define-key vm-mail-mode-map [(control tab)] 'ff/goto-next-mail-field)
 562 (define-key vm-mail-mode-map [(iso-lefttab)] 'ff/goto-next-mail-field)
 563 ;; (define-key vm-mail-mode-map [(shift iso-lefttab)] 'mail-mode-smart-tab)
 564 (define-key vm-mail-mode-map [(shift iso-lefttab)] 'bbdb-complete-name)
 565
 566 ;; The definition of "\t" is forced through a hook defined in
 567 ;; vm-init.el, so I add mine. This is ugly.
 568
 569 (add-hook 'mail-setup-hook
 570           '(lambda () (local-set-key "\t" 'ff/goto-next-mail-field))
 571           t)
 572
 573 (substitute-key-definition 'next-line 'mail-abbrev-next-line vm-mail-mode-map global-map)
 574 (substitute-key-definition 'end-of-buffer 'mail-abbrev-end-of-buffer vm-mail-mode-map global-map)
 575
 576 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 577 ;; I rarely edit two mails at the same time, and it makes sense to
 578 ;; come back to the one currently being edited with the same function
 579
 580 (defun ff/first-buffer-in-mode (l m)
 581   (if l
 582       (if (eq (save-excursion
 583                 (set-buffer (car l)) major-mode) m)
 584           (car l)
 585         (ff/first-buffer-in-mode (cdr l) m))))
 586
 587 (defun ff/compose-mail (&optional force-new)
 588   "Switch to an existing buffer with major mode `mail-mode',
 589 or invoke `vm-compose-mail' if none can be found or if FORCE-NEW
 590 is t. If already in a mail buffer, burry it and go to the next."
 591   (interactive "P")
 592   (when (eq major-mode 'mail-mode) (bury-buffer))
 593   (let ((buf (and (not force-new)
 594                   (ff/first-buffer-in-mode (buffer-list) 'mail-mode))))
 595     (if buf (switch-to-buffer buf)
 596       (vm-compose-mail))))
 597
 598 (define-key global-map [(control x) (m)] 'ff/compose-mail)
 599
 600 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 601 ;; bbdb
 602
 603 (load "bbdb")
 604 (load "bbdb-hooks")
 605
 606 (when (load "bbdb-vm" t)
 607
 608   ;; (defadvice define-mail-abbrev (before ff/remove-explicit-name (name definition &optional from-mailrc-file) activate)
 609   ;; (message "%s -> %s" name definition))
 610
 611   (defun ff/mail-aliases-from-bbdb ()
 612     "Creates automatically mail aliases from the bbdb records. For
 613 instance, someone in bbdb named \"Paul Smith\" would generate an alias
 614 'pm'. Does not replace existing aliases."
 615     (interactive)
 616     (let* ((records (bbdb-records)))
 617       (while records
 618         (let* ((record (car records))
 619                (name (concat (elt record 0) " " (elt record 1)))
 620                (email (car (elt record 6)))
 621                (alias (downcase (replace-regexp-in-string "\\([a-zA-Z]?\\)[^- ]*[- ]*" "\\1" name))))
 622           (if (and (> (length alias) 1)
 623                    ;; Do not overwrite an existing alias
 624                    (not (and mail-abbrevs (intern-soft alias mail-abbrevs))))
 625               (define-mail-abbrev alias email))
 626           (setq records (cdr records))))))
 627
 628   (when (>= emacs-major-version 22)
 629     (bbdb-insinuate-vm)
 630     (ff/mail-aliases-from-bbdb))
 631   )