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

diff --git a/vm b/vm
index 8e25489..6b4b1fb 100644
--- a/vm
+++ b/vm
@@ -17,6 +17,20 @@
 ;; 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")
+)
+
 (setq-default vm-summary-show-threads t)
 
 ;; (setq vm-preview-lines nil)
@@ -299,6 +313,7 @@ attachement from mail."
   (flyspell-mode)
   (auto-fill-mode)
   (mail-abbrevs-setup)
+  (yas/minor-mode)
 
   ;; (setq fill-paragraph-function 'mail-mode-fill-paragraph)
 
@@ -530,8 +545,13 @@ 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)
+
 ;; 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)
 
@@ -542,10 +562,11 @@ an attachment")
 (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)
-;; (error nil)))
+  ;; (condition-case nil (mc-encrypt-message)
+    ;; (error nil)))
 
 ;; (add-hook 'vm-mail-send-hook 'ff/encrypt-mail-if-possible t)
 
@@ -558,7 +579,8 @@ an attachment")
 (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)
+                 (re-search-backward
+                  (concat "\\(^[a-zA-Z\-]*: \\|^" mail-header-separator "$\\)") nil t)
                  (match-string 1))))
 
     (cond ((string= field "To: ")
@@ -593,6 +615,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)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -639,7 +662,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))
@@ -649,3 +673,108 @@ instance, someone in bbdb named \"Paul Smith\" would generate an alias
     (bbdb-insinuate-vm)
     (ff/mail-aliases-from-bbdb))
   )
+
+(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)