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 (setq vm-mime-default-face-charsets t)
 158 ;; (add-to-list 'vm-mime-default-face-charsets  "utf-8")
 159
 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)))
 166
 167 (add-to-list 'vm-mime-attachment-auto-type-alist '(".*" . "application/octet-stream") t)
 168
 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"))
 171
 172 ;; (add-to-list 'vm-mime-type-converter-alist
 173 ;; '("text/html" "text/plain"
 174 ;; "w3m -cols 75 -graph -dump -T text/html"
 175 ;; ))
 176
 177 ;; (add-to-list 'vm-mime-type-converter-alist
 178              ;; '("text/html" "text/plain"
 179                ;; "html2text -style pretty -nobs"
 180                ;; ))
 181
 182 ;; (add-to-list 'vm-mime-type-converter-alist
 183              ;; '("text/html" "text/plain"
 184                ;; "html2text.sh"
 185                ;; ))
 186
 187 (add-to-list 'vm-mime-type-converter-alist
 188              '("image" "image/xpm"
 189                "/usr/bin/convert -geometry 640x480 - xpm:-"))
 190
 191 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 192
 193 ;; (defun ff/vm-remove-properties () (interactive)
 194 ;; (save-excursion
 195 ;; (goto-char (point-min))
 196 ;; (re-search-forward (concat "^" mail-header-separator "$"))
 197 ;; (set-text-properties (point) (point-max) nil)
 198 ;; )
 199 ;; )
 200
 201 ;; (add-hook 'vm-mail-send-hook 'ff/vm-remove-properties)
 202
 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."
 206   ;; (interactive "P")
 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)
 210                   ;; (error nil)))))
 211   ;; )
 212
 213 (defun ff/vm-mime-save-file (&optional delete)
 214   "Save the current attachement. With delete argument, remove the
 215 attachement from mail."
 216   (interactive "P")
 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"))))
 220
 221 ;; (define-key vm-summary-mode-map [(r)] 'vm-reply-include-text)
 222 ;; (define-key vm-summary-mode-map [(R)] 'vm-followup-include-text)
 223
 224 (define-key vm-summary-mode-map [(control o)] 'ff/vm-mime-save-file)
 225
 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"))))
 231
 232 (defun ff/vm-select-thread-for-next-command () (interactive)
 233   (vm-mark-thread-subtree)
 234   (vm-next-command-uses-marks))
 235
 236 (define-key vm-summary-mode-map "T" 'ff/vm-select-thread-for-next-command)
 237
 238 (defun ff/vm-attach-file-or-dir
 239   (&optional dir)
 240   "Attaches the file or recursively the content of the directory with
 241 `vm-mime-attach-file'."
 242   (interactive "fFile or directory: ")
 243
 244   (save-excursion
 245     (goto-char (point-max))
 246     (insert "\n")
 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)
 250           (mapcar
 251            (lambda (x)
 252              (when (not (string-match "^\\." (car x)))
 253                (ff/vm-attach-file-or-dir
 254                 (concat dir
 255                         (unless (string-match "/$" dir) "/")
 256                         (car x)))))
 257            (directory-files-and-attributes dir)
 258            )
 259
 260         (error "Can attach only files and directories")
 261         ))))
 262
 263 (define-key vm-mail-mode-map [(control c) (control a)] 'ff/vm-attach-file-or-dir)
 264
 265 ;; Found no other way to avoid displaying the icones
 266 (load "vm-mime")
 267 (defun vm-mime-set-image-stamp-for-type (e type))
 268
 269 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 270 ;; Summary stuff
 271
 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))))
 277
 278 (defun vm-summary-function-S (&optional message)
 279   (let ((s (string-to-int (vm-su-byte-count message))))
 280     (if (> s 32768)
 281         (propertize (concat (int-to-string (/ s 1024)) "k")
 282                     'face 'italic
 283                     )
 284       "")))
 285
 286 (defun ff/vm-delete-and-go-down () (interactive)
 287   ;; (vm-goto-message)
 288   (vm-delete-message 1)
 289   (condition-case nil (vm-next-message-no-skip 1) (error nil)))
 290
 291 (defun ff/vm-expunge-folder ()
 292   (unless vm-folder-read-only (vm-expunge-folder)))
 293
 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)
 297
 298 (ff/configure-faces '((ff/summary-highlight-face :background "yellow"
 299                                                  ;; :weight 'bold
 300                                                  )))
 301
 302 (setq vm-summary-highlight-face 'ff/summary-highlight-face)
 303
 304 (define-key vm-summary-mode-map [(K)] 'ff/vm-delete-and-go-down)
 305
 306 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 307 ;; Activate the required modes and authorize the commenting
 308
 309 (defun ff/prepare-mail-mode ()
 310   (bbdb-define-all-aliases)
 311   (flyspell-mode)
 312   (auto-fill-mode)
 313   (mail-abbrevs-setup)
 314
 315   ;; (setq fill-paragraph-function 'mail-mode-fill-paragraph)
 316
 317   ;; Since I set the comment prefix, I have to tell the filling
 318   ;; functions not to use it
 319
 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) "\\)"))
 326   ;; ;; )
 327   )
 328
 329 (add-hook 'mail-mode-hook 'ff/prepare-mail-mode)
 330 ;; (add-hook 'mail-mode-hook 'orgtbl-mode)
 331
 332 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 333 ;; To have a slightly darker background for headers
 334
 335 (ff/configure-faces
 336  ;; '((ff/mail-header-face :background "#c8c8ff"))
 337  '((ff/mail-header-face :foreground "blue4"))
 338  )
 339
 340 (defun ff/colorize-headers () (interactive)
 341   (let ((inhibit-read-only t))
 342     (save-excursion
 343       (goto-char (point-min))
 344       (while (vm-match-header)
 345         (goto-char (vm-matched-header-end)))
 346       (add-text-properties
 347        ;; (vm-matched-header-contents-start)
 348        ;; (vm-matched-header-contents-end)
 349        (point-min)
 350        (point-at-bol)
 351        '(face ff/mail-header-face)
 352        )
 353       )))
 354
 355 (defadvice vm-highlight-headers (after ff/colorize-headers nil activate)
 356   (ff/colorize-headers))
 357
 358 (defun ff/highlight-important-words ()
 359   (let ((inhibit-read-only t))
 360     (save-excursion
 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"))
 366                              ;; )
 367         ))
 368     ))
 369
 370 ;; (add-hook 'vm-select-message-hook 'ff/highlight-important-words)
 371
 372 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 373 ;; I want to have a file associated to every mail I am writing
 374
 375 (defcustom ff/vm-mail-draft-directory "~/"
 376   "Where to save mail drafts with VM")
 377
 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
 382                             "%s/mail-%s"
 383                             ff/vm-mail-draft-directory
 384                             (format-time-string
 385                              "%04Y%02m%02d-%02H%02M%02S"
 386                              (current-time))))
 387     (set-buffer-modified-p nil)))
 388
 389 (add-hook 'mail-setup-hook 'ff/associate-file-to-vm-mail-buffer)
 390
 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"))
 394     (save-excursion
 395       (goto-char (point-min))
 396       (let ((l (re-search-forward (concat "^" mail-header-separator "$") nil t)))
 397         (when l
 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))))
 401           )
 402         )
 403       )
 404     s))
 405
 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)))
 409     (when bn
 410       (set-visited-file-name
 411        (concat (file-name-directory bn)
 412                "sent-"
 413                (file-name-nondirectory bn)
 414                "-"
 415                (replace-regexp-in-string "[^a-zA-Z0-9]+" "_"
 416                                          (ff/mail-header-field "Subject"))
 417                ))
 418       (save-buffer)
 419       (set-visited-file-name nil))
 420     )
 421   )
 422
 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
 426   (vm-compose-mail)
 427   (when (file-exists-p filename)
 428     (erase-buffer)
 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)
 437         (previous-line 1)
 438       (next-line 1))
 439     (end-of-line))
 440   )
 441
 442 ;; All this mess to activate the vm-mail-mode when loading a file
 443 ;; looking like a mail draft. Did I miss something ?
 444
 445 (defadvice find-file (around ff/find-file-or-mail
 446                              (filename &optional wildcards)
 447                              activate)
 448
 449   (interactive "FFind file: \np")
 450
 451   (if (string-match "^\\(mail\\|sent\\)-[^/]+$"
 452                     (file-name-nondirectory filename))
 453
 454       (if (find-buffer-visiting filename)
 455           (switch-to-buffer (find-buffer-visiting filename))
 456         (ff/find-file-in-vm-mail-mode filename))
 457     ad-do-it
 458     ))
 459
 460 (setq ff/vm-mail-draft-directory "~/private/drafts")
 461
 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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 466
 467 (defcustom ff/check-vm-attachement-regexp "attach"
 468   "*A mail whose body matches this regular expression should contain
 469 an attachment")
 470
 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"))
 477
 478   (if (and
 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."))
 485
 486   )
 487
 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.
 490
 491 (defun ff/check-no-leading-from ()
 492   (and (let ((case-fold-search nil))
 493          (save-excursion
 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 ''.")))
 499
 500 ;; An attempt at limiting excess wording in sent mails
 501
 502 (defface ff/strong-words
 503   '((t (:background "red")))
 504   "The face to highlight upper caps, exclamation marks and such.")
 505
 506 (defun ff/max-in-a-row (overlay regexp max)
 507   (let ((case-fold-search nil))
 508     (save-excursion
 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))
 514         t))))
 515
 516 (defun ff/check-no-excess-wording () (interactive)
 517   (let ((overlay (make-overlay 0 0)))
 518     (overlay-put overlay 'face 'media/current-tune-face)
 519     (let ((err (and
 520                 (or (ff/max-in-a-row overlay "[A-Z\?\!][A-Z\?\! ]+[A-Z\?\!]" 6)
 521                     (ff/max-in-a-row overlay "[\?\!]+" 2)
 522                     )
 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.")))
 526     ))
 527
 528 (defun ff/check-badly-encoded-address () (interactive)
 529   (let (bodysep bad-adr)
 530     (save-excursion
 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)"
 538                (match-string 0)))))
 539   )
 540
 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)
 549
 550 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 551 ;; If we can, encrypt!
 552
 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)
 557
 558 ;; (defun ff/encrypt-mail-if-possible () (interactive)
 559 ;; (condition-case nil (mc-encrypt)
 560 ;; (error nil)))
 561
 562 ;; (add-hook 'vm-mail-send-hook 'ff/encrypt-mail-if-possible t)
 563
 564 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 565 ;; Composing a mail
 566
 567 ;; Move through important points in the mail ("To:" field, "Subject:"
 568 ;; field and the end of the body)
 569
 570 (defun ff/goto-next-mail-field () (interactive)
 571   (let ((field (save-excursion
 572                  (end-of-line)
 573                  (re-search-backward (concat "\\(^[a-zA-Z\-]*: \\|^" mail-header-separator "$\\)") nil t)
 574                  (match-string 1))))
 575
 576     (cond ((string= field "To: ")
 577            (expand-abbrev)
 578            (re-search-forward "Subject: ")
 579            (end-of-line))
 580
 581           ((string= field "Subject: ")
 582            (re-search-forward (concat "^" mail-header-separator "$"))
 583            (if (re-search-forward "^-- $" nil t)
 584                (previous-line 1)
 585              (next-line 1))
 586            (end-of-line))
 587
 588           (t (beginning-of-buffer)
 589              (re-search-forward "^To: ")
 590              (end-of-line)
 591              (re-search-forward "^[a-zA-Z\-]*: ")
 592              (beginning-of-line)
 593              (backward-char)))))
 594
 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)
 599
 600 ;; The definition of "\t" is forced through a hook defined in
 601 ;; vm-init.el, so I add mine. This is ugly.
 602
 603 (add-hook 'mail-setup-hook
 604           '(lambda () (local-set-key "\t" 'ff/goto-next-mail-field))
 605           t)
 606
 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)
 609
 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
 613
 614 (defun ff/first-buffer-in-mode (l m)
 615   (if l
 616       (if (eq (save-excursion
 617                 (set-buffer (car l)) major-mode) m)
 618           (car l)
 619         (ff/first-buffer-in-mode (cdr l) m))))
 620
 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
 624 is t."
 625   (interactive "P")
 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)
 630       (vm-compose-mail))))
 631
 632 (define-key global-map [(control x) (m)] 'ff/compose-mail)
 633
 634 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 635 ;; bbdb
 636
 637 (load "bbdb")
 638 (load "bbdb-hooks")
 639
 640 (when (load "bbdb-vm" t)
 641
 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."
 646     (interactive)
 647     (let* ((records (bbdb-records)))
 648       (while 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))))))
 659
 660   (when (>= emacs-major-version 22)
 661     (bbdb-insinuate-vm)
 662     (ff/mail-aliases-from-bbdb))
 663   )