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

diff --git a/vm b/vm
index b9e7233..49104ac 100644
--- a/vm
+++ b/vm
@@ -35,15 +35,17 @@
 
 ;; Store and restore the window configuration
 
+(setq ff/window-configuration-before-vm nil)
+
 (defadvice vm (before ff/store-window-configuration nil activate)
-  (unless (boundp 'ff/window-configuration-before-vm)
+  (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 (boundp 'ff/window-configuration-before-vm)
+  (when ff/window-configuration-before-vm
     (set-window-configuration ff/window-configuration-before-vm)
-    (makunbound 'ff/window-configuration-before-vm)
+    (setq ff/window-configuration-before-vm nil)
     )
   )
 
@@ -351,7 +353,8 @@ attachement from mail."
 
 (ff/configure-faces
  ;; '((ff/mail-header-face :background "#c8c8ff"))
- '((ff/mail-header-face :background "#f0f0f0"))
+ '((ff/mail-header-face :background "#eaf0ff"))
+ ;; '((ff/mail-header-face :background "#fff0a0"))
  ;; '((ff/mail-header-face :foreground "blue4"))
  )
 
@@ -517,7 +520,6 @@ an attachment")
       )
     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.
 
@@ -588,11 +590,14 @@ an attachment")
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; 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)
-(add-hook 'vm-presentation-mode-hook 'mc-install-read-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-message)
@@ -637,6 +642,19 @@ an attachment")
 ;; (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.
 
@@ -654,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))))
@@ -676,7 +697,7 @@ is t."
 ;; bbdb
 
 (load "bbdb")
-(load "bbdb-hooks")
+;; (load "bbdb-hooks")
 
 (when (load "bbdb-vm" t)
 
@@ -713,12 +734,26 @@ instance, someone in bbdb named \"Paul Smith\" would generate an alias
     (let ((link "/tmp/at")
           (dir (format-time-string "/tmp/at-%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 link 1))
-      (vm-pipe-message-to-command (concat "munpack -C " 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)
       )
-
     )
   )
 
@@ -816,3 +851,21 @@ created."
       (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)
+   ))