X-Git-Url: https://www.fleuret.org/cgi-bin/gitweb/gitweb.cgi?p=elisp.git;a=blobdiff_plain;f=vm;h=49104acde1c3bd84968b5d44f4f604ed1198ea2e;hp=8e254894c6bea93aec2afc3b84a0ee3667792d4c;hb=HEAD;hpb=0600e35543a1f991515a6c42a6bf1cdb4e8eaf4e

diff --git a/vm b/vm
index 8e25489..49104ac 100644
--- a/vm
+++ b/vm
@@ -17,6 +17,40 @@
 ;; Contact <francois@fleuret.org> for comments & bug reports             ;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; A fast indexed / search in mbox
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; This is one of my own things, check my web page to get it
+
+(when (ff/load-or-alert "~/sources/gpl/mymail/mymail-vm.el")
+
+  (define-key vm-summary-mode-map "\\" 'mymail/vm-visit-folder)
+  (define-key global-map [S-f7] 'mymail/vm-visit-folder)
+  (setq mymail/default-search-request "today"
+        mymail/default-additional-search-requests "!s ^\\[SPAM\\],!s \\] STATUS,")
+  (add-to-list 'recentf-exclude "/tmp/mymail-vm-.*\.mbox")
+  )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Store and restore the window configuration
+
+(setq ff/window-configuration-before-vm nil)
+
+(defadvice vm (before ff/store-window-configuration nil activate)
+  (unless ff/window-configuration-before-vm
+    (setq ff/window-configuration-before-vm (current-window-configuration)))
+  )
+
+(defadvice vm-quit (after ff/restore-window-configuration nil activate)
+  (when ff/window-configuration-before-vm
+    (set-window-configuration ff/window-configuration-before-vm)
+    (setq ff/window-configuration-before-vm nil)
+    )
+  )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (setq-default vm-summary-show-threads t)
 
 ;; (setq vm-preview-lines nil)
@@ -35,60 +69,60 @@
 
 
 (setq
-      ;; browse-url-mozilla-program "iceweasel"
-      ;; mail-complete-style nil
-      ;; mail-from-style nil
-      ;; vm-coding-system-priorities '(utf-8)
-      ;; vm-highlighted-header-regexp "From:\\|Subject:\\|Cc:\\|To:\\|Bcc:\\|Reply-To:"
-      ;; vm-included-text-attribution-format "\nOn %w, %m %d, at %H, you wrote:\n\n"
-      ;; vm-jump-to-new-messages nil
-      ;; vm-mime-7bit-composition-charset "latin-1"
-      ;; vm-mime-8bit-composition-charset "utf-8"
-      ;; vm-preview-read-messages t
-      ;; vm-summary-format " %*%A %-3.3m %2d %5US %I%UA  %s\n"
-      ;; vm-summary-uninteresting-senders-arrow "->"
-      ;; vm-summary-uninteresting-senders-arrow "►"
-      ;; vm-summary-uninteresting-senders-arrow "➔"
-      ;; vm-summary-uninteresting-senders-arrow "➤"
-      bbdb-send-mail-style 'vm
-      bbdb/mail-auto-create-p nil
-      mail-signature t
-      mail-specify-envelope-from t
-      vm-auto-folder-case-fold-search t
-      vm-auto-get-new-mail t
-      vm-circular-folders nil
-      vm-confirm-new-folders t
-      vm-delete-after-archiving t
-      vm-delete-after-saving t
-      vm-forwarding-digest-type "mime"
-      vm-forwarding-subject-format "(forwarded from %F) %s"
-      vm-frame-per-folder nil
-      vm-frame-per-summary nil
-      vm-highlighted-header-regexp "From:\\|Subject:\\|Reply-To:"
-      vm-in-reply-to-format nil
-      vm-included-text-attribution-format "\nOn %w, %m %d, %y (%h), %F wrote:\n\n"
-      vm-included-text-prefix " > "
-      vm-keep-sent-messages nil
-      vm-mime-8bit-composition-charset "iso-8859-1"
-      vm-mime-attachment-save-directory "~/misc/attachments"
-      vm-mime-yank-attachments nil
-      vm-mutable-frames nil
-      vm-mutable-windows t
-      vm-netscape-program browse-url-mozilla-program
-      vm-preview-lines nil
-      vm-reply-subject-prefix "Re: "
-      vm-skip-deleted-messages nil
-      vm-skip-read-messages nil
-      vm-startup-message-displayed t
-      vm-startup-with-summary t
-      vm-summary-arrow "> "
-      vm-summary-format " %*%a %-3.3m %2d %5US %I%UA  %s\n"
-      vm-summary-thread-indent-level 1
-      vm-summary-uninteresting-senders-arrow ">"
-      vm-use-menus nil
-      vm-use-toolbar nil
-      vm-use-toolbar nil
-      )
+ ;; browse-url-mozilla-program "iceweasel"
+ ;; mail-complete-style nil
+ ;; mail-from-style nil
+ ;; vm-coding-system-priorities '(utf-8)
+ ;; vm-highlighted-header-regexp "From:\\|Subject:\\|Cc:\\|To:\\|Bcc:\\|Reply-To:"
+ ;; vm-included-text-attribution-format "\nOn %w, %m %d, at %H, you wrote:\n\n"
+ ;; vm-jump-to-new-messages nil
+ ;; vm-mime-7bit-composition-charset "latin-1"
+ ;; vm-mime-8bit-composition-charset "utf-8"
+ ;; vm-preview-read-messages t
+ ;; vm-summary-format " %*%A %-3.3m %2d %5US %I%UA  %s\n"
+ ;; vm-summary-uninteresting-senders-arrow "->"
+ ;; vm-summary-uninteresting-senders-arrow "►"
+ ;; vm-summary-uninteresting-senders-arrow "➔"
+ ;; vm-summary-uninteresting-senders-arrow "➤"
+ bbdb-send-mail-style 'vm
+ bbdb/mail-auto-create-p nil
+ mail-signature t
+ mail-specify-envelope-from t
+ vm-auto-folder-case-fold-search t
+ vm-auto-get-new-mail t
+ vm-circular-folders nil
+ vm-confirm-new-folders t
+ vm-delete-after-archiving t
+ vm-delete-after-saving t
+ vm-forwarding-digest-type "mime"
+ vm-forwarding-subject-format "(forwarded from %F) %s"
+ vm-frame-per-folder nil
+ vm-frame-per-summary nil
+ vm-highlighted-header-regexp "From:\\|Subject:\\|Reply-To:"
+ vm-in-reply-to-format nil
+ vm-included-text-attribution-format "\nOn %w, %m %d, %y (%h), %F wrote:\n\n"
+ vm-included-text-prefix " > "
+ vm-keep-sent-messages nil
+ vm-mime-8bit-composition-charset "iso-8859-1"
+ vm-mime-attachment-save-directory "~/misc/attachments"
+ vm-mime-yank-attachments nil
+ vm-mutable-frames nil
+ vm-mutable-windows t
+ vm-netscape-program browse-url-mozilla-program
+ vm-preview-lines nil
+ vm-reply-subject-prefix "Re: "
+ vm-skip-deleted-messages nil
+ vm-skip-read-messages nil
+ vm-startup-message-displayed t
+ vm-startup-with-summary t
+ vm-summary-arrow "> "
+ vm-summary-format " %*%a %-3.3m %2d %5US %I%UA  %s\n"
+ vm-summary-thread-indent-level 1
+ vm-summary-uninteresting-senders-arrow ">"
+ vm-use-menus nil
+ vm-use-toolbar nil
+ vm-use-toolbar nil
+ )
 
 ;; (add-to-list 'vm-visible-headers "From " t)
 (add-to-list 'vm-visible-headers "Reply-To:" t)
@@ -148,6 +182,7 @@
 ;; (add-to-list 'vm-mime-default-face-charsets "iso-8859-1")
 ;; (add-to-list 'vm-mime-default-face-charsets "Windows-1251")
 ;; (add-hook 'vm-mail-send-hook 'ff/vm-remove-non-7bits-in-headers)
+
 (add-hook 'vm-mail-send-hook 'vm-mime-encode-headers)
 (add-hook 'vm-mail-send-hook 'vm-mail-check-recipients)
 (add-hook 'vm-reply-hook (lambda () (set-buffer-modified-p nil)))
@@ -163,14 +198,14 @@
 ;; ))
 
 ;; (add-to-list 'vm-mime-type-converter-alist
-             ;; '("text/html" "text/plain"
-               ;; "html2text -style pretty -nobs"
-               ;; ))
+;; '("text/html" "text/plain"
+;; "html2text -style pretty -nobs"
+;; ))
 
 ;; (add-to-list 'vm-mime-type-converter-alist
-             ;; '("text/html" "text/plain"
-               ;; "html2text.sh"
-               ;; ))
+;; '("text/html" "text/plain"
+;; "html2text.sh"
+;; ))
 
 (add-to-list 'vm-mime-type-converter-alist
              '("image" "image/xpm"
@@ -189,14 +224,14 @@
 ;; (add-hook 'vm-mail-send-hook 'ff/vm-remove-properties)
 
 ;; (defun ff/vm-mime-save-all-files (&optional delete)
-  ;; "Save all the mail attachments. With delete argument, remove
+;; "Save all the mail attachments. With delete argument, remove
 ;; the attachement from mail."
-  ;; (interactive "P")
-  ;; (let ((vm-mime-delete-after-saving delete))
-    ;; (while (and (vm-mime-reader-map-save-file)
-                ;; (condition-case nil (vm-move-to-next-button 1)
-                  ;; (error nil)))))
-  ;; )
+;; (interactive "P")
+;; (let ((vm-mime-delete-after-saving delete))
+;; (while (and (vm-mime-reader-map-save-file)
+;; (condition-case nil (vm-move-to-next-button 1)
+;; (error nil)))))
+;; )
 
 (defun ff/vm-mime-save-file (&optional delete)
   "Save the current attachement. With delete argument, remove the
@@ -218,13 +253,13 @@ attachement from mail."
       (vm-sort-messages "date"))))
 
 (defun ff/vm-select-thread-for-next-command () (interactive)
-  (vm-mark-thread-subtree)
-  (vm-next-command-uses-marks))
+       (vm-mark-thread-subtree)
+       (vm-next-command-uses-marks))
 
 (define-key vm-summary-mode-map "T" 'ff/vm-select-thread-for-next-command)
 
 (defun ff/vm-attach-file-or-dir
-  (&optional dir)
+    (&optional dir)
   "Attaches the file or recursively the content of the directory with
 `vm-mime-attach-file'."
   (interactive "fFile or directory: ")
@@ -272,9 +307,9 @@ attachement from mail."
       "")))
 
 (defun ff/vm-delete-and-go-down () (interactive)
-  ;; (vm-goto-message)
-  (vm-delete-message 1)
-  (condition-case nil (vm-next-message-no-skip 1) (error nil)))
+       ;; (vm-goto-message)
+       (vm-delete-message 1)
+       (condition-case nil (vm-next-message-no-skip 1) (error nil)))
 
 (defun ff/vm-expunge-folder ()
   (unless vm-folder-read-only (vm-expunge-folder)))
@@ -294,51 +329,49 @@ attachement from mail."
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Activate the required modes and authorize the commenting
 
+(defun ff/does-not-fill (&optional a b) (interactive) (message "Nope"))
+
 (defun ff/prepare-mail-mode ()
   (bbdb-define-all-aliases)
   (flyspell-mode)
-  (auto-fill-mode)
   (mail-abbrevs-setup)
+  (yas/minor-mode)
 
-  ;; (setq fill-paragraph-function 'mail-mode-fill-paragraph)
+  ;; Let's try the visual-line mode for mails
 
-  ;; Since I set the comment prefix, I have to tell the filling
-  ;; functions not to use it
+  (auto-fill-mode)
+  ;; (setq fill-paragraph-function 'ff/does-not-fill)
+  ;; (visual-line-mode)
 
-  ;; ******************* removed Aug 23
-  ;; (setq fill-paragraph-handle-comment nil)
-  ;; ;; (when message-yank-prefix
   (set (make-local-variable 'comment-start) vm-included-text-prefix)
-  ;; (set (make-local-variable 'comment-start-skip)
-  ;; (concat "^\\(" (regexp-quote vm-included-text-prefix) "\\)"))
-  ;; ;; )
   )
 
 (add-hook 'mail-mode-hook 'ff/prepare-mail-mode)
-;; (add-hook 'mail-mode-hook 'orgtbl-mode)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; To have a slightly darker background for headers
 
 (ff/configure-faces
  ;; '((ff/mail-header-face :background "#c8c8ff"))
- '((ff/mail-header-face :foreground "blue4"))
+ '((ff/mail-header-face :background "#eaf0ff"))
+ ;; '((ff/mail-header-face :background "#fff0a0"))
+ ;; '((ff/mail-header-face :foreground "blue4"))
  )
 
 (defun ff/colorize-headers () (interactive)
-  (let ((inhibit-read-only t))
-    (save-excursion
-      (goto-char (point-min))
-      (while (vm-match-header)
-        (goto-char (vm-matched-header-end)))
-      (add-text-properties
-       ;; (vm-matched-header-contents-start)
-       ;; (vm-matched-header-contents-end)
-       (point-min)
-       (point-at-bol)
-       '(face ff/mail-header-face)
-       )
-      )))
+       (let ((inhibit-read-only t))
+         (save-excursion
+           (goto-char (point-min))
+           (while (vm-match-header)
+             (goto-char (vm-matched-header-end)))
+           (add-text-properties
+            ;; (vm-matched-header-contents-start)
+            ;; (vm-matched-header-contents-end)
+            (point-min)
+            (point-at-bol)
+            '(face ff/mail-header-face)
+            )
+           )))
 
 (defadvice vm-highlight-headers (after ff/colorize-headers nil activate)
   (ff/colorize-headers))
@@ -350,8 +383,8 @@ attachement from mail."
       (while (re-search-forward "Fleuret" nil t)
         (message "%d-%d"  (match-beginning 0) (match-end 0))
         ;; (add-text-properties (match-beginning 0) (match-end 0)
-                             ;; '(face (:background "red"))
-                             ;; )
+        ;; '(face (:background "red"))
+        ;; )
         ))
     ))
 
@@ -377,19 +410,19 @@ attachement from mail."
 (add-hook 'mail-setup-hook 'ff/associate-file-to-vm-mail-buffer)
 
 (defun ff/mail-header-field (field) (interactive)
-  "Grab the value of a certain field from the mail header."
-  (let ((s "no-subject"))
-    (save-excursion
-      (goto-char (point-min))
-      (let ((l (re-search-forward (concat "^" mail-header-separator "$") nil t)))
-        (when l
-          (goto-char (point-min))
-          (when (re-search-forward (concat "^" field ": ") l t nil)
-            (setq s (buffer-substring-no-properties (point) (point-at-eol))))
-          )
-        )
-      )
-    s))
+       "Grab the value of a certain field from the mail header."
+       (let ((s "no-subject"))
+         (save-excursion
+           (goto-char (point-min))
+           (let ((l (re-search-forward (concat "^" mail-header-separator "$") nil t)))
+             (when l
+               (goto-char (point-min))
+               (when (re-search-forward (concat "^" field ": ") l t nil)
+                 (setq s (buffer-substring-no-properties (point) (point-at-eol))))
+               )
+             )
+           )
+         s))
 
 (defun ff/dissociate-file-from-vm-mail-buffer ()
   "Save the file under a new name and set the associated file to nil."
@@ -409,23 +442,23 @@ attachement from mail."
   )
 
 (defun ff/find-file-in-vm-mail-mode (filename) (interactive)
-  ;; No easy way to activate vm-mail-mode, so we create such a
-  ;; buffer, erase its content and insert the file
-  (vm-compose-mail)
-  (when (file-exists-p filename)
-    (erase-buffer)
-    (insert-file filename))
-  (set-visited-file-name filename)
-  (set-buffer-modified-p nil)
-  ;; (run-hooks find-file-hooks)
-  (when (functionp 'alarm-vc-check) (alarm-vc-check))
-  ;; Move the cursor at a convenient location
-  (when (re-search-forward (concat "^" mail-header-separator "$") nil t)
-    (if (re-search-forward "^-- $" nil t)
-        (previous-line 1)
-      (next-line 1))
-    (end-of-line))
-  )
+       ;; No easy way to activate vm-mail-mode, so we create such a
+       ;; buffer, erase its content and insert the file
+       (vm-compose-mail)
+       (when (file-exists-p filename)
+         (erase-buffer)
+         (insert-file filename))
+       (set-visited-file-name filename)
+       (set-buffer-modified-p nil)
+       ;; (run-hooks find-file-hooks)
+       (when (functionp 'alarm-vc-check) (alarm-vc-check))
+       ;; Move the cursor at a convenient location
+       (when (re-search-forward (concat "^" mail-header-separator "$") nil t)
+         (if (re-search-forward "^-- $" nil t)
+             (previous-line 1)
+           (next-line 1))
+         (end-of-line))
+       )
 
 ;; All this mess to activate the vm-mail-mode when loading a file
 ;; looking like a mail draft. Did I miss something ?
@@ -473,6 +506,20 @@ an attachment")
 
   )
 
+(defun ff/check-no-prolematic-dest ()
+  "Check that there are no \">,[^\ $]\" in the header"
+  (let ((s "no-subject"))
+    (save-excursion
+      (goto-char (point-min))
+      (let ((end-header (re-search-forward (concat "^" mail-header-separator "$") nil t)))
+        (when end-header
+          (goto-char (point-min))
+          (re-search-forward ">,[^\ ]" end-header t nil)
+          )
+        )
+      )
+    s))
+
 ;; You can not have a line starting with "From:" in a pure text
 ;; mail. The smtp server would add a leading character to prevent it.
 
@@ -502,49 +549,58 @@ an attachment")
         t))))
 
 (defun ff/check-no-excess-wording () (interactive)
-  (let ((overlay (make-overlay 0 0)))
-    (overlay-put overlay 'face 'media/current-tune-face)
-    (let ((err (and
-                (or (ff/max-in-a-row overlay "[A-Z\?\!][A-Z\?\! ]+[A-Z\?\!]" 6)
-                    (ff/max-in-a-row overlay "[\?\!]+" 2)
-                    )
-                (not (y-or-n-p "That does not look good. Send message ? ")))))
-      (delete-overlay overlay)
-      (when err (error "Good idea. Chill out a bit.")))
-    ))
+       (let ((overlay (make-overlay 0 0)))
+         (overlay-put overlay 'face 'media/current-tune-face)
+         (let ((err (and
+                     (or (ff/max-in-a-row overlay "[A-Z\?\!][A-Z\?\! ]+[A-Z\?\!]" 6)
+                         (ff/max-in-a-row overlay "[\?\!]+" 2)
+                         )
+                     (not (y-or-n-p "That does not look good. Send message ? ")))))
+           (delete-overlay overlay)
+           (when err (error "Good idea. Chill out a bit.")))
+         ))
 
 (defun ff/check-badly-encoded-address () (interactive)
-  (let (bodysep bad-adr)
-    (save-excursion
-      (goto-char (point-min))
-      (search-forward mail-header-separator)
-      (setq bodysep (vm-marker (match-beginning 0)))
-      (goto-char (point-min))
-      (setq bad-adr (re-search-forward "[^<a-zA-Z_0-9\-\. \n\t]+[^ \n]*@" nil t))
-      (when (and bad-adr (< bad-adr bodysep))
-        (error "There is an invalid address in the header (%s)"
-               (match-string 0)))))
-  )
+       (let (bodysep bad-adr)
+         (save-excursion
+           (goto-char (point-min))
+           (search-forward mail-header-separator)
+           (setq bodysep (vm-marker (match-beginning 0)))
+           (goto-char (point-min))
+           (setq bad-adr (re-search-forward "[^<a-zA-Z_0-9\-\. \n\t]+[^ \n]*@" nil t))
+           (when (and bad-adr (< bad-adr bodysep))
+             (error "There is an invalid address in the header (%s)"
+                    (match-string 0)))))
+       )
 
 (add-hook 'vm-mail-send-hook 'ff/check-vm-attachment)
 (add-hook 'vm-mail-send-hook 'ff/check-no-leading-from)
 (add-hook 'vm-mail-send-hook 'ff/check-no-excess-wording)
 (add-hook 'vm-mail-send-hook 'flyspell-mode-off)
+
+(defadvice vm-mail-send-and-exit (before ff/switch-flyspell-off nil activate)
+  (flyspell-mode-off))
+
 ;; Append so that it happens after the mime encoding
 ;; (add-hook 'vm-mail-send-hook 'ff/check-badly-encoded-address t)
+
 ;; Append this hook so that it runs after all other checks
 (add-hook 'vm-mail-send-hook 'ff/dissociate-file-from-vm-mail-buffer t)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; If we can, encrypt!
 
-(add-hook 'vm-mode-hook 'mc-install-read-mode)
-(add-hook 'vm-summary-mode-hook 'mc-install-read-mode)
-(add-hook 'vm-virtual-mode-hook 'mc-install-read-mode)
-(add-hook 'vm-mail-mode-hook 'mc-install-write-mode)
+;; (autoload 'mc-install-write-mode "mailcrypt" nil t)
+;; (autoload 'mc-install-read-mode "mailcrypt" nil t)
+
+;; (add-hook 'vm-mode-hook 'mc-install-read-mode)
+;; (add-hook 'vm-summary-mode-hook 'mc-install-read-mode)
+;; (add-hook 'vm-virtual-mode-hook 'mc-install-read-mode)
+;; (add-hook 'vm-mail-mode-hook 'mc-install-write-mode)
+;; (add-hook 'vm-presentation-mode-hook 'mc-install-read-mode)
 
 ;; (defun ff/encrypt-mail-if-possible () (interactive)
-;; (condition-case nil (mc-encrypt)
+;; (condition-case nil (mc-encrypt-message)
 ;; (error nil)))
 
 ;; (add-hook 'vm-mail-send-hook 'ff/encrypt-mail-if-possible t)
@@ -556,35 +612,49 @@ an attachment")
 ;; field and the end of the body)
 
 (defun ff/goto-next-mail-field () (interactive)
-  (let ((field (save-excursion
-                 (end-of-line)
-                 (re-search-backward (concat "\\(^[a-zA-Z\-]*: \\|^" mail-header-separator "$\\)") nil t)
-                 (match-string 1))))
-
-    (cond ((string= field "To: ")
-           (expand-abbrev)
-           (re-search-forward "Subject: ")
-           (end-of-line))
-
-          ((string= field "Subject: ")
-           (re-search-forward (concat "^" mail-header-separator "$"))
-           (if (re-search-forward "^-- $" nil t)
-               (previous-line 1)
-             (next-line 1))
-           (end-of-line))
-
-          (t (beginning-of-buffer)
-             (re-search-forward "^To: ")
-             (end-of-line)
-             (re-search-forward "^[a-zA-Z\-]*: ")
-             (beginning-of-line)
-             (backward-char)))))
+       (let ((field (save-excursion
+                      (end-of-line)
+                      (re-search-backward
+                       (concat "\\(^[a-zA-Z\-]*: \\|^" mail-header-separator "$\\)") nil t)
+                      (match-string 1))))
+
+         (cond ((string= field "To: ")
+                (expand-abbrev)
+                (re-search-forward "Subject: ")
+                (end-of-line))
+
+               ((string= field "Subject: ")
+                (re-search-forward (concat "^" mail-header-separator "$"))
+                (if (re-search-forward "^-- $" nil t)
+                    (previous-line 1)
+                  (next-line 1))
+                (end-of-line))
+
+               (t (beginning-of-buffer)
+                  (re-search-forward "^To: ")
+                  (end-of-line)
+                  (re-search-forward "^[a-zA-Z\-]*: ")
+                  (beginning-of-line)
+                  (backward-char)))))
 
 ;; (define-key vm-mail-mode-map [(control tab)] 'ff/goto-next-mail-field)
 (define-key vm-mail-mode-map [(iso-lefttab)] 'ff/goto-next-mail-field)
 ;; (define-key vm-mail-mode-map [(shift iso-lefttab)] 'mail-mode-smart-tab)
 (define-key vm-mail-mode-map [(shift iso-lefttab)] 'bbdb-complete-name)
 
+(defun ff/kill-to-signature () (interactive)
+       (save-excursion
+         (delete-region
+          (point)
+          (progn
+            (search-forward-regexp "^-- *$")
+            (- (match-beginning 0) 1))
+          )
+         )
+       )
+
+(define-key vm-mail-mode-map [(control c) (k)] 'ff/kill-to-signature)
+
 ;; The definition of "\t" is forced through a hook defined in
 ;; vm-init.el, so I add mine. This is ugly.
 
@@ -593,6 +663,7 @@ an attachment")
           t)
 
 (substitute-key-definition 'next-line 'mail-abbrev-next-line vm-mail-mode-map global-map)
+
 (substitute-key-definition 'end-of-buffer 'mail-abbrev-end-of-buffer vm-mail-mode-map global-map)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -601,18 +672,21 @@ an attachment")
 
 (defun ff/first-buffer-in-mode (l m)
   (if l
-      (if (eq (save-excursion
-                (set-buffer (car l)) major-mode) m)
+      (if (eq
+           ;; (save-excursion (set-buffer (car l)) major-mode)
+           (with-current-buffer (car l) major-mode)
+           m)
           (car l)
         (ff/first-buffer-in-mode (cdr l) m))))
 
 (defun ff/compose-mail (&optional force-new)
-  "Cycles through an existing buffers with major mode `mail-mode',
+  "Cycles through existing buffers with major mode `mail-mode',
 or invoke `vm-compose-mail' if none can be found or if FORCE-NEW
 is t."
   (interactive "P")
   (when (eq major-mode 'mail-mode) (bury-buffer))
   (let ((buf (and (not force-new)
+                  ;; (not (eq major-mode 'mail-mode))
                   (ff/first-buffer-in-mode (buffer-list) 'mail-mode))))
     (if buf (switch-to-buffer buf)
       (vm-compose-mail))))
@@ -623,7 +697,7 @@ is t."
 ;; bbdb
 
 (load "bbdb")
-(load "bbdb-hooks")
+;; (load "bbdb-hooks")
 
 (when (load "bbdb-vm" t)
 
@@ -639,7 +713,8 @@ instance, someone in bbdb named \"Paul Smith\" would generate an alias
                (email (car (elt record 6)))
                (alias (downcase (replace-regexp-in-string
                                  "\\([a-zA-Z]?\\)[^- ]*[- ]*" "\\1" name))))
-          (if (and (> (length alias) 1)
+          (if (and email
+                   (> (length alias) 1)
                    ;; Do not overwrite an existing alias
                    (not (and mail-abbrevs (intern-soft alias mail-abbrevs))))
               (define-mail-abbrev alias email))
@@ -647,5 +722,150 @@ instance, someone in bbdb named \"Paul Smith\" would generate an alias
 
   (when (>= emacs-major-version 22)
     (bbdb-insinuate-vm)
-    (ff/mail-aliases-from-bbdb))
+    (ff/mail-aliases-from-bbdb)
+    )
   )
+
+(defun ff/pipe-to-tmp (universal)
+  (interactive "P")
+
+  (if universal (vm-pipe-message-to-command)
+
+    (let ((link "/tmp/at")
+          (dir (format-time-string "/tmp/at-%Y%m%d-%H%M%S" (current-time))))
+      (mkdir dir)
+
+      (when (file-symlink-p (concat link "~~"))
+        (delete-file (concat link "~~")))
+
+      (when (and (file-symlink-p (concat link "~"))
+                 (not (file-exists-p (concat link "~~"))))
+        (rename-file (concat link "~") (concat link "~~")))
+
+      (when (and (file-symlink-p link)
+                 (not (file-exists-p (concat link "~"))))
+        (file-symlink-p link) (rename-file link (concat link "~")))
+
+      (unless (file-exists-p link)
+        (make-symbolic-link dir link 1))
+
+      ;; (vm-pipe-message-to-command (concat "munpack -C " dir))
+
+      (vm-pipe-message-to-command (concat "munpack -t -C " dir))
+      (message "Wrote files to %s" dir)
+      )
+    )
+  )
+
+(define-key vm-mode-pipe-map "\\" 'ff/pipe-to-tmp)
+
+(defun ff/make-nonexisting-filename (filename)
+  (let ((root filename)
+        (extension "")
+        (result filename))
+    (when (file-exists-p result)
+      (when (string-match "^\\(.*\\)\\(\\.[^\\.]*\\)$" filename)
+        (setq root (match-string 1 filename)
+              extension (match-string 2 filename)))
+      (let ((n 0))
+        (while (file-exists-p (setq result (format "%s_%03d%s" root n extension)))
+          (setq n (+ n 1)))))
+    result))
+
+(defun ff/vm-mime-save-all-attachments (&optional count
+                                                  directory
+                                                  no-delete-after-saving)
+  "Save all attachments in the next COUNT messages or marked
+messages.  For the purpose of this function, an \"attachment\" is
+a mime part part which has \"attachment\" as its disposition or
+simply has an associated filename.  Any mime types that match
+`vm-mime-savable-types' but not `vm-mime-savable-type-exceptions'
+are also included.
+
+The attachments are saved to the specified DIRECTORY.  The
+variables `vm-all-attachments-directory' or
+`vm-mime-attachment-save-directory' can be used to set the
+default location.  When directory does not exist it will be
+created."
+  (interactive
+   (list current-prefix-arg
+         (vm-read-file-name
+          "Attachment directory: "
+          (or vm-mime-all-attachments-directory
+              vm-mime-attachment-save-directory
+              default-directory)
+          (or vm-mime-all-attachments-directory
+              vm-mime-attachment-save-directory
+              default-directory)
+          nil nil
+          vm-mime-save-all-attachments-history)))
+
+  (vm-check-for-killed-summary)
+  (if (interactive-p) (vm-follow-summary-cursor))
+
+  (let ((n 0))
+    (vm-mime-action-on-all-attachments
+     count
+     ;; the action to be performed BEGIN
+     (lambda (msg layout type file)
+       (let ((directory (if (functionp directory)
+                            (funcall directory msg)
+                          directory)))
+         (setq file
+	       (if file
+		   (expand-file-name (file-name-nondirectory file) directory)
+		 (vm-read-file-name
+		  (format "Save %s to file: " type)
+		  (or directory
+		      vm-mime-all-attachments-directory
+		      vm-mime-attachment-save-directory)
+		  (or directory
+		      vm-mime-all-attachments-directory
+		      vm-mime-attachment-save-directory)
+		  nil nil
+		  vm-mime-save-all-attachments-history)
+		 ))
+
+         (setq file (ff/make-nonexisting-filename file))
+
+         (when file
+           (message "Saving `%s%s" type (if file (format " (%s)" file) ""))
+           (make-directory (file-name-directory file) t)
+           (vm-mime-send-body-to-file layout file file)
+           (if vm-mime-delete-after-saving
+               (let ((vm-mime-confirm-delete nil))
+                 (vm-mime-discard-layout-contents
+		  layout (expand-file-name file))))
+           (setq n (+ 1 n)))))
+     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; the action to be performed END
+     ;; attachment filters
+     vm-mime-savable-types
+     vm-mime-savable-type-exceptions)
+
+    (when (interactive-p)
+      (vm-discard-cached-data)
+      (vm-preview-current-message))
+
+    (if (> n 0)
+        (message "%d attachment%s saved" n (if (= n 1) "" "s"))
+      (message "No attachments to be saved!"))))
+
+(define-key vm-summary-mode-map [(control c) (control s)] 'ff/vm-mime-save-all-attachments)
+
+;; I do not like relief
+
+(ff/configure-faces
+ '(
+
+   ;; (vm-highlight-url :weight 'bold :foreground "#0000f0" :box nil)
+   (vm-highlight-url :underline nil :foreground "#0000f0" :box nil)
+   ;; (vm-highlight-url :background "white" :foreground "#0000f0" :box nil)
+   (vm-highlighted-header :box nil) ;; :weight 'bold :background "white")
+
+   (vm-attachment-button :background "#f0d0d0" :box nil)
+   (vm-attachment-button-mouse :background "#f0d0d0" :box nil)
+   (vm-attachment-button-pressed-face :background "#f0d0d0" :box nil)
+   (vm-mime-button :background "#f0d0d0" :box nil)
+   (vm-mime-button-mouse :background "#f0d0d0" :box nil)
+   (vm-mime-button-pressed-face :background "#f0d0d0" :box nil)
+   ))