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