-;; -*-Emacs-Lisp-*-
+;; -*- mode: Emacs-Lisp; mode: rainbow; -*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This program is free software: you can redistribute it and/or modify ;;
;; along with this program. If not, see <http://www.gnu.org/licenses/>. ;;
;; ;;
;; Written by and Copyright (C) Francois Fleuret ;;
-;; Contact < francois@fleuret.org > for comments & bug reports ;;
+;; 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-startup-message-displayed t ;; Yes, we already saw it, no need to insist
- vm-use-menus nil
- vm-skip-deleted-messages nil
- vm-skip-read-messages nil
- vm-use-toolbar nil
- ;; vm-jump-to-new-messages nil
- vm-startup-with-summary t
- ;; vm-preview-read-messages t
- vm-preview-lines nil
- vm-auto-get-new-mail t
- vm-circular-folders nil
- vm-confirm-new-folders t
- vm-mutable-windows t
- vm-mutable-frames nil
- vm-summary-uninteresting-senders-arrow "->"
- vm-summary-arrow "> "
- vm-included-text-prefix " > "
- vm-forwarding-digest-type "mime"
- vm-mime-attachment-save-directory "~/"
- vm-use-toolbar nil
- vm-frame-per-folder nil
- vm-frame-per-summary nil
- vm-mime-yank-attachments nil
-
- ;; vm-mime-7bit-composition-charset "latin-1"
- vm-mime-8bit-composition-charset "iso-8859-1"
- ;; vm-mime-8bit-composition-charset "utf-8"
- ;; browse-url-mozilla-program "iceweasel"
- vm-netscape-program browse-url-mozilla-program
- ;; vm-coding-system-priorities '(utf-8)
- ;; mail-from-style nil
- ;; mail-complete-style nil
-
- ;; vm-summary-format " %*%A %-3.3m %2d %5US %I%UA %s\n"
- vm-summary-format " %*%a %-3.3m %2d %5US %I%UA %s\n"
- ;; vm-highlighted-header-regexp "From:\\|Subject:\\|Cc:\\|To:\\|Bcc:\\|Reply-To:"
- vm-highlighted-header-regexp "From:\\|Subject:"
-
- vm-auto-folder-case-fold-search t
-
- vm-keep-sent-messages nil
- vm-delete-after-saving t
- vm-delete-after-archiving t
-
- vm-forwarding-subject-format "(forwarded from %F) %s"
- vm-in-reply-to-format nil
- vm-included-text-attribution-format "\nOn %w, %m %d, %y (%h), %F wrote:\n\n"
- ;; vm-included-text-attribution-format "\nOn %w, %m %d, at %H, you wrote:\n\n"
- vm-reply-subject-prefix "Re: "
-
- mail-signature t
- mail-specify-envelope-from t
-
- bbdb/mail-auto-create-p nil
- bbdb-send-mail-style 'vm
+;; (setq vm-preview-lines nil)
- )
+;; (setq vm-auto-displayed-mime-content-types '("text"));; "multipart"));; "image/xpm"
+
+(setq vm-mime-thumbnail-max-geometry nil)
+
+(setq vm-auto-displayed-mime-content-types '(
+ "text"
+ ;; "image/jpeg"
+ ;; "image/png"
+ "multipart"
+ "message/rfc822"
+ ))
+
+
+(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
+ )
-;; (add-to-list 'vm-visible-headers "Reply-To:" t)
+;; (add-to-list 'vm-visible-headers "From " t)
+(add-to-list 'vm-visible-headers "Reply-To:" t)
;; (add-to-list 'vm-visible-headers "X-Mailer:" t)
;; (add-to-list 'vm-visible-headers "X-from-in-bbdb:" t)
;; (add-to-list 'vm-visible-headers "Return-Path:")
(setq
- ;; vm-auto-displayed-mime-content-types '("text/plain" "text" "image" "multipart")
- ;; vm-display-using-mime t
- ;; vm-coding-system-priorities '(iso-8859-1 iso-8859-15 utf-8)
-
vm-infer-mime-types t
vm-mime-use-image-strips nil
- vm-mime-base64-decoder-program "mimencode"
- vm-mime-base64-decoder-switches '("-u")
- vm-mime-base64-encoder-program "mimencode"
+ vm-mime-base64-decoder-program "base64"
+ vm-mime-base64-decoder-switches '("-d")
+ vm-mime-base64-encoder-program "base64"
vm-mime-base64-encoder-switches '()
- vm-auto-displayed-mime-content-types '(
- ;; "plain text"
- "text"
- "multipart"
- "image/xpm"
- )
-
- ;; vm-auto-displayed-mime-content-type-exceptions '("text/html")
-
vm-mime-internal-content-types '(
"multipart"
"text"
)
;; To force it to be converted to plain text
- vm-mime-internal-content-type-exceptions '("text/html")
+ ;; vm-mime-internal-content-type-exceptions '("text/html")
vm-mime-external-content-types-alist '(
("application/x-dvi" "xdvi")
("image/postscript" "gv")
("application/pdf" "xpdf")
- ;; ("application/pdf" "epdfview")
("application/postscript" "gv")
- ;;("image" "feh")
+ ("image" "pho")
("video" "mplayer")
- ;; ("text/html" "iceweasel")
+ ;; ("text/html" "firefox")
+ ;; ("application/pdf" "epdfview")
)
)
(require 'vm-rfaddons)
+;; The two following lines deal with windows-1252 buggy encoding
+
+;;**;; ;; First, don't display iso-8859-1 as-is in default face
+;;**;; (delete "iso-8859-1" vm-mime-default-face-charsets)
+;;**;; ;; Then substitute windows-1252 for iso-8859-1
+;;**;; (add-to-list 'vm-mime-mule-charset-to-coding-alist '("iso-8859-1" windows-1252))
+
+;; (setq vm-mime-default-face-charsets t)
+
;; (add-to-list 'vm-mime-default-face-charsets "utf-8")
-(add-to-list 'vm-mime-default-face-charsets "iso-8859-1")
+;; (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)))
;; "w3m -cols 75 -graph -dump -T text/html"
;; ))
-(add-to-list 'vm-mime-type-converter-alist
- '("text/html" "text/plain"
- "html2text -nobs"
- ))
+;; (add-to-list 'vm-mime-type-converter-alist
+;; '("text/html" "text/plain"
+;; "html2text -style pretty -nobs"
+;; ))
+
+;; (add-to-list 'vm-mime-type-converter-alist
+;; '("text/html" "text/plain"
+;; "html2text.sh"
+;; ))
(add-to-list 'vm-mime-type-converter-alist
'("image" "image/xpm"
;; (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
-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)))))
- )
+;; (defun ff/vm-mime-save-all-files (&optional delete)
+;; "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)))))
+;; )
(defun ff/vm-mime-save-file (&optional delete)
"Save the current attachement. With delete argument, remove the
(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: ")
(defun vm-summary-function-S (&optional message)
(let ((s (string-to-int (vm-su-byte-count message))))
(if (> s 32768)
- (propertize (concat (int-to-string (/ s 1024)) "k") 'face 'bold)
+ (propertize (concat (int-to-string (/ s 1024)) "k")
+ 'face 'italic
+ )
"")))
(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)))
-(add-hook 'vm-quit-hook 'vm-expunge-folder)
+(add-hook 'vm-quit-hook 'ff/vm-expunge-folder)
(add-hook 'vm-quit-hook 'bbdb-save-db)
(add-hook 'vm-retrieved-spooled-mail-hook 'display-time-update)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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 "#d0d0e8"))
+ ;; '((ff/mail-header-face :background "#c8c8ff"))
+ '((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 (:background "gray85"))
- ;; '(face (:background "gray50" :foreground "gray95"))
- '(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))
(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"))
+ ;; )
))
))
(set-visited-file-name (format
"%s/mail-%s"
ff/vm-mail-draft-directory
- (format-time-string "%04Y%02m%02d-%02H%02M%02S" (current-time))))
+ (format-time-string
+ "%04Y%02m%02d-%02H%02M%02S"
+ (current-time))))
(set-buffer-modified-p nil)))
(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."
(let ((bn (buffer-file-name)))
(when bn
- (set-visited-file-name (concat (file-name-directory bn)
- "sent-"
- (file-name-nondirectory bn)
- "-"
- (replace-regexp-in-string "[^a-zA-Z0-9]+" "_"
- (ff/mail-header-field "Subject"))
- ))
+ (set-visited-file-name
+ (concat (file-name-directory bn)
+ "sent-"
+ (file-name-nondirectory bn)
+ "-"
+ (replace-regexp-in-string "[^a-zA-Z0-9]+" "_"
+ (ff/mail-header-field "Subject"))
+ ))
(save-buffer)
(set-visited-file-name nil))
)
)
(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 ?
)
+(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.
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!
+;; (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)
;; 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.
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)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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)
- "Switch to an existing buffer 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. If already in a mail buffer, burry it and go to the next."
+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))))
;; bbdb
(load "bbdb")
-(load "bbdb-hooks")
+;; (load "bbdb-hooks")
(when (load "bbdb-vm" t)
- ;; (defadvice define-mail-abbrev (before ff/remove-explicit-name (name definition &optional from-mailrc-file) activate)
- ;; (message "%s -> %s" name definition))
-
(defun ff/mail-aliases-from-bbdb ()
"Creates automatically mail aliases from the bbdb records. For
instance, someone in bbdb named \"Paul Smith\" would generate an alias
(let* ((record (car records))
(name (concat (elt record 0) " " (elt record 1)))
(email (car (elt record 6)))
- (alias (downcase (replace-regexp-in-string "\\([a-zA-Z]?\\)[^- ]*[- ]*" "\\1" name))))
- (if (and (> (length alias) 1)
+ (alias (downcase (replace-regexp-in-string
+ "\\([a-zA-Z]?\\)[^- ]*[- ]*" "\\1" name))))
+ (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))
(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)
+ ))
projects / elisp.git / blobdiff