X-Git-Url: https://www.fleuret.org/cgi-bin/gitweb/gitweb.cgi?p=elisp.git;a=blobdiff_plain;f=vm;h=75e3b13afd9a221c7706665585266b555187bd34;hp=675c7aab90b7294288880cc1f1c4ccf48172f013;hb=6a44bdf65c8691602f917c8d5b4d8d751efa83d7;hpb=077152ff029319c5f13e85c7b6cc8f9378abbf44 diff --git a/vm b/vm index 675c7aa..75e3b13 100644 --- a/vm +++ b/vm @@ -17,6 +17,20 @@ ;; Contact 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") +) + (setq-default vm-summary-show-threads t) ;; (setq vm-preview-lines nil) @@ -148,6 +162,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))) @@ -299,6 +314,7 @@ attachement from mail." (flyspell-mode) (auto-fill-mode) (mail-abbrevs-setup) + (yas/minor-mode) ;; (setq fill-paragraph-function 'mail-mode-fill-paragraph) @@ -322,7 +338,8 @@ attachement from mail." (ff/configure-faces ;; '((ff/mail-header-face :background "#c8c8ff")) - '((ff/mail-header-face :foreground "blue4")) + '((ff/mail-header-face :background "#f0f0f0")) + ;; '((ff/mail-header-face :foreground "blue4")) ) (defun ff/colorize-headers () (interactive) @@ -473,6 +490,21 @@ 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. @@ -530,6 +562,10 @@ an 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) @@ -643,7 +679,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)) @@ -654,18 +691,107 @@ instance, someone in bbdb named \"Paul Smith\" would generate an alias (ff/mail-aliases-from-bbdb)) ) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; 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") -) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun ff/pipe-to-tmp () (interactive) + (let ((link "/tmp/attach") + (dir (format-time-string "/tmp/attach-%Y%m%d-%H%M%S" (current-time)))) + (mkdir dir) + (when (file-symlink-p link) (delete-file link)) + (unless (file-exists-p link) + (make-symbolic-link dir "/tmp/attach" 1)) + (vm-pipe-message-to-command (concat "munpack -C " dir)) + (message "Wrote files to %s" dir) + ) + ) +(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)