;; "tool" bar? Are you kidding?
(when (fboundp 'tool-bar-mode) (tool-bar-mode -1))
-;; ;; If my own letter icon is here, use it and change its color
-;; (when (file-exists-p "~/local/share/emacs/letter.xbm")
-;; (setq-default display-time-mail-icon
-;; (find-image
-;; '((:type xbm
-;; :file "~/local/share/emacs/letter.xbm"
-;; :ascent center)))))
-
;; My funky setting of face colors. Basically, we switch to a sober
;; look and darken a bit the colors which need to (because of the
;; darker background)
;; X-window
(when window-system
- ;; (setq
- ;; display-time-use-mail-icon t)
(ff/configure-faces
'(
;; (fringe :background "black" :foreground "gray90")
(fringe :background "gray80")
(ff/date-info-face :foreground "white")
- (ff/battery-info-face :foreground "white")
- (ff/mail-alarm-face :foreground "white" :background "red2")
+ (ff/battery-info-face :foreground "black")
+ ;; (ff/mail-alarm-face :foreground "white" :background "red2")
;; (alarm-vc-face :foreground "black" :background "yellow" :weight 'normal)
(gui-button-face :background "green" :foreground "black")
))
:inverse-video nil)
(region :background "white" :foreground "black")
(ff/date-info-face :foreground "white" :weight 'bold)
- (ff/battery-info-face :foreground "white")
- (ff/mail-alarm-face :foreground "red" :weight 'bold)
+ (ff/battery-info-face :foreground "black")
+ ;; (ff/mail-alarm-face :foreground "red" :weight 'bold)
(selector/selection :background "yellow")
(gui-button-face :background "green" :foreground "white")
(enotes/information-face :foreground "cyan")
;; Playing sounds
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; (defun ff/esd-sound (file)
-;; "Plays a sound with the Enlighted sound daemon."
-;; (interactive)
-;; (process-kill-without-query (start-process-shell-command "esdplay"
-;; nil
-;; "esdplay" file)))
-
(defun ff/alsa-sound (file)
"Plays a sound with ALSA."
(interactive)
(set-buffer-modified-p nil)
))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Make a sound when there is new mail
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; I do not like sounds anymore
-
-;; (setq ff/already-boinged-for-mail nil)
-
-;; (defun ff/boing-if-new-mail ()
-;; (if mail (when (not ff/already-boinged-for-mail)
-;; ;; (ff/play-sound-async "~/local/sounds/boing1.wav")
-;; ;; (ff/show-unspooled-mails)
-;; (setq ff/already-boinged-for-mail t))
-;; (setq ff/already-boinged-for-mail nil))
-;; )
-
-;; (add-hook 'display-time-hook 'ff/boing-if-new-mail)
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Display time
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-key global-map [f8] 'ff-find-other-file)
(define-key global-map [(shift f8)] (lambda () (interactive) (ff-find-other-file t)))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Antiword, htmlize and boxquote
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(autoload 'no-word "no-word")
-(add-to-list 'auto-mode-alist '("\\.doc\\'" . no-word))
-;; (add-to-list 'auto-mode-alist '("\\.DOC\\'" . no-word))
-
-(autoload 'htmlize-buffer "htmlize" nil t)
-
-(setq boxquote-top-and-tail "------------------")
-(autoload 'boxquote-region "boxquote" nil t)
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; The compilation hacks
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq mymail/default-search-request "today"
mymail/default-additional-search-requests "!s ^\\[SPAM\\],!s \\] STATUS,")
(add-to-list 'recentf-exclude "/tmp/mymail-vm-.*\.mbox")
-)
+ )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(set-window-configuration ff/window-configuration-before-vm)
(makunbound 'ff/window-configuration-before-vm)
)
-)
+ )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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)
;; ))
;; (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"
;; (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
(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 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)))
)
(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))
(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"))
+ ;; )
))
))
(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."
)
(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 ?
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-presentation-mode-hook 'mc-install-read-mode)
;; (defun ff/encrypt-mail-if-possible () (interactive)
- ;; (condition-case nil (mc-encrypt-message)
- ;; (error nil)))
+;; (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)
)
)
-(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/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 link) (delete-file link))
+ (unless (file-exists-p link) (make-symbolic-link dir link 1))
+ (vm-pipe-message-to-command (concat "munpack -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))
(defun ff/vm-mime-save-all-attachments (&optional count
- directory
- no-delete-after-saving)
+ 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
projects / elisp.git / commitdiff