* move emacs/ code to toys/mua; rename mu=>mua, many updates
This commit is contained in:
Dirk-Jan C. Binnema
@ -1,227 +0,0 @@
|
||||
;;; mu-common.el -- part of mu
|
||||
;;
|
||||
;; Copyright (C) 2011 Dirk-Jan C. Binnema
|
||||
|
||||
;; Author: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||
;; Maintainer: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||
;; Keywords: email
|
||||
;; Version: 0.0
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; mu message has functions to display a message
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl)
|
||||
|
||||
(defvar mu-binary "/home/djcb/src/mu/src/mu" "name/path of the mu executable")
|
||||
(defvar mu-muile-binary "/home/djcb/src/mu/toys/muile/muile"
|
||||
"name/path of the muile executable")
|
||||
(defvar mu-home nil
|
||||
"path where mu stores it's data or nil for the defaults (typically, ~/.mu)")
|
||||
|
||||
(defvar mu-date-format-short "%x %X" "date format (in strftime(2)
|
||||
notation) e.g. for mail headers")
|
||||
|
||||
(defvar mu-date-format-long "%c" "date format (in strftime(2)
|
||||
notation) for the mail view and in replied/forwarded message quotations")
|
||||
|
||||
(defvar mu-folder-draft "/home/djcb/Maildir/")
|
||||
|
||||
(defface mu-date-face '((t (:foreground "#8c5353"))) "")
|
||||
(defface mu-subject-face '((t (:foreground "#dfaf8f"))) "")
|
||||
(defface mu-from-face '((t (:foreground "#7f9f7f"))) "")
|
||||
(defface mu-to-face '((t (:foreground "#7f6655"))) "")
|
||||
(defface mu-cc-face '((t (:foreground "#7f6666"))) "")
|
||||
(defface mu-bcc-face '((t (:foreground "#7f6677"))) "")
|
||||
(defface mu-body-face '((t (:foreground "#8cd0d3"))) "")
|
||||
(defface mu-header-face '((t (:foreground "#7f9f7f"))) "")
|
||||
(defface mu-size-face '((t (:foreground "#889f7f"))) "")
|
||||
(defface mu-flag-face '((t (:foreground "#dc56cc"))) "")
|
||||
(defface mu-path-face '((t (:foreground "#dc56cc"))) "")
|
||||
|
||||
(defface mu-unread-face '((t (:bold t))) "")
|
||||
(defface mu-face '((t (:foreground "Gray" :italic t))) "")
|
||||
|
||||
(defvar mu-own-address "djcb" "regexp matching my own address")
|
||||
|
||||
;;; internal stuff
|
||||
(defvar mu-parent-buffer nil "the parent buffer for a
|
||||
buffer (buffer-local), i.e., the buffer we'll return to when this
|
||||
buffer is killed")
|
||||
|
||||
|
||||
(defun mu-binary-version ()
|
||||
"get the version of the mu binary"
|
||||
(let ((cmd (concat mu-binary
|
||||
" --version | head -1 | sed 's/.*version //'")))
|
||||
(substring (shell-command-to-string cmd) 0 -1)))
|
||||
|
||||
(defun mu-inspect (path)
|
||||
"inspect message in a guile environment"
|
||||
(let ((cmd (concat mu-muile-binary " --msg='" path "'")))
|
||||
(ansi-term cmd "*mu-inspect")))
|
||||
|
||||
;; (defalias mu-find mu-headers-find)
|
||||
;; (defalias mu-display mu-message-display)
|
||||
|
||||
(defun mu-str (str)
|
||||
"return STR propertized as a mu string (for info, warnings
|
||||
etc.)"
|
||||
(propertize str 'face 'mu-face 'intangible t))
|
||||
|
||||
(setq mu-headers-fields
|
||||
'(
|
||||
(:date . 20)
|
||||
(:flags . 4)
|
||||
(:from-or-to . 22)
|
||||
(:size . 8)
|
||||
(:subject . 40)))
|
||||
(setq mu-headers-date-format "%x %X")
|
||||
|
||||
(setq mu-header-fields
|
||||
'( :from
|
||||
:to
|
||||
:subject
|
||||
:date
|
||||
:path))
|
||||
|
||||
(setq mu-own-address-regexp "djcb\\|diggler\\|bulkmeel")
|
||||
|
||||
(defvar mu-maildir nil "our maildir")
|
||||
(defvar mu-folder nil "our list of special folders for jumping,
|
||||
moving")
|
||||
|
||||
|
||||
(defvar mu-maildir nil "location of your maildir, typically ~/Maildir")
|
||||
(defvar mu-inbox-folder nil "location of your inbox folder")
|
||||
(defvar mu-outbox-folder nil "location of your outbox folder")
|
||||
(defvar mu-sent-folder nil "location of your sent folder")
|
||||
(defvar mu-trash-folder nil "location of your trash-folder folder")
|
||||
|
||||
(setq
|
||||
mu-maildir "/home/djcb/Maildir"
|
||||
mu-inbox-folder "/inbox"
|
||||
mu-outbox-folder "/outbox"
|
||||
mu-sent-folder "/sent"
|
||||
mu-trash-folder "/trash")
|
||||
|
||||
(defvar mu-quick-folders nil)
|
||||
|
||||
(setq mu-quick-folders
|
||||
'("/archive" "/bulkarchive" "/todo"))
|
||||
|
||||
(defun mu-ask-maildir (prompt &optional fullpath)
|
||||
"ask user with PROMPT for a maildir name, if fullpath is
|
||||
non-nill, return the fulpath (ie, mu-maildir prepended to the
|
||||
maildir"
|
||||
(interactive)
|
||||
(let*
|
||||
((showfolders
|
||||
(delete-dups
|
||||
(append (list mu-inbox-folder mu-sent-folder) mu-quick-folders)))
|
||||
(chosen (ido-completing-read prompt showfolders)))
|
||||
(concat (if fullpath mu-maildir "") chosen)))
|
||||
|
||||
(defun mu-ask-key (prompt)
|
||||
"Get a char from user, only accepting characters marked with [x] in prompt,
|
||||
e.g. 'Reply to [a]ll or [s]ender only; returns the character chosen"
|
||||
(let ((match 0) (kars '()))
|
||||
(while match
|
||||
(setq match (string-match "\\[\\(.\\)\\]" prompt match))
|
||||
(when match
|
||||
(setq kars (cons (match-string 1 prompt) kars))
|
||||
(setq match (+ 1 match))))
|
||||
(let ((kar)
|
||||
(prompt (replace-regexp-in-string
|
||||
"\\[\\(.\\)\\]"
|
||||
(lambda(s)
|
||||
(concat "[" (propertize (substring s 1 -1) 'face 'highlight) "]"))
|
||||
prompt)))
|
||||
(while (not kar)
|
||||
(setq kar (read-char-exclusive prompt))
|
||||
(unless (member (string kar) kars)
|
||||
(setq kar nil)))
|
||||
kar)))
|
||||
|
||||
|
||||
;; both in mu-find.el and mu-view.el we have the path as a text property; in the
|
||||
;; latter case we could have use a buffer-local variable, but using a
|
||||
;; text-property makes this function work for both
|
||||
(defun mu-get-path ()
|
||||
"get the path (a string) of the message at point or nil if it
|
||||
is not found; this works both for the header list and when
|
||||
viewing a message"
|
||||
(let ((path (get-text-property (point) 'path)))
|
||||
(unless path (message "No message at point"))
|
||||
path))
|
||||
|
||||
|
||||
;; The message sexp looks something like:
|
||||
;; (
|
||||
;; :from (("Donald Duck" . "donald@example.com"))
|
||||
;; :to (("Mickey Mouse" . "mickey@example.com"))
|
||||
;; :subject "Wicked stuff"
|
||||
;; :date (20023 26572 0)
|
||||
;; :size 15165
|
||||
;; :msgid "foobar32423847ef23@pluto.net"
|
||||
;; :path "/home/mickey/Maildir/inbox/cur/1312254065_3.32282.pluto,4cd5bd4e9:2,"
|
||||
;; :priority high
|
||||
;; :flags (new unread)
|
||||
;; :body-txt " <message body>"
|
||||
;; )
|
||||
(defun mu-get-message (path)
|
||||
"use 'mu view --format=sexp' to get the message at PATH in the
|
||||
form of an s-expression; parse this s-expression and return the
|
||||
Lisp data as a plist. Returns nil in case of error"
|
||||
(if (not (file-readable-p path))
|
||||
(progn (message "Message is not readable") nil)
|
||||
(let* ((cmd (concat mu-binary " view --format=sexp " path))
|
||||
(str (shell-command-to-string cmd))
|
||||
(msglst (read-from-string str)))
|
||||
(if msglst
|
||||
(car msglst)
|
||||
(progn (message "Failed to parse message") nil)))))
|
||||
|
||||
|
||||
(defun mu-quit-buffer ()
|
||||
"kill this buffer, and switch to it's parentbuf if it is alive"
|
||||
(interactive)
|
||||
(let ((parentbuf mu-parent-buffer))
|
||||
(kill-buffer)
|
||||
(when (and parentbuf (buffer-live-p parentbuf))
|
||||
(switch-to-buffer parentbuf))))
|
||||
|
||||
(defun mu-get-new-buffer (bufname)
|
||||
"return a new buffer BUFNAME; if such already exists, kill the
|
||||
old one first"
|
||||
(when (get-buffer bufname)
|
||||
(kill-buffer bufname))
|
||||
(get-buffer-create bufname))
|
||||
|
||||
(defun mu-log (frm &rest args)
|
||||
(with-current-buffer (get-buffer-create "*mu-log*")
|
||||
(goto-char (point-max))
|
||||
(insert (apply 'format
|
||||
(concat
|
||||
(format-time-string "%x %X " (current-time))
|
||||
frm "\n") args))))
|
||||
|
||||
|
||||
(provide 'mu-common)
|
||||
@ -1,464 +0,0 @@
|
||||
;;; mu-headers.el -- use `mu' from emacs
|
||||
;; Copyright (C) 2011 Dirk-Jan C. Binnema
|
||||
|
||||
;; Author: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||
;; Maintainer: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||
;; Keywords: email
|
||||
;; Version: 0.0
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'mu-common)
|
||||
|
||||
|
||||
;;; mu-headers has functions for displaying/manipulating a list of headers (ie.,
|
||||
;;; one line descriptions of an e-mail message), based on the output of 'mu
|
||||
;;; find'.
|
||||
|
||||
;; data is stored like the following: for each header-line, we take the (point)
|
||||
;; at beginning-of-line (bol) and use that as the key in the mu-headers-hash
|
||||
;; hash, which does
|
||||
;;
|
||||
;; point-of-bol -> path
|
||||
;;
|
||||
;; then, marks are stored in a seperate hash 'mu-headers-marks-hash, using
|
||||
;;
|
||||
;; point-of-bol -> (src . target)
|
||||
;;
|
||||
;; and note both 'delete' (target=/dev/null), trash (target=trash-folder), and
|
||||
;; move can be expressed by that
|
||||
;;
|
||||
;; after the marks have been 'executed', the lines will be marked a *invisible*
|
||||
;; instead of deleting them; that way, the 'point-of-bol' stays valid.
|
||||
|
||||
(defvar mu-headers-hash nil "internal: buffer-local hash table
|
||||
which maps bol->path")
|
||||
(defvar mu-headers-marks-hash nil "internal: buffer-local hash table
|
||||
which maps bol->(src . target) for marked lines")
|
||||
|
||||
(defun mu-headers-set-path (path)
|
||||
"map the bol of the current header to a path"
|
||||
(puthash (line-beginning-position 1) path mu-headers-hash))
|
||||
|
||||
(defun mu-headers-get-path ()
|
||||
"get the path for the header at point"
|
||||
(gethash (line-beginning-position 1) mu-headers-hash))
|
||||
|
||||
(defvar mu-headers-fields
|
||||
'( (:date . 25)
|
||||
(:from-or-to . 22)
|
||||
(:subject . 40))
|
||||
"a list of fields and their widths")
|
||||
|
||||
(defvar mu-headers-sort-field "date"
|
||||
"shortcut of the field to sort on (see mu-headers (1))")
|
||||
(defvar mu-headers-sort-descending nil
|
||||
"whether to sort in descending order")
|
||||
|
||||
;; internal stuff
|
||||
(defconst mu-headers-buffer-name " *mu-headers*" "name of the mu
|
||||
results buffer; name should start with a space")
|
||||
|
||||
(defvar mu-headers-process nil "the possibly running find process")
|
||||
|
||||
(defconst mu-eom "\n;;eom\n" "marker for the end of message in
|
||||
the mu find output")
|
||||
|
||||
(defvar mu-headers-expression nil
|
||||
"search expression for the current find buffer")
|
||||
|
||||
(defvar mu-buf "" "internal: buffer for results data")
|
||||
(defun mu-headers-process-filter (proc str)
|
||||
"process-filter for the 'mu find --format=sexp output; it
|
||||
accumulates the strings into valid sexps by checking of the
|
||||
';;eom' end-of-msg marker, and then evaluating them"
|
||||
(when (buffer-live-p (process-buffer proc))
|
||||
(with-current-buffer (process-buffer proc)
|
||||
(save-excursion
|
||||
(setq mu-buf (concat mu-buf str))
|
||||
(let ((eom (string-match mu-eom mu-buf)))
|
||||
(while (numberp eom)
|
||||
(let* ((msg (car (read-from-string (substring mu-buf 0 eom))))
|
||||
(inhibit-read-only t))
|
||||
(goto-char (point-max))
|
||||
(mu-headers-set-path (plist-get msg :path))
|
||||
(save-match-data (insert (mu-headers-header msg) ?\n)))
|
||||
(setq mu-buf (substring mu-buf (match-end 0)))
|
||||
(setq eom (string-match mu-eom mu-buf))))))))
|
||||
|
||||
(defun mu-headers-process-sentinel (proc msg)
|
||||
"Check the mu-headers process upon completion"
|
||||
(when (buffer-live-p (process-buffer proc))
|
||||
(with-current-buffer (process-buffer proc)
|
||||
(let ((status (process-status proc))
|
||||
(exit-status (process-exit-status proc)))
|
||||
(if (memq status '(exit signal))
|
||||
(let ((inhibit-read-only t)
|
||||
(text
|
||||
(cond
|
||||
((eq status 'signal)
|
||||
"Search process killed (results incomplete)")
|
||||
((eq status 'exit)
|
||||
(cond
|
||||
((= 0 exit-status) "End of search results")
|
||||
((= 2 exit-status) "No matches found")
|
||||
((= 4 exit-status) "Database problem; try running 'mu index'")
|
||||
(t (format "Some error occured; mu-headers returned %d"
|
||||
exit-status))))
|
||||
(t "Unknown status")))) ;; shouldn't happen
|
||||
(save-excursion
|
||||
(goto-char (point-max))
|
||||
(insert (mu-str text)))))))))
|
||||
|
||||
|
||||
;; Note, the 'mu find --format=sexp' sexp is almost the same as the ones that
|
||||
;; 'mu view --format=sexp' produces (see mu-get-message), with the difference
|
||||
;; that former may give more than one result, and that mu-headers output comes
|
||||
;; from the database rather than file, and does _not_ contain the message body
|
||||
(defun mu-headers-search (expr)
|
||||
"search in the mu database"
|
||||
(interactive "s[mu] search for: ")
|
||||
(let* ((buf (mu-get-new-buffer mu-headers-buffer-name))
|
||||
(dummy-arg "--fields=\"dummy\"") ;; ignored
|
||||
(proc (start-process mu-headers-buffer-name buf
|
||||
mu-binary
|
||||
"find"
|
||||
(if mu-home
|
||||
(concat "--muhome=" mu-home) dummy-arg)
|
||||
(if mu-headers-sort-field
|
||||
(concat "--sortfield=" mu-headers-sort-field) dummy-arg)
|
||||
(if mu-headers-sort-descending "--descending" dummy-arg)
|
||||
"--format=sexp"
|
||||
"--quiet"
|
||||
expr)))
|
||||
(mu-log "search: '%s'" expr)
|
||||
(switch-to-buffer buf)
|
||||
(mu-headers-mode)
|
||||
|
||||
(setq
|
||||
mu-buf "" ;; if the last query went wrong...
|
||||
mu-headers-expression expr
|
||||
mu-headers-process proc
|
||||
|
||||
mu-headers-hash (make-hash-table :size 256 :rehash-size 2)
|
||||
mu-headers-marks-hash (make-hash-table :size 16 :rehash-size 2))
|
||||
|
||||
(set-process-filter proc 'mu-headers-process-filter)
|
||||
(set-process-sentinel proc 'mu-headers-process-sentinel)))
|
||||
|
||||
(defun mu-headers-field-contact (lst width face)
|
||||
"display a list of contacts, truncated for fitting in WIDTH"
|
||||
(if lst
|
||||
(let* ((len (length lst))
|
||||
(str (if (= len 0) "<none>"
|
||||
;; try name -> email -> ?
|
||||
(or (car(car lst)) (cdr(car lst)) "?")))
|
||||
(others (if (> len 1) (mu-str (format " [+%d]" (- len 1))) "")))
|
||||
(truncate-string-to-width
|
||||
(concat(propertize (truncate-string-to-width str
|
||||
(- width (length others)) 0 ?\s "...") 'face face) others)
|
||||
width 0 ?\s))
|
||||
(make-string width ?\s)))
|
||||
|
||||
|
||||
(defun mu-headers-field-from-or-to (fromlst tolst width from-face to-face)
|
||||
"return a propertized string for FROM unless TO matches
|
||||
mu-own-address, in which case it returns TO, prefixed with To:"
|
||||
(if (and fromlst tolst)
|
||||
(let ((fromaddr (cdr(car fromlst))))
|
||||
(if (and fromaddr (string-match mu-own-address fromaddr))
|
||||
(concat (mu-str "To ") (mu-headers-field-contact tolst (- width 3) to-face))
|
||||
(mu-headers-field-contact fromlst width from-face)))
|
||||
(make-string width ?\s)))
|
||||
|
||||
(defun mu-headers-field-size (size width face)
|
||||
"return a string for SIZE of WIDTH with FACE"
|
||||
(let* ((str
|
||||
(cond
|
||||
((>= size 1000000) (format "%2.1fM" (/ size 1000000.0)))
|
||||
((and (>= size 1000) (< size 1000000)) (format "%2.1fK" (/ size 1000.0)))
|
||||
((< size 1000) (format "%d" size)))))
|
||||
(propertize (truncate-string-to-width str width 0 ?\s) 'face face)))
|
||||
|
||||
(defun mu-headers-field-str (str width face)
|
||||
"print a STR, at WIDTH (truncate or ' '-pad) with FACE"
|
||||
(let ((str (if str str "")))
|
||||
(propertize (truncate-string-to-width str width 0 ?\s t) 'face face)))
|
||||
|
||||
(defun mu-headers-field-flags (flags width face)
|
||||
(let ((str
|
||||
(mapconcat
|
||||
(lambda(flag)
|
||||
(let ((flagname (symbol-name flag)))
|
||||
(cond
|
||||
((string= flagname "unread") "U")
|
||||
((string= flagname "seen") "S")
|
||||
((string= flagname "replied") "R")
|
||||
((string= flagname "attach") "a")
|
||||
((string= flagname "encrypted") "x")
|
||||
((string= flagname "signed") "s")))) flags "")))
|
||||
(propertize (truncate-string-to-width str width 0 ?\s) 'face face)))
|
||||
|
||||
(defun mu-headers-field (msg fieldinfo)
|
||||
"determine a field based on FIELDINFO in the header for MSG"
|
||||
(let* ((field (car fieldinfo))
|
||||
(width (cdr fieldinfo))
|
||||
(val (plist-get msg field)) ;; note: header-field maps msg-field in
|
||||
(str (case field ;; most cases..
|
||||
(:date (mu-headers-field-str (format-time-string mu-date-format-short
|
||||
val) width 'mu-date-face))
|
||||
(:from (mu-headers-field-contact val width 'mu-from-face))
|
||||
(:to (mu-headers-field-contact val width 'mu-to-face))
|
||||
(:cc (mu-headers-field-contact val width 'mu-cc-face))
|
||||
(:bcc (mu-headers-field-contact val width 'mu-bcc-face))
|
||||
(:flags (mu-headers-field-flags val width 'mu-flag-face))
|
||||
(:size (mu-headers-field-size val width 'mu-size-face))
|
||||
(:subject (mu-headers-field-str val width 'mu-subject-face))
|
||||
(:from-or-to ;; this one is special
|
||||
(mu-headers-field-from-or-to (plist-get msg :from)
|
||||
(plist-get msg :to) width 'mu-from-face 'mu-to-face)))))
|
||||
str))
|
||||
|
||||
(defun mu-headers-header (msg)
|
||||
"convert a message s-expression into a header for display, and
|
||||
set text property 'path"
|
||||
(concat " "
|
||||
(mapconcat
|
||||
(lambda (fieldinfo)
|
||||
(mu-headers-field msg fieldinfo)) mu-headers-fields " ")))
|
||||
|
||||
|
||||
(defun mu-headers-mode ()
|
||||
"major mode for displaying search results"
|
||||
(interactive)
|
||||
(kill-all-local-variables)
|
||||
(use-local-map mu-headers-mode-map)
|
||||
|
||||
(make-local-variable 'mu-buf)
|
||||
(make-local-variable 'mu-parent-buffer)
|
||||
(make-local-variable 'mu-headers-expression)
|
||||
(make-local-variable 'mu-headers-process)
|
||||
(make-local-variable 'mu-headers-hash)
|
||||
(make-local-variable 'mu-headers-marks-hash)
|
||||
|
||||
(setq
|
||||
major-mode 'mu-headers-mode mode-name "*headers*"
|
||||
mu-buf ""
|
||||
truncate-lines t buffer-read-only t
|
||||
overwrite-mode 'overwrite-mode-binary))
|
||||
|
||||
(defvar mu-headers-mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
|
||||
(define-key map "s" 'mu-headers-search)
|
||||
(define-key map "q" 'mu-quit-buffer)
|
||||
(define-key map "s" 'mu-headers-change-sort)
|
||||
(define-key map "g" 'mu-headers-refresh)
|
||||
|
||||
;; navigation
|
||||
(define-key map "n" 'mu-headers-next)
|
||||
(define-key map "p" 'mu-headers-previous)
|
||||
(define-key map "j" 'mu-headers-jump-to-maildir)
|
||||
|
||||
;; marking/unmarking/executing
|
||||
(define-key map "m" 'mu-headers-mark-for-move)
|
||||
(define-key map "d" 'mu-headers-mark-for-trash)
|
||||
(define-key map "D" 'mu-headers-mark-for-deletion)
|
||||
(define-key map "u" 'mu-headers-unmark)
|
||||
(define-key map "U" 'mu-headers-unmark-all)
|
||||
(define-key map "x" 'mu-headers-marked-execute)
|
||||
|
||||
;; message composition
|
||||
(define-key map "r" 'mu-reply)
|
||||
(define-key map "f" 'mu-forward)
|
||||
(define-key map (kbd "RET") 'mu-headers-view)
|
||||
map)
|
||||
"Keymap for \"mu-headers\" buffers.")
|
||||
(fset 'mu-headers-mode-map mu-headers-mode-map)
|
||||
|
||||
(defun mu-headers-view ()
|
||||
"display the message at the current line"
|
||||
(interactive)
|
||||
(let ((path (mu-headers-get-path)))
|
||||
(when path (mu-view path (current-buffer)))))
|
||||
|
||||
(defun mu-headers-next ()
|
||||
"go to the next line; t if it worked, nil otherwise"
|
||||
(interactive)
|
||||
(if (or (/= 0 (forward-line 1)) (not (mu-headers-get-path)))
|
||||
(progn (message "No message after this one") nil)
|
||||
t))
|
||||
|
||||
(defun mu-headers-prev ()
|
||||
"go to the next line; t if it worked, nil otherwise"
|
||||
(interactive)
|
||||
(if (/= 0 (forward-line -1))
|
||||
(progn (message "No message before this one") nil)
|
||||
t))
|
||||
|
||||
(defun mu-headers-jump-to-maildir ()
|
||||
"show the messages in one of the standard folders"
|
||||
(interactive)
|
||||
(let ((fld (mu-ask-maildir "Jump to maildir: ")))
|
||||
(mu-headers-search (concat "maildir:" fld))))
|
||||
|
||||
(defun mu-headers-refresh ()
|
||||
"re-run the query for the current search expression, but only
|
||||
if the search process is not already running"
|
||||
(interactive)
|
||||
(message "REFRESH %s" mu-headers-expression)
|
||||
(if (and mu-headers-process (eq (process-status mu-headers-process) 'run))
|
||||
(message "Can't refresh while running")
|
||||
(when mu-headers-expression (mu-headers mu-headers-expression))))
|
||||
|
||||
;; create a new query based on the old one, but with a changed sort order
|
||||
|
||||
(defun mu-headers-change-sort-order (fieldchar)
|
||||
"change the sortfield to FIELDCHAR"
|
||||
(interactive"cField to sort by ('d', 's', etc.; see mu-headers(1)):\n")
|
||||
(let
|
||||
((field
|
||||
(case fieldchar
|
||||
(?b "bcc")
|
||||
(?c "cc")
|
||||
(?d "date")
|
||||
(?f "from")
|
||||
(?i "msgid")
|
||||
(?m "maildir")
|
||||
(?p "prio")
|
||||
(?s "subject")
|
||||
(?t "to")
|
||||
(?z "size"))))
|
||||
(if field
|
||||
(setq mu-headers-sort-field field)
|
||||
(message "Invalid sort-field; use one of bcdfimpstz (see mu-headers(1)"))
|
||||
field))
|
||||
|
||||
(defun mu-headers-change-sort-direction (dirchar)
|
||||
"change the sort direction, either [a]scending or [d]escending"
|
||||
(interactive
|
||||
"cSorting direction ([a]scending or [d]escending):")
|
||||
(cond
|
||||
(?d (setq mu-headers-sort-descending t) t)
|
||||
(?a (setq mu-headers-sort-descending nil) t)
|
||||
(t (message
|
||||
"Invalid sort-direction; choose either [a]scending or [d]escending") nil)))
|
||||
|
||||
(defun mu-headers-change-sort ()
|
||||
"change sort field and direction"
|
||||
(interactive)
|
||||
(and (call-interactively 'mu-headers-change-sort-order)
|
||||
(call-interactively 'mu-headers-change-sort-direction)))
|
||||
|
||||
(defun mu-headers-add-marked (src &optional dst)
|
||||
(let ((bol (line-beginning-position 1)))
|
||||
(if (gethash bol mu-headers-marks-hash)
|
||||
(progn (message "Message is already marked") nil)
|
||||
(progn (puthash bol (cons src dst) mu-headers-marks-hash) t))))
|
||||
|
||||
(defun mu-headers-remove-marked ()
|
||||
(let ((bol (line-beginning-position 1)))
|
||||
(if (not (gethash bol mu-headers-marks-hash))
|
||||
(progn (message "Message is not marked") nil)
|
||||
(progn (remhash bol mu-headers-marks-hash) t))))
|
||||
|
||||
(defun mu-headers-set-marker (kar)
|
||||
"set the marker at the beginning of this line"
|
||||
(beginning-of-line 1)
|
||||
(let ((inhibit-read-only t))
|
||||
(delete-char 2)
|
||||
(insert (if kar kar " ") " ")))
|
||||
|
||||
(defun mu-headers-mark (action)
|
||||
"mark the current msg for something: move, delete, trash, unmark"
|
||||
(let ((target) (src (mu-headers-get-path)))
|
||||
(when src
|
||||
(case action
|
||||
(move
|
||||
(when (mu-headers-add-marked src
|
||||
(mu-ask-maildir "Target maildir: " t))
|
||||
(mu-headers-set-marker ?m)))
|
||||
(trash
|
||||
(when (mu-headers-add-marked src
|
||||
(concat mu-maildir mu-trash-folder))
|
||||
(mu-headers-set-marker ?d)))
|
||||
(delete
|
||||
(when (mu-headers-add-marked src "/dev/null")
|
||||
(mu-headers-set-marker ?D)))
|
||||
(unmark
|
||||
(when (mu-headers-remove-marked)
|
||||
(mu-headers-set-marker nil)))
|
||||
(unmark-all
|
||||
(when (y-or-n-p (format "Sure you want to remove all (%d) marks? "
|
||||
(hash-table-count mu-headers-marks-hash)))
|
||||
(save-excursion
|
||||
(maphash (lambda (k v) (goto-char k) (mu-headers-mark 'unmark))
|
||||
mu-headers-marks-hash)))
|
||||
(t (message "Unsupported mark type"))))
|
||||
(move-beginning-of-line 2))))
|
||||
|
||||
(defun mu-headers-marks-execute ()
|
||||
"execute the actions for all marked messages"
|
||||
(interactive)
|
||||
(let ((n-marked (hash-table-count mu-headers-marks-hash)))
|
||||
(if (= 0 n-marked)
|
||||
(message "No marked messages")
|
||||
(when (y-or-n-p
|
||||
(format "Execute actions for %d marked message(s)? " n-marked))
|
||||
(save-excursion
|
||||
(maphash
|
||||
(lambda(bol v)
|
||||
(let ((src (car v)) (target (cdr v)) (inhibit-read-only t))
|
||||
(when (mu-message-move src target)
|
||||
(goto-char bol)
|
||||
(mu-headers-remove-marked)
|
||||
(put-text-property (line-beginning-position 1)
|
||||
(line-beginning-position 2)
|
||||
'invisible t)))) ;; when it succeedes, hide msg..)
|
||||
mu-headers-marks-hash))
|
||||
(message "Done")
|
||||
))))
|
||||
|
||||
(defun mu-headers-mark-for-move () (interactive) (mu-headers-mark 'move))
|
||||
(defun mu-headers-mark-for-trash () (interactive) (mu-headers-mark 'trash))
|
||||
(defun mu-headers-mark-for-delete () (interactive) (mu-headers-mark 'delete))
|
||||
(defun mu-headers-mark-for-deletion () (interactive) (mu-headers-mark 'delete))
|
||||
(defun mu-headers-unmark () (interactive) (mu-headers-mark 'unmark))
|
||||
(defun mu-headers-unmark-all () (interactive) (mu-headers-mark 'unmark-all))
|
||||
|
||||
(defun mu-headers-reply ()
|
||||
"Reply to the message at point"
|
||||
(interactive)
|
||||
(let ((path (mu-headers-get-path)))
|
||||
(if path
|
||||
(mu-message-reply path)
|
||||
(message "No message at point"))))
|
||||
|
||||
(defun mu-headers-forward ()
|
||||
"Reply to the message at point"
|
||||
(interactive)
|
||||
(let ((path (mu-headers-get-path)))
|
||||
(if path
|
||||
(mu-message-forward path)
|
||||
(message "No message at point"))))
|
||||
|
||||
|
||||
(provide 'mu-headers)
|
||||
|
||||
@ -1,165 +0,0 @@
|
||||
;;; mu-message.el -- use `mu' from emacs
|
||||
;; Copyright (C) 2011 Dirk-Jan C. Binnema
|
||||
|
||||
;; Author: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||
;; Maintainer: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||
;; Keywords: email
|
||||
;; Version: 0.0
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; mu-message contains code to generate a message for composing, replying or
|
||||
;; forwarding
|
||||
|
||||
;;; Code:
|
||||
(require 'mu-common)
|
||||
|
||||
(defvar mu-message-citation-prefix "> "
|
||||
"string to prefix cited message parts with")
|
||||
|
||||
(defvar mu-message-reply-prefix "Re:"
|
||||
"string to prefix the subject of replied messages with")
|
||||
|
||||
(defvar mu-message-forward-prefix "Fwd:"
|
||||
"string to prefix the subject of forwarded messages with")
|
||||
|
||||
(defun mu-message-user-agent ()
|
||||
(format "mu %s; emacs %s" (mu-binary-version) emacs-version))
|
||||
|
||||
(defun mu-message-attribution (msg)
|
||||
"get an attribution line for a quoted message"
|
||||
(format "On %s, %s wrote:\n"
|
||||
(format-time-string mu-date-format-long (plist-get msg :date))
|
||||
(cdr (car (plist-get msg :from)))))
|
||||
|
||||
(defun mu-message-cite (msg)
|
||||
"cite an existing message"
|
||||
(let ((body
|
||||
(or (plist-get msg :body-txt)
|
||||
(let ((html (plist-get msg :body-html)))
|
||||
(when html
|
||||
(with-temp-buffer (insert html) (html2text) (buffer-string))))
|
||||
"")))
|
||||
(replace-regexp-in-string "^" " > " body)))
|
||||
|
||||
(defun mu-message-recipients-remove (lst email-to-remove)
|
||||
"remove the recipient with EMAIL from the recipient list (of
|
||||
form '( (\"A\" . \"a@example.com\") (\"B\" . \"B@example.com\"))"
|
||||
(remove-if (lambda (name-email)
|
||||
(string= email-to-remove (downcase (cdr name-email))))
|
||||
lst))
|
||||
|
||||
(defun mu-message-recipients-to-string (lst)
|
||||
"convert a recipient list (of form '( (\"A\"
|
||||
. \"a@example.com\") (\"B\" . \"B@example.com\") into a string
|
||||
useful for from/to headers"
|
||||
(message "recips: %S" lst)
|
||||
(mapconcat
|
||||
(lambda (recip)
|
||||
(let ((name (car recip)) (email (cdr recip)))
|
||||
(format "%s <%s>" (or name "") email))) lst ", "))
|
||||
|
||||
(defun mu-message-hidden-header (hdr val)
|
||||
"return user-invisible header to the message (HDR: VAL\n)"
|
||||
(propertize (format "%s: %s\n" hdr val) 'invisible t))
|
||||
|
||||
(defun mu-message-reply (path)
|
||||
"create a reply to the message at PATH. After creation, switch
|
||||
to the message editor"
|
||||
(let* ((cmd (concat mu-binary " view --format=sexp " path))
|
||||
(str (shell-command-to-string cmd))
|
||||
(msg (car (read-from-string str)))
|
||||
(buf (get-buffer-create
|
||||
(generate-new-buffer-name "*mu-draft*")))
|
||||
(to-lst (mu-message-recipients-remove
|
||||
(append (plist-get msg :from) (plist-get msg :to))
|
||||
user-mail-address))
|
||||
(cc-lst (mu-message-recipients-remove (plist-get msg :cc)
|
||||
user-mail-address)))
|
||||
|
||||
(with-current-buffer buf
|
||||
(insert
|
||||
(format "From: %s <%s>\n" user-full-name user-mail-address)
|
||||
(mu-message-hidden-header "User-agent" (mu-message-user-agent))
|
||||
(if (boundp 'mail-reply-to) (insert (format "Reply-To: %s\n"
|
||||
mail-reply-to)) "")
|
||||
(format "To: %s\n" (if to-lst (mu-message-recipients-to-string to-lst) ""))
|
||||
(if cc-lst
|
||||
(format "Cc: %s\n" (mu-message-recipients-to-string cc-lst)))
|
||||
"Subject: " mu-message-reply-prefix (plist-get msg :subject) "\n"
|
||||
"--text follows this line--\n\n"
|
||||
|
||||
(mu-message-attribution msg)
|
||||
(mu-message-cite msg)))
|
||||
|
||||
(switch-to-buffer buf)
|
||||
(message-mode)
|
||||
(message-goto-body)))
|
||||
|
||||
|
||||
(defun mu-message-forward (path)
|
||||
"create a forward to the message at PATH. After creation, switch
|
||||
to the message editor"
|
||||
(let* ((cmd (concat mu-binary " view --format=sexp " path))
|
||||
(str (shell-command-to-string cmd))
|
||||
(msg (car (read-from-string str)))
|
||||
(buf (get-buffer-create
|
||||
(generate-new-buffer-name "*mu-draft*"))))
|
||||
|
||||
(with-current-buffer buf
|
||||
(insert
|
||||
(format "From: %s <%s>\n" user-full-name user-mail-address)
|
||||
(mu-message-hidden-header "User-agent" (mu-message-user-agent))
|
||||
"To: \n"
|
||||
"Subject: " mu-message-forward-prefix (plist-get msg :subject) "\n"
|
||||
"--text follows this line--\n\n"
|
||||
|
||||
(mu-message-attribution msg)
|
||||
(mu-message-cite msg)))
|
||||
|
||||
(switch-to-buffer buf)
|
||||
(message-mode)
|
||||
(message-goto-to)))
|
||||
|
||||
(defun mu-message-move (src targetdir)
|
||||
"move message at PATH using 'mu mv'; if targetdir is
|
||||
'/dev/null', move immediately. Return t if succeeded, nil
|
||||
otherwise"
|
||||
(let* ((cmd (concat
|
||||
mu-binary " mv --printtarget "
|
||||
(shell-quote-argument src) " "
|
||||
(shell-quote-argument targetdir)))
|
||||
(fulltarget (shell-command-to-string cmd)))
|
||||
(mu-log cmd)
|
||||
|
||||
(mu-log
|
||||
(if fulltarget (concat "Message has been moved to " fulltarget)
|
||||
"Message moving failed"))
|
||||
;; now, if saving worked, anynchronously try to update the database
|
||||
(when fulltarget
|
||||
(mu-log "Removing from database: %s" src)
|
||||
(start-process " *mu-remove*" nil mu-binary "remove" src)
|
||||
|
||||
(if (string= targetdir "/dev/null")
|
||||
t
|
||||
(mu-log "Adding to database: %s" fulltarget)
|
||||
(start-process " *mu-add*" nil mu-binary "add" fulltarget) t))))
|
||||
|
||||
;; note, we don't check the result of the db output
|
||||
|
||||
(provide 'mu-message)
|
||||
221
emacs/mu-view.el
221
emacs/mu-view.el
@ -1,221 +0,0 @@
|
||||
;;; mu-view.el -- use `mu' from emacs
|
||||
;; Copyright (C) 2011 Dirk-Jan C. Binnema
|
||||
|
||||
;; Author: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||
;; Maintainer: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||
;; Keywords: email
|
||||
;; Version: 0.0
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theq
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; mu message has functions to display a single message
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'mu-common)
|
||||
|
||||
(defvar mu-view-header-fields
|
||||
'( :from
|
||||
:to
|
||||
:subject
|
||||
:date
|
||||
:attachments
|
||||
:path)
|
||||
"list of header fields to display in the message view")
|
||||
|
||||
(defconst mu-view-buffer-name " *mu-view*")
|
||||
(defvar mu-view-headers-buffer nil "the headers buffer (if any)
|
||||
from which this buffer was invoked (buffer local)")
|
||||
|
||||
(defun mu-view-header (field val val-face)
|
||||
"get a header string (like 'Subject: foo')"
|
||||
(when val
|
||||
(concat (propertize field 'face 'mu-header-face) ": "
|
||||
(propertize val 'face val-face) "\n")))
|
||||
|
||||
(defun mu-view-header-contact (field lst face)
|
||||
(when lst
|
||||
(let* ((header (concat (propertize field 'face 'mu-header-face) ": "))
|
||||
(val (mapconcat (lambda(c)
|
||||
(propertize (or (car c) (cdr c) "?") 'face face))
|
||||
lst ",")))
|
||||
(concat header val "\n"))))
|
||||
|
||||
|
||||
(defun mu-view-header-contact (field lst face)
|
||||
(when lst
|
||||
(let* ((header (concat (propertize field 'face 'mu-header-face) ": "))
|
||||
(val (mapconcat (lambda(c)
|
||||
(propertize (or (car c) (cdr c) "?") 'face face))
|
||||
lst ", ")))
|
||||
(concat header val "\n"))))
|
||||
|
||||
(defun mu-view-header-attachments (field lst face)
|
||||
(when lst
|
||||
(let* ((header (concat (propertize field 'face 'mu-header-face) ": "))
|
||||
(val (mapconcat
|
||||
(lambda(att)
|
||||
(let ((idx (nth 0 att)) (fname (nth 1 att)) (ctype (nth 2 att)))
|
||||
(propertize fname 'face face)))
|
||||
lst ", ")))
|
||||
(concat header val "\n"))))
|
||||
|
||||
(defun mu-view-body (msg face)
|
||||
"view the body; try text first, if that does not work, try html"
|
||||
(cond
|
||||
((plist-get msg :body-txt) (propertize (plist-get msg :body-txt) 'face face))
|
||||
((plist-get msg :body-html)
|
||||
(propertize
|
||||
(with-temp-buffer
|
||||
(insert (plist-get msg :body-html))
|
||||
(html2text)
|
||||
(buffer-string)) 'face face))
|
||||
(t "")))
|
||||
|
||||
(defun mu-view-message (path)
|
||||
"display the email message at PATH"
|
||||
(let ((msg (mu-get-message path)))
|
||||
(when msg
|
||||
(concat
|
||||
(mapconcat
|
||||
(lambda (field)
|
||||
(case field
|
||||
(:from (mu-view-header-contact "From"
|
||||
(plist-get msg :from) 'mu-from-face))
|
||||
(:to
|
||||
(mu-view-header-contact "To" (plist-get msg :to) 'mu-to-face))
|
||||
(:cc
|
||||
(mu-view-header-contact "Cc" (plist-get msg :cc) 'mu-to-face))
|
||||
(:bcc
|
||||
(mu-view-header-contact "Bcc" (plist-get msg :bcc) 'mu-to-face))
|
||||
(:subject
|
||||
(mu-view-header "Subject" (plist-get msg :subject) 'mu-subject-face))
|
||||
(:path
|
||||
(mu-view-header "Path" (plist-get msg :path) 'mu-path-face))
|
||||
(:date
|
||||
(mu-view-header "Date"
|
||||
(format-time-string mu-date-format-long
|
||||
(plist-get msg :date)) 'mu-date-face))
|
||||
(:attachments
|
||||
(mu-view-header-attachments "Attachments" (plist-get msg :attachments)
|
||||
'mu-path-face)
|
||||
)))
|
||||
mu-view-header-fields "")
|
||||
"\n"
|
||||
(mu-view-body msg 'mu-body-face)
|
||||
))))
|
||||
|
||||
;; note: mu-view sets path as a text-property ('path) for the whole buffer, just
|
||||
;; like mu-headers does it per-header
|
||||
(defun mu-view (path parentbuf)
|
||||
"display message at PATH in a new buffer; note that the action
|
||||
of viewing a message may cause it to be moved/renamed; this
|
||||
function returns the resulting name. PARENTBUF refers to the
|
||||
buffer who invoked this view; this allows us to return there when
|
||||
we quit from this view. Also, if PARENTBUF is a find buffer (ie.,
|
||||
has mu-headers-mode as its major mode), this allows various
|
||||
commands (navigation, marking etc.) to be applied to this
|
||||
buffer."
|
||||
(let ((str (mu-view-message path))
|
||||
(buf (mu-get-new-buffer mu-view-buffer-name)))
|
||||
(when str
|
||||
(switch-to-buffer buf)
|
||||
(insert str))
|
||||
(mu-view-mode)
|
||||
|
||||
(setq ;; these are buffer-local
|
||||
mu-parent-buffer parentbuf
|
||||
mu-view-headers-buffer parentbuf
|
||||
mu-path path)
|
||||
|
||||
(goto-char (point-min))))
|
||||
|
||||
(defvar mu-view-mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map "q" 'mu-quit-buffer)
|
||||
(define-key map "s" 'mu-headers)
|
||||
(define-key map "f" 'mu-forward)
|
||||
(define-key map "r" 'mu-reply)
|
||||
|
||||
;; navigation between messages
|
||||
(define-key map "n" 'mu-view-next)
|
||||
(define-key map "p" 'mu-view-prev)
|
||||
|
||||
;; marking/unmarking
|
||||
(define-key map "d" '(lambda (mu-view-mark 'trash)))
|
||||
(define-key map "D" '(lambda (mu-view-mark 'delete)))
|
||||
(define-key map "m" '(lambda (mu-view-mark 'move)))
|
||||
(define-key map "u" '(lambda (mu-view-mark 'unmark)))
|
||||
(define-key map "x" 'mu-view-marked-execute)
|
||||
|
||||
map)
|
||||
"Keymap for \"mu-view\" buffers.")
|
||||
(fset 'mu-view-mode-map mu-view-mode-map)
|
||||
|
||||
(defun mu-view-mode ()
|
||||
"major mode for viewing an e-mail message"
|
||||
(interactive)
|
||||
(kill-all-local-variables)
|
||||
(use-local-map mu-view-mode-map)
|
||||
|
||||
(make-local-variable 'mu-parent-buffer)
|
||||
(make-local-variable 'mu-headers-buffer)
|
||||
(make-local-variable 'mu-path)
|
||||
|
||||
(setq major-mode 'mu-view-mode mode-name "*mu-view*")
|
||||
(setq truncate-lines t buffer-read-only t))
|
||||
|
||||
(defmacro with-current-headers-buffer (&rest body)
|
||||
"Execute the forms in BODY with BUFFER-OR-NAME temporarily current.
|
||||
BUFFER-OR-NAME must be a buffer or the name of an existing buffer.
|
||||
The value returned is the value of the last form in BODY. See
|
||||
also `with-temp-buffer'."
|
||||
(declare (indent 1) (debug t))
|
||||
`(if (and mu-view-headers-buffer (buffer-live-p mu-view-headers-buffer))
|
||||
(save-current-buffer
|
||||
(set-buffer mu-view-headers-buffer)
|
||||
,@body)
|
||||
(message "No headers-buffer connected")))
|
||||
|
||||
(defun mu-view-next ()
|
||||
"move to the next message"
|
||||
(interactive)
|
||||
(with-current-headers-buffer
|
||||
(when (mu-headers-next)
|
||||
(mu-view (mu-headers-get-path) (current-buffer)))))
|
||||
|
||||
(defun mu-view-prev ()
|
||||
"move to the previous message"
|
||||
(interactive)
|
||||
(with-current-headers-buffer
|
||||
(when (mu-headers-prev)
|
||||
(mu-view (mu-headers-get-path) (current-buffer)))))
|
||||
|
||||
(defun mu-view-mark (mark)
|
||||
"mark for MARK"
|
||||
(interactive)
|
||||
(with-current-headers-buffer (mu-headers-mark mark)))
|
||||
|
||||
;; we don't allow executing marks from the view buffer, to protect user from
|
||||
;; accidentally deleting stuff...
|
||||
(defun mu-view-marked-execute ()
|
||||
"give user a warning"
|
||||
(interactive)
|
||||
(message "Please go back to the headers list to execute your marks"))
|
||||
|
||||
(provide 'mu-view)
|
||||
68
emacs/mu.el
68
emacs/mu.el
@ -1,68 +0,0 @@
|
||||
;;; mu.el -- use `mu' from emacs
|
||||
;; Copyright (C) 2011 Dirk-Jan C. Binnema
|
||||
|
||||
;; Author: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||
;; Maintainer: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||
;; Keywords: email
|
||||
;; Version: 0.0
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;;; Code:
|
||||
(require 'mu-view)
|
||||
(require 'mu-headers)
|
||||
(require 'mu-message)
|
||||
|
||||
(define-key mu-headers-mode-map "q" 'mu-quit-buffer)
|
||||
(define-key mu-headers-mode-map "f" 'mu-headers)
|
||||
(define-key mu-headers-mode-map (kbd "<up>") 'mu-headers-prev)
|
||||
(define-key mu-headers-mode-map (kbd "<down>") 'mu-headers-next)
|
||||
(define-key mu-headers-mode-map (kbd "RET") 'mu-headers-view)
|
||||
(define-key mu-headers-mode-map "n" 'mu-headers-next)
|
||||
(define-key mu-headers-mode-map "p" 'mu-headers-prev)
|
||||
(define-key mu-headers-mode-map "o" 'mu-headers-change-sort)
|
||||
(define-key mu-headers-mode-map "g" 'mu-headers-refresh)
|
||||
(define-key mu-headers-mode-map "m" 'mu-headers-mark-for-move)
|
||||
(define-key mu-headers-mode-map "d" 'mu-headers-mark-for-trash)
|
||||
(define-key mu-headers-mode-map "D" 'mu-headers-mark-for-deletion)
|
||||
(define-key mu-headers-mode-map "u" 'mu-headers-unmark)
|
||||
(define-key mu-headers-mode-map "U" 'mu-headers-unmark-all)
|
||||
(define-key mu-headers-mode-map "r" 'mu-headers-reply)
|
||||
(define-key mu-headers-mode-map "f" 'mu-headers-forward)
|
||||
(define-key mu-headers-mode-map "x" 'mu-headers-marks-execute)
|
||||
|
||||
|
||||
(define-key mu-view-mode-map "q" 'mu-quit-buffer)
|
||||
(define-key mu-view-mode-map "f" 'mu-view-find)
|
||||
(define-key mu-view-mode-map "n" 'mu-view-next)
|
||||
(define-key mu-view-mode-map "p" 'mu-view-prev)
|
||||
(define-key mu-view-mode-map "r" 'mu-reply)
|
||||
(define-key mu-view-mode-map "f" 'mu-forward)
|
||||
(define-key mu-view-mode-map "x" 'mu-execute)
|
||||
(define-key mu-view-mode-map "m" 'mu-view-mark-for-move)
|
||||
(define-key mu-view-mode-map "d" 'mu-view-mark-for-trash)
|
||||
(define-key mu-view-mode-map "D" 'mu-view-mark-for-deletion)
|
||||
(define-key mu-view-mode-map "u" 'mu-view-unmark)
|
||||
(define-key mu-view-mode-map "U" 'mu-view-unmark-all)
|
||||
(define-key mu-view-mode-map "r" 'mu-view-reply)
|
||||
(define-key mu-view-mode-map "f" 'mu-view-forward)
|
||||
(define-key mu-view-mode-map "x" 'mu-view-marked-execute)
|
||||
|
||||
|
||||
(provide 'mu)
|
||||
|
||||
28
toys/mua/TODO
Normal file
28
toys/mua/TODO
Normal file
@ -0,0 +1,28 @@
|
||||
* TODO
|
||||
|
||||
[ ] message un-new in find/view
|
||||
[ ] set 'Replied' flag on source when message is replied
|
||||
[ ] update database after changes (CHECK)
|
||||
[ ] save message to draft, sent items
|
||||
[ ] attachment handling (open, play) in view
|
||||
|
||||
[ ] abstract away mu/binary, shell-command-to-string
|
||||
[ ] make flag handling a bit more lispy
|
||||
|
||||
[ ] threads support
|
||||
[ ] expandable recipients list in view
|
||||
[ ] additive font props in mu find
|
||||
[ ] fix headers/view interaction
|
||||
|
||||
[ ] region commands
|
||||
[ ] menu
|
||||
[ ] mua-dashboard
|
||||
|
||||
|
||||
# Local Variables:
|
||||
# mode: org; org-startup-folded: nil
|
||||
# End:
|
||||
|
||||
|
||||
|
||||
|
||||
94
toys/mua/mua-common.el
Normal file
94
toys/mua/mua-common.el
Normal file
@ -0,0 +1,94 @@
|
||||
;;; mua-common.el -- part of mua, the mu mail user agent
|
||||
;;
|
||||
;; Copyright (C) 2011 Dirk-Jan C. Binnema
|
||||
|
||||
;; Author: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||
;; Maintainer: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||
;; Keywords: email
|
||||
;; Version: 0.0
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; mua-common contains common utility functions for mua
|
||||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
(defconst mua/log-buffer-name "*mua-log*" "name of the logging buffer")
|
||||
|
||||
(defun mua/warn (frm &rest args)
|
||||
"warn user in echo-area, return nil"
|
||||
(let ((str (apply 'format frm args)))
|
||||
(message str)
|
||||
nil))
|
||||
|
||||
(defun mua/log (frm &rest args)
|
||||
"write something in the *mua-log* buffer - mainly useful for debugging"
|
||||
(with-current-buffer (get-buffer-create mua/log-buffer-name)
|
||||
(goto-char (point-max))
|
||||
(insert (apply 'format (concat (format-time-string "%x %X " (current-time))
|
||||
frm "\n") args))))
|
||||
|
||||
(defun mua/warn-and-log (frm &rest args)
|
||||
"log and warn (ie., mua/warn + mua/log); return nil"
|
||||
(apply 'mua/log frm args)
|
||||
(apply 'mua/warn frm args)
|
||||
nil)
|
||||
|
||||
(defun mua/new-buffer (bufname)
|
||||
"return a new buffer BUFNAME; if such already exists, kill the
|
||||
old one first"
|
||||
(when (get-buffer bufname)
|
||||
(kill-buffer bufname))
|
||||
(get-buffer-create bufname))
|
||||
|
||||
(defun mua/message (frm &rest args)
|
||||
"print a mua message at point"
|
||||
(let ((str (apply 'format frm args)) (inhibit-read-only t))
|
||||
(insert (propertize str 'face 'italic))))
|
||||
|
||||
(defun mua/quit-buffer ()
|
||||
"kill this buffer, and switch to it's parentbuf if it is alive"
|
||||
(interactive)
|
||||
(let ((parentbuf mua/parent-buffer))
|
||||
(kill-buffer)
|
||||
(when (and parentbuf (buffer-live-p parentbuf))
|
||||
(switch-to-buffer parentbuf))))
|
||||
|
||||
(defun mua/ask-maildir (prompt &optional fullpath)
|
||||
"ask user with PROMPT for a maildir name, if fullpath is
|
||||
non-nill, return the fulpath (ie, mu-maildir prepended to the
|
||||
maildir"
|
||||
(interactive)
|
||||
(let* ((showfolders
|
||||
(delete-dups
|
||||
(append (list mua/inbox-folder mua/sent-folder)
|
||||
mua/working-folders)))
|
||||
(chosen (ido-completing-read prompt showfolders)))
|
||||
(concat (if fullpath mua/maildir "") chosen)))
|
||||
|
||||
(defun mua/mu-binary-version ()
|
||||
"Get the version of the mu binary."
|
||||
(let ((cmd (concat mua/mu-binary
|
||||
" --version | head -1 | sed 's/.*version //'")))
|
||||
(substring (shell-command-to-string cmd) 0 -1)))
|
||||
|
||||
|
||||
|
||||
(provide 'mua-common)
|
||||
480
toys/mua/mua-hdrs.el
Normal file
480
toys/mua/mua-hdrs.el
Normal file
@ -0,0 +1,480 @@
|
||||
;;; mua-hdrs.el -- part of mua, the mu mail user agent
|
||||
;;
|
||||
;; Copyright (C) 2011 Dirk-Jan C. Binnema
|
||||
|
||||
;; Author: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||
;; Maintainer: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||
;; Keywords: email
|
||||
;; Version: 0.0
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; mu
|
||||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
(require 'mua-common)
|
||||
(require 'mua-msg)
|
||||
|
||||
;; note: these next two are *not* buffer-local, so they persist during a session
|
||||
(defvar mua/hdrs-sortfield nil "field to sort headers by")
|
||||
(defvar mua/hdrs-sort-descending nil "whether to sort in descending order")
|
||||
|
||||
(defvar mua/header-fields
|
||||
'( (:date . 25)
|
||||
(:from-or-to . 22)
|
||||
(:subject . 40))
|
||||
"a list of fields and their widths")
|
||||
|
||||
|
||||
;; internal stuff
|
||||
(defvar mua/buf "" "buffer for results data")
|
||||
(defvar mua/last-expression "the last search expression")
|
||||
(defvar mua/hdrs-process "the mu-find process")
|
||||
(defvar mua/hdrs-hash nil "the bol->path hash")
|
||||
(defvar mua/hdrs-marks-hash nil "the hash for marked messages")
|
||||
|
||||
(defconst mua/eom "\n;;eom\n" "marker for the end of message in
|
||||
the mu find output")
|
||||
(defconst mua/hdrs-buffer-name "*mua-headers*"
|
||||
"name of the mua headers buffer")
|
||||
|
||||
(defun mua/hdrs-proc-filter (proc str)
|
||||
"process-filter for the 'mu find --format=sexp output; it
|
||||
accumulates the strings into valid sexps by checking of the
|
||||
';;eom' end-of-msg marker, and then evaluating them"
|
||||
(let ((procbuf (process-buffer proc)))
|
||||
(when (buffer-live-p procbuf)
|
||||
(with-current-buffer procbuf
|
||||
(save-excursion
|
||||
(setq mua/buf (concat mua/buf str))
|
||||
(let ((eom (string-match mua/eom mua/buf)))
|
||||
(while (numberp eom)
|
||||
(let* ((msg (mua/msg-from-string(substring mua/buf 0 eom))))
|
||||
(save-match-data (mua/hdrs-append-message msg))
|
||||
(setq mua/buf (substring mua/buf (match-end 0)))
|
||||
(setq eom (string-match mua/eom mua/buf))))))))))
|
||||
|
||||
|
||||
(defun mua/hdrs-proc-sentinel (proc msg)
|
||||
"Check the process upon completion"
|
||||
(let ((procbuf (process-buffer proc))
|
||||
(status (process-status proc))
|
||||
(exit-status (process-exit-status proc)))
|
||||
(when (and (buffer-live-p procbuf) (memq status '(exit signal)))
|
||||
(let ((msg
|
||||
(case status
|
||||
('signal "Search process killed (results incomplete)")
|
||||
('exit
|
||||
(case exit-status
|
||||
(0 "End of search results")
|
||||
(1 "mu find error")
|
||||
(2 "No matches found")
|
||||
(4 "Database problem; try running 'mu index'")
|
||||
(t (format "Some error occured; mu find returned %d"
|
||||
exit-status)))))))
|
||||
(with-current-buffer procbuf
|
||||
(save-excursion
|
||||
(goto-char (point-max))
|
||||
(mua/message msg)))
|
||||
|
||||
(unless (= exit-status 0)
|
||||
(mua/log "mu find exit with %d" exit-status))))))
|
||||
|
||||
(defun mua/hdrs-search-execute (expr buf)
|
||||
"search in the mu database; output the results in buffer BUF"
|
||||
(let ((args `("find" "--format=sexp" ,expr)))
|
||||
(when mua/mu-home
|
||||
(add-to-list args (concat "--muhome=" mua/mu-home)))
|
||||
(when mua/hdrs-sortfield
|
||||
(add-to-list args (concat "--sortfield=" mua/hdrs-sortfield)))
|
||||
(when mua/hdrs-sort-descending
|
||||
(add-to-list args "--descending"))
|
||||
(mua/log "Searching for %s with %S" expr args)
|
||||
|
||||
;; now, do it!
|
||||
(let ((proc (apply 'start-process "*mua-headers*" buf mua/mu-binary args)))
|
||||
(setq
|
||||
mua/buf ""
|
||||
mua/hdrs-process proc)
|
||||
(set-process-filter proc 'mua/hdrs-proc-filter)
|
||||
(set-process-sentinel proc 'mua/hdrs-proc-sentinel))))
|
||||
|
||||
;; Note, the 'mu find --format=sexp' sexp is almost the same as the ones that
|
||||
;; 'mu view --format=sexp' produces (see mu-get-message), with the difference
|
||||
;; that former may give more than one result, and that mu-headers output comes
|
||||
;; from the database rather than file, and does _not_ contain the message body
|
||||
(defun mua/hdrs-search (expr)
|
||||
"search in the mu database"
|
||||
(interactive "s[mu] search for: ")
|
||||
(setq debug-on-error t)
|
||||
|
||||
;; kill running process if needed
|
||||
(when (and mua/hdrs-process
|
||||
(eq (process-status mua/hdrs-process) 'run))
|
||||
(kill-process mua/hdrs-process))
|
||||
|
||||
(let ((buf (mua/new-buffer mua/hdrs-buffer-name)))
|
||||
(switch-to-buffer buf)
|
||||
(mua/hdrs-mode)
|
||||
(setq
|
||||
mua/last-expression expr
|
||||
mua/hdrs-hash (make-hash-table :size 256 :rehash-size 2)
|
||||
mua/hdrs-marks-hash (make-hash-table :size 16 :rehash-size 2))
|
||||
(mua/log "searching for %S" expr)
|
||||
(mua/hdrs-search-execute expr buf)))
|
||||
|
||||
|
||||
(defun mua/hdrs-mode ()
|
||||
"major mode for displaying mua search results"
|
||||
(interactive)
|
||||
(kill-all-local-variables)
|
||||
(use-local-map mua/hdrs-mode-map)
|
||||
|
||||
(make-local-variable 'mua/buf)
|
||||
(make-local-variable 'mua/last-expression)
|
||||
(make-local-variable 'mua/hdrs-process)
|
||||
(make-local-variable 'mua/hdrs-hash)
|
||||
(make-local-variable 'mua/hdrs-marks-hash)
|
||||
|
||||
(setq
|
||||
major-mode 'mu-headers-mode mode-name "*headers*"
|
||||
truncate-lines t buffer-read-only t
|
||||
overwrite-mode 'overwrite-mode-binary))
|
||||
|
||||
(defun mua/hdrs-line (msg)
|
||||
"return line describing a message (ie., a header line)"
|
||||
(let
|
||||
((hdr
|
||||
(mapconcat
|
||||
(lambda(fieldpair)
|
||||
(let ((field (car fieldpair)) (width (cdr fieldpair)))
|
||||
(case field
|
||||
(:subject (mua/hdrs-header msg :subject width))
|
||||
(:to (mua/hdrs-contact msg field width))
|
||||
(:from (mua/hdrs-contact msg field width))
|
||||
;;(:from-or-to (mua/msg-header-header-from-or-to msg width 'mua/header-face))
|
||||
(:cc (mua/hdrs-contact msg field width))
|
||||
(:bcc (mua/hdrs-contact msg field width))
|
||||
(:date (mua/hdrs-date msg width))
|
||||
(:flags (mua/hdrs-flags msg width))
|
||||
(:size (mua/hdrs-size msg width))
|
||||
(t (error "Unsupported field: %S" field))
|
||||
)))
|
||||
mua/header-fields " ")))
|
||||
hdr))
|
||||
|
||||
;;
|
||||
;; Note: we maintain a hash table to remember what message-path corresponds to a
|
||||
;; certain line in the buffer. (mua/hdrs-set-path, mua/hdrs-get-path)
|
||||
;;
|
||||
;; data is stored like the following: for each header-line, we
|
||||
;; take the (point) at beginning-of-line (bol) and use that as the key in the
|
||||
;; mu-headers-hash hash, which does
|
||||
;;
|
||||
;; point-of-bol -> path
|
||||
;;
|
||||
|
||||
(defun mua/hdrs-set-path (path)
|
||||
"map the bol of the current header to a path"
|
||||
(puthash (line-beginning-position 1) path mua/hdrs-hash))
|
||||
|
||||
(defun mua/hdrs-get-path ()
|
||||
"get the path for the header at point"
|
||||
(gethash (line-beginning-position 1) mua/hdrs-hash))
|
||||
|
||||
(defun mua/hdrs-append-message (msg)
|
||||
"append a message line to the buffer and register the message"
|
||||
(let ((line (mua/hdrs-line msg)) (inhibit-read-only t))
|
||||
(save-excursion
|
||||
(goto-char (point-max))
|
||||
(mua/hdrs-set-path (mua/msg-field msg :path))
|
||||
(insert " " line "\n"))))
|
||||
|
||||
|
||||
;; Now follow a bunch of function to turn some message field in a
|
||||
;; string for display
|
||||
|
||||
(defun mua/hdrs-header (msg field width)
|
||||
"get a string at WIDTH (truncate or ' '-pad) for display as a
|
||||
header"
|
||||
(let* ((str (mua/msg-field msg field)) (str (if str str "")))
|
||||
(propertize (truncate-string-to-width str width 0 ?\s t)
|
||||
'face 'mua/header-face)))
|
||||
|
||||
(defun mua/hdrs-contact (msg field width)
|
||||
"get display string for a list of contacts in a header, truncated for
|
||||
fitting in WIDTH"
|
||||
(unless (member field '(:to :from :bcc :cc))
|
||||
(error "Illegal type for contact"))
|
||||
(let* ((lst (mua/msg-field msg field))
|
||||
(str (mapconcat
|
||||
(lambda (ctc)
|
||||
(let ((name (car ctc)) (email (cdr ctc)))
|
||||
(or name email "?"))) lst ",")))
|
||||
(propertize (truncate-string-to-width str width 0 ?\s t)
|
||||
'face 'mua/contacts-face)))
|
||||
|
||||
|
||||
(defun mua/hdrs-size (msg width)
|
||||
"return a string for size of MSG of WIDTH"
|
||||
(let* ((size (mua/msg-field msg :size))
|
||||
((str
|
||||
(cond
|
||||
((>= size 1000000) (format "%2.1fM" (/ size 1000000.0)))
|
||||
((and (>= size 1000) (< size 1000000)) (format "%2.1fK" (/ size 1000.0)))
|
||||
((< size 1000) (format "%d" size)))))
|
||||
(propertize (truncate-string-to-width str width 0 ?\s)
|
||||
'face 'mua/header-face))))
|
||||
|
||||
|
||||
(defun mua/hdrs-date (msg width)
|
||||
"return a string for the date of MSG of WIDTH"
|
||||
(let* ((date (mua/msg-field msg :date)))
|
||||
(if date
|
||||
(propertize (truncate-string-to-width (format-time-string "%x %X" date)
|
||||
width 0 ?\s) 'face 'mua/date-face))))
|
||||
|
||||
(defun mua/hdrs-flags (msg width)
|
||||
(let* ((flags (mua/msg-field msg :flags))
|
||||
(flagstr
|
||||
(mapconcat
|
||||
(lambda(flag)
|
||||
(case flag
|
||||
('unread "U")
|
||||
('seen "S")
|
||||
('replied "R")
|
||||
('attach "a")
|
||||
('encrypted "x")
|
||||
('signed "s"))) flags "")))
|
||||
(propertize (truncate-string-to-width flagstr width 0 ?\s)
|
||||
'face 'mua/header-face)))
|
||||
|
||||
|
||||
;; some keybinding / functions for basic navigation
|
||||
|
||||
(defvar mua/hdrs-mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
|
||||
(define-key map "s" 'mua/hdrs-search)
|
||||
(define-key map "q" 'mua/quit-buffer)
|
||||
(define-key map "o" 'mua/hdrs-change-sort)
|
||||
(define-key map "g" 'mua/hdrs-refresh)
|
||||
|
||||
;; navigation
|
||||
(define-key map "n" 'mua/hdrs-next)
|
||||
(define-key map "p" 'mua/hdrs-prev)
|
||||
(define-key map "j" 'mua/hdrs-jump-to-maildir)
|
||||
|
||||
;; marking/unmarking/executing
|
||||
(define-key map "m" (lambda()(interactive)(mua/hdrs-mark 'move)))
|
||||
(define-key map "d" (lambda()(interactive)(mua/hdrs-mark 'trash)))
|
||||
(define-key map "D" (lambda()(interactive)(mua/hdrs-mark 'delete)))
|
||||
(define-key map "u" (lambda()(interactive)(mua/hdrs-mark 'unmark)))
|
||||
(define-key map "U" (lambda()(interactive)(mua/hdrs-mark 'unmark-all)))
|
||||
(define-key map "x" 'mua/hdrs-marks-execute)
|
||||
|
||||
;; message composition
|
||||
(define-key map "r" 'mua/hdrs-reply)
|
||||
(define-key map "f" 'mua/hdrs-forward)
|
||||
(define-key map "c" 'mua/hdrs-compose)
|
||||
|
||||
|
||||
(define-key map (kbd "RET") 'mua/hdrs-view)
|
||||
map)
|
||||
"Keymap for *mua-headers* buffers.")
|
||||
(fset 'mua/hdrs-mode-map mua/hdrs-mode-map)
|
||||
|
||||
(defun mua/hdrs-next ()
|
||||
"go to the next line; t if it worked, nil otherwise"
|
||||
(interactive) ;; TODO: check if next line has path, if not, don't go there
|
||||
(if (or (/= 0 (forward-line 1)) (not (mua/hdrs-get-path)))
|
||||
(mua/warn "No message after this one")
|
||||
(progn
|
||||
(mua/log "At: %d [%S]" (point) (mua/hdrs-get-path)) t)))
|
||||
|
||||
|
||||
(defun mua/hdrs-prev ()
|
||||
"go to the previous line; t if it worked, nil otherwise"
|
||||
(interactive)
|
||||
(if (or (/= 0 (forward-line -1)) (not (mua/hdrs-get-path)))
|
||||
(mua/warn "No message before this one")
|
||||
(progn
|
||||
(mua/log "At: %d [%S]" (point) (mua/hdrs-get-path)) t)))
|
||||
|
||||
|
||||
(defun mua/hdrs-view ()
|
||||
(interactive)
|
||||
(let ((path (mua/hdrs-get-path)))
|
||||
(if path
|
||||
(mua/view path (current-buffer))
|
||||
(mua/warn "No message at point"))))
|
||||
|
||||
(defun mua/hdrs-jump-to-maildir ()
|
||||
"Show the messages in one of the standard folders."
|
||||
(interactive)
|
||||
(let ((fld (mua/ask-maildir "Jump to maildir: ")))
|
||||
(mua/hdrs-search (concat "maildir:" fld))))
|
||||
|
||||
(defun mua/hdrs-refresh ()
|
||||
"Re-run the query for the current search expression, but only
|
||||
if the search process is not already running"
|
||||
(interactive)
|
||||
(when mua/last-expression (mua/hdrs-search mua/last-expression)))
|
||||
|
||||
|
||||
;;; functions for sorting
|
||||
(defun mua/hdrs-change-sort-order (fieldchar)
|
||||
"Change the sortfield to FIELDCHAR."
|
||||
(interactive "cField to sort by ('d', 's', etc.; see mu-headers(1)):\n")
|
||||
(let ((field
|
||||
(case fieldchar
|
||||
(?b "bcc")
|
||||
(?c "cc")
|
||||
(?d "date")
|
||||
(?f "from")
|
||||
(?i "msgid")
|
||||
(?m "maildir")
|
||||
(?p "prio")
|
||||
(?s "subject")
|
||||
(?t "to")
|
||||
(?z "size"))))
|
||||
(if field
|
||||
(setq mua/hdrs-sortfield field)
|
||||
(mua/warn "Invalid sort-field; use one of bcdfimpstz (see mu-headers(1)"))
|
||||
field))
|
||||
|
||||
(defun mua/hdrs-change-sort-direction (dirchar)
|
||||
"Change the sort direction, either [a]scending or [d]escending."
|
||||
(interactive)
|
||||
(setq mua/hdrs-sort-descending
|
||||
(y-or-n-p "Set sorting direction to descending(y) or ascending(n)")))
|
||||
|
||||
|
||||
(defun mua/hdrs-change-sort ()
|
||||
"Change thee sort field and direction."
|
||||
(interactive)
|
||||
(and (call-interactively 'mua/hdrs-change-sort-order)
|
||||
(call-interactively 'mua/hdrs-change-sort-direction)))
|
||||
|
||||
|
||||
|
||||
;;; functions for marking
|
||||
|
||||
(defun mua/hdrs-add-marked (src &optional dst)
|
||||
"Add the message at point to the markings hash"
|
||||
(let ((bol (line-beginning-position 1)))
|
||||
(if (gethash bol mua/hdrs-marks-hash)
|
||||
(mua/warn "Message is already marked")
|
||||
(progn (puthash bol (cons src dst) mua/hdrs-marks-hash) t))))
|
||||
|
||||
(defun mua/hdrs-remove-marked ()
|
||||
"Remove the message at point from the markings hash"
|
||||
(let ((bol (line-beginning-position 1)))
|
||||
(if (not (gethash bol mua/hdrs-marks-hash))
|
||||
(mua/warn "Message is not marked")
|
||||
(progn (remhash bol mua/hdrs-marks-hash) t))))
|
||||
|
||||
(defun mua/hdrs-set-marker (kar)
|
||||
"Set the marker at the beginning of this line."
|
||||
(beginning-of-line 1)
|
||||
(let ((inhibit-read-only t))
|
||||
(delete-char 2)
|
||||
(insert (if kar (format "%c " kar) " "))))
|
||||
|
||||
(defun mua/hdrs-mark (action)
|
||||
"Mark the message at point with one of the symbols: move,
|
||||
delete, trash, unmark, unmark-all; the latter two are
|
||||
pseudo-markings."
|
||||
(let ((target) (src (mua/hdrs-get-path)))
|
||||
(when src
|
||||
(case action
|
||||
(move
|
||||
(when (mua/hdrs-add-marked src
|
||||
(mua/ask-maildir "Target maildir: " t)) ;; t->return fullpath
|
||||
(mua/hdrs-set-marker ?m)))
|
||||
(trash
|
||||
(when (mua/hdrs-add-marked src
|
||||
(concat mua/maildir mua/trash-folder))
|
||||
(mua/hdrs-set-marker ?d)))
|
||||
(delete
|
||||
(when (mua/hdrs-add-marked src "/dev/null")
|
||||
(mua/hdrs-set-marker ?D)))
|
||||
(unmark
|
||||
(when (mua/hdrs-remove-marked)
|
||||
(mua/hdrs-set-marker nil)))
|
||||
(unmark-all
|
||||
(when (y-or-n-p (format "Sure you want to remove all (%d) marks? "
|
||||
(hash-table-count mua/hdrs-marks-hash)))
|
||||
(save-excursion
|
||||
(maphash (lambda (k v) (goto-char k) (mua/hdrs-mark 'unmark))
|
||||
mua/hdrs-marks-hash))))
|
||||
(t (error "Unsupported mark type")))
|
||||
(move-beginning-of-line 2))))
|
||||
|
||||
(defun mua/hdrs-marks-execute ()
|
||||
"execute the actions for all marked messages"
|
||||
(interactive)
|
||||
(let ((n-marked (hash-table-count mua/hdrs-marks-hash)))
|
||||
(if (= 0 n-marked)
|
||||
(mua/warn "No marked messages")
|
||||
(when (y-or-n-p
|
||||
(format "Execute actions for %d marked message(s)? " n-marked))
|
||||
(save-excursion
|
||||
(maphash
|
||||
(lambda(bol v)
|
||||
(let ((src (car v)) (target (cdr v)) (inhibit-read-only t))
|
||||
(when (mua/msg-move src target)
|
||||
(goto-char bol)
|
||||
(mua/hdrs-remove-marked)
|
||||
(put-text-property (line-beginning-position 1)
|
||||
(line-beginning-position 2)
|
||||
'invisible t)))) ;; when it succeedes, hide msg..)
|
||||
mua/hdrs-marks-hash))))))
|
||||
|
||||
|
||||
|
||||
;; functions for creating new message -- reply, forward, and new
|
||||
(defun mua/hdrs-reply ()
|
||||
"Reply to message at point."
|
||||
(interactive)
|
||||
(let* ((path (mua/hdrs-get-path))
|
||||
(msg (when path (mua/msg-from-path path))))
|
||||
(if msg
|
||||
(mua/msg-compose (mua/msg-create-reply msg
|
||||
(yes-or-no-p "Reply to all? ")))
|
||||
(mua/warn "No message at point"))))
|
||||
|
||||
(defun mua/hdrs-forward ()
|
||||
"Forward the message at point."
|
||||
(interactive)
|
||||
(let* ((path (mua/hdrs-get-path))
|
||||
(msg (when path (mua/msg-from-path path))))
|
||||
(if msg
|
||||
(mua/msg-compose (mua/msg-create-forward msg))
|
||||
(mua/warn "No message at point"))))
|
||||
|
||||
(defun mua/hdrs-compose ()
|
||||
"Create a new messge."
|
||||
(interactive)
|
||||
(mua/msg-compose (mua/msg-create-new)))
|
||||
|
||||
|
||||
(provide 'mua-hdrs)
|
||||
483
toys/mua/mua-msg.el
Normal file
483
toys/mua/mua-msg.el
Normal file
@ -0,0 +1,483 @@
|
||||
;;; mua-msg.el -- part of mua, the mu mail user agent
|
||||
;;
|
||||
;; Copyright (C) 2011 Dirk-Jan C. Binnema
|
||||
|
||||
;; Author: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||
;; Maintainer: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||
;; Keywords: email
|
||||
;; Version: 0.0
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; mua
|
||||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
;; we use some stuff from gnus...
|
||||
(require 'message)
|
||||
(require 'mail-parse)
|
||||
|
||||
(require 'html2text)
|
||||
(require 'mua-common)
|
||||
|
||||
(defun mua/msg-from-string (str)
|
||||
"Get the plist describing an email message, from a string
|
||||
contain a message sexp; a message sexp looks something like: The
|
||||
message sexp looks something like:
|
||||
\(
|
||||
:from ((\"Donald Duck\" . \"donald@example.com\"))
|
||||
:to ((\"Mickey Mouse\" . \"mickey@example.com\"))
|
||||
:subject \"Wicked stuff\"
|
||||
:date (20023 26572 0)
|
||||
:size 15165
|
||||
:references (\"200208121222.g7CCMdb80690@msg.id\")
|
||||
:in-reply-to \"200208121222.g7CCMdb80690@msg.id\"
|
||||
:message-id \"foobar32423847ef23@pluto.net\"
|
||||
:path \"/home/mickey/Maildir/inbox/cur/1312254065_3.32282.pluto,4cd5bd4e9:2,\"
|
||||
:priority high
|
||||
:flags (new unread)
|
||||
:attachments ((2 \"hello.jpg\" \"image/jpeg\") (3 \"laah.mp3\" \"audio/mp3\"))
|
||||
:body-txt \" <message body>\"
|
||||
\)
|
||||
other fields are :cc, :bcc, :body-html
|
||||
|
||||
When the s-expression comes from the database ('mu find'), the
|
||||
fields :attachments, :body-txt, :body-html, :references, :in-reply-to
|
||||
are missing (because that information is not stored in the
|
||||
database -- at least not in a usable way."
|
||||
(condition-case nil
|
||||
(car (read-from-string str));; read-from-string returns a cons
|
||||
(error "Failed to parse message")))
|
||||
|
||||
|
||||
(defun mua/msg-from-path (path)
|
||||
"Get the an s-expression (plist) describing the e-mail message
|
||||
at path, or nil if it failed. This functions uses 'mu view' to
|
||||
obtain the s-expression. For the format, see `mua/msg-from-string'"
|
||||
(if (not (file-readable-p path))
|
||||
(progn
|
||||
(mua/warn "Message is not readable")
|
||||
(mua/log "not readable: %s" path))
|
||||
(condition-case nil
|
||||
(progn (let* ((cmd (concat mua/mu-binary " view --format=sexp " path))
|
||||
(str (shell-command-to-string cmd)))
|
||||
(mua/msg-from-string str)))
|
||||
(error "Failed to read/parse message %s" path))))
|
||||
|
||||
|
||||
(defun mua/msg-body-txt-or-html (msg)
|
||||
"Get :body-txt, or if not available, :body-html converted to
|
||||
text, using `html2text'."
|
||||
(let ((body (mua/msg-field msg :body-txt)))
|
||||
(unless body
|
||||
(setq body (mua/msg-field msg :body-html))
|
||||
(when body
|
||||
(setq body (with-temp-buffer
|
||||
(insert body)
|
||||
(html2text)
|
||||
(buffer-string)))))
|
||||
body))
|
||||
|
||||
(defun mua/msg-field (msg field)
|
||||
"Get a field from this message, or nil. The fields are the
|
||||
fields of the message, which are the various items of the plist
|
||||
as described in `mua/msg-from-string'
|
||||
|
||||
There is also the special field :body (which is either :body-txt,
|
||||
or if not available, :body-html converted to text)."
|
||||
(case field
|
||||
(:body (mua/msg-body-txt-or-html msg))
|
||||
(t (plist-get msg field))))
|
||||
|
||||
|
||||
;; TODO: add better error-reporting to mua/msg-move, and make flag handling a
|
||||
;; bit more lispy
|
||||
|
||||
(defun mua/msg-move (src targetdir &optional flags)
|
||||
"Move message at SRC to TARGETDIR using 'mu mv'; SRC must be
|
||||
the full, absolute path to a message file, while TARGETDIR must
|
||||
be a maildir - that is, the part _without_ cur/ or new/. 'mu mv'
|
||||
will calculate the target directory and the exact file name.
|
||||
|
||||
Optionally, you can specify the FLAGS for the new file; this must
|
||||
be a string consisting of one or more of DFNPRST, mean
|
||||
resp. Deleted, Flagged, New, Passed Replied, Seen and Trash, as
|
||||
defined in [1].
|
||||
|
||||
If TARGETDIR is '/dev/null', remove SRC. After the file system
|
||||
move, the database will be updated as well, using the 'mu add'
|
||||
and 'mu remove' commands.
|
||||
|
||||
Function returns the target filename if the move succeeds, or
|
||||
/dev/null if TARGETDIR was /dev/null; in other cases, it returns
|
||||
`nil'.
|
||||
|
||||
\[1\] http://cr.yp.to/proto/maildir.html."
|
||||
|
||||
;; require the flags to be kosher
|
||||
(when (and flags (let ((case-fold-search nil))
|
||||
(string-match "[^DFNPRST]" flags))) (error Illegal flags))
|
||||
|
||||
(let* ((cmd (concat
|
||||
mua/mu-binary " mv --printtarget "
|
||||
(when flags (concat "--flags=" flags " "))
|
||||
(shell-quote-argument src) " "
|
||||
(shell-quote-argument targetdir)))
|
||||
(fulltarget (shell-command-to-string cmd)))
|
||||
(mua/log cmd)
|
||||
(mua/log
|
||||
(if fulltarget (concat "Message has been moved to " fulltarget)
|
||||
"Message moving failed"))
|
||||
;; now, if saving worked, anynchronously try to update the database
|
||||
(when fulltarget ;; note, we don't check the result of the db output
|
||||
|
||||
(mua/log "Removing from database: %s" src)
|
||||
(start-process " *mu-remove*" nil mua/mu-binary "remove" src)
|
||||
|
||||
(unless (string= targetdir "/dev/null")
|
||||
(mua/log "Adding to database: %s" fulltarget)
|
||||
(start-process " *mu-add*" nil mua/mu-binary "add" fulltarget) t)
|
||||
)
|
||||
|
||||
fulltarget))
|
||||
|
||||
|
||||
;; functions for composing new messages (forward, reply and new)
|
||||
|
||||
(defvar mua/msg-citation-prefix "> "
|
||||
"String to prefix cited message parts with.")
|
||||
|
||||
(defvar mua/msg-reply-prefix "Re: "
|
||||
"String to prefix the subject of replied messages with.")
|
||||
|
||||
(defvar mua/msg-forward-prefix "Fwd: "
|
||||
"String to prefix the subject of forwarded messages with.")
|
||||
|
||||
(defconst mua/msg-draft-name "*mua-draft*"
|
||||
"Name for draft messages.")
|
||||
|
||||
(defun mua/msg-user-agent ()
|
||||
"Return the User-Agent string for mua. This is either the value
|
||||
of `mua/user-agent', or, if not set, a string based on the
|
||||
version of mua and emacs."
|
||||
(or mua/user-agent
|
||||
(format "mu %s; emacs %s" (mua/mu-binary-version) emacs-version)))
|
||||
|
||||
(defun mua/msg-cite-original (msg)
|
||||
"Cite the body text of MSG, with a \"On %s, %s wrote:\"
|
||||
line (with the %s's replaced with the date of MSG and the name
|
||||
or e-mail address of its sender (or 'someone' if nothing
|
||||
else)), followed of the quoted body of MSG, constructed by by
|
||||
prepending `mua/msg-citation-prefix' to each line."
|
||||
(let ((from (mua/msg-field msg :from)))
|
||||
(concat
|
||||
(format "On %s, %s wrote:"
|
||||
(format-time-string "%c" (mua/msg-field msg :date))
|
||||
(if (and from (car from)) ;; a list ((<name> . <email>))
|
||||
(or (caar from) (cdar from) "someone")
|
||||
"someone"))
|
||||
"\n\n"
|
||||
(replace-regexp-in-string "^" " > "
|
||||
(mua/msg-body-txt-or-html msg)))))
|
||||
|
||||
(defun mua/msg-recipients-remove (lst email-to-remove)
|
||||
"Remove the recipient with EMAIL from the recipient list (of
|
||||
form '( (\"A\" . \"a@example.com\") (\"B\" . \"B@example.com\"))."
|
||||
(remove-if
|
||||
(lambda (name-email)
|
||||
(let ((email (cdr name-email)))
|
||||
(when email (string= email-to-remove (downcase email))))) lst))
|
||||
|
||||
(defun mua/msg-recipients-to-string (lst)
|
||||
"Convert a recipient list (of form '( (\"A\"
|
||||
. \"a@example.com\") (\"B\" . \"B@example.com\") (nil
|
||||
. \"c@example.com\")) into a string of form \"A <@aexample.com>,
|
||||
B <b@example.com>, c@example.com\."
|
||||
(mapconcat
|
||||
(lambda (recip)
|
||||
(let ((name (car recip)) (email (cdr recip)))
|
||||
(if name
|
||||
(format "%s <%s>" name email)
|
||||
(format "%s" email)))) lst ", "))
|
||||
|
||||
(defun mua/msg-hidden-header (hdr val)
|
||||
"Return user-invisible header to the message (HDR: VAL\n)."
|
||||
(format "%s: %s\n" hdr val))
|
||||
;;(propertize (format "%s: %s\n" hdr val) 'invisible t))
|
||||
|
||||
(defun mua/msg-header (hdr val)
|
||||
"Return a header line of the form HDR: VAL\n. If VAL is nil,
|
||||
return nil."
|
||||
(when val (format "%s: %s\n" hdr val)))
|
||||
;;(propertize (format "%s: %s\n" hdr val) 'invisible t))
|
||||
|
||||
|
||||
(defun mua/msg-references-create (msg)
|
||||
"Construct the value of the References: header based on MSG as
|
||||
a comma-separated string. Normally, this the concatenation of the
|
||||
existing References (which may be empty) and the message-id. If
|
||||
the message-id is empty, returns the old References. If both are
|
||||
empty, return nil."
|
||||
(let ((refs (mua/msg-field msg :references))
|
||||
(msgid (mua/msg-field msg :message-id)))
|
||||
(if msgid ;; every received message should have one...
|
||||
(mapconcat 'identity (append refs (list msgid)) ",")
|
||||
(mapconcat 'identity refs ","))))
|
||||
|
||||
(defun mua/msg-to-create (msg reply-all)
|
||||
"Construct the To: header for a reply-message based on some
|
||||
message MSG. If REPLY-ALL is nil, this the the Reply-To addresss
|
||||
of MSG if it exist, or the From:-address othewise. If reply-all
|
||||
is non-nil, the To: is what was in the old To: with either the
|
||||
Reply-To: or From: appended, and then the
|
||||
receiver (i.e. `user-mail-address') removed.
|
||||
|
||||
So:
|
||||
reply-all nil: Reply-To: or From: of MSG
|
||||
reply-all t : Reply-To: or From: of MSG + To: of MSG - `user-mail-address'
|
||||
|
||||
The result is either nil or a string which can be used for the To:-field."
|
||||
(let ((to-lst (mua/msg-field msg :to))
|
||||
(reply-to (mua/msg-field msg :reply-to))
|
||||
(from (mua/msg-field msg :from)))
|
||||
|
||||
(if reply-all
|
||||
(progn ;; reply-all
|
||||
(setq to-lst ;; append Reply-To:, or if not set, From: if set
|
||||
(if reply-to (cons `(nil . ,reply-to) to-lst)
|
||||
(if from (append to-lst from)
|
||||
to-lst)))
|
||||
|
||||
;; and remove myself from To:
|
||||
(setq to-lst (mua/msg-recipients-remove to-lst user-mail-address))
|
||||
(mua/msg-recipients-to-string to-lst))
|
||||
|
||||
;; reply single
|
||||
(progn
|
||||
(or reply-to (mua/msg-recipients-to-string from))))))
|
||||
|
||||
(defconst mua/msg-separator "--text follows this line--\n\n"
|
||||
"separator between headers and body, needed for `message-mode'")
|
||||
|
||||
(defun mua/msg-cc-create (msg reply-all)
|
||||
"Get the list of Cc-addresses for the reply to MSG. If
|
||||
REPLY-ALL is nil this is simply empty, otherwise it is the same
|
||||
list as the one in MSG, minus `user-mail-address'. The result of
|
||||
this function is either nil or a string to be used for the Cc:
|
||||
field."
|
||||
(let ((cc-lst (mua/msg-field msg :cc)))
|
||||
(when (and reply-all cc-lst)
|
||||
(mu-message-recipients-to-string
|
||||
(mua/msg-recipients-remove cc-lst
|
||||
user-mail-address)))))
|
||||
|
||||
(defun mua/msg-from-create ()
|
||||
"Construct a value for the From:-field of the reply to MSG,
|
||||
based on `user-full-name' and `user-mail-address'; if the latter
|
||||
is nil, function returns nil."
|
||||
(when user-mail-address
|
||||
(if user-full-name
|
||||
(format "%s <%s>" user-full-name user-mail-address)
|
||||
(format "%s" user-mail-address))))
|
||||
|
||||
|
||||
(defun mua/msg-create-reply (msg reply-all)
|
||||
"Create a draft message as a reply to MSG; if REPLY-ALL is
|
||||
non-nil, reply to all recipients.
|
||||
|
||||
A reply message has fields:
|
||||
From: - see `mu-msg-from-create'
|
||||
To: - see `mua/msg-to-create'
|
||||
Cc: - see `mua/msg-cc-create'
|
||||
Subject: - `mua/msg-reply-prefix' + subject of MSG
|
||||
|
||||
then, the following fields, normally hidden from user:
|
||||
Reply-To: - if `mail-reply-to' has been set
|
||||
References: - see `mua/msg-references-create'
|
||||
In-Reply-To: - message-id of MSG
|
||||
User-Agent - see `mua/msg-user-agent'
|
||||
|
||||
Then follows `mua-msg-separator' (for `message-mode' to separate
|
||||
body from headers)
|
||||
|
||||
And finally, the cited body of MSG, as per `mua/msg-cite-original'."
|
||||
(concat
|
||||
(mua/msg-header "From" (or (mua/msg-from-create) ""))
|
||||
(when (boundp 'mail-reply-to)
|
||||
(mua/msg-header "Reply-To" mail-reply-to))
|
||||
|
||||
(mua/msg-header "To" (or (mua/msg-to-create msg reply-all) ""))
|
||||
(mua/msg-header "Cc" (mua/msg-cc-create msg reply-all))
|
||||
|
||||
(mua/msg-hidden-header "User-agent" (mua/msg-user-agent))
|
||||
(mua/msg-hidden-header "References" (mua/msg-references-create msg))
|
||||
|
||||
(mua/msg-hidden-header "In-reply-to" (mua/msg-field msg :message-id))
|
||||
|
||||
(mua/msg-header"Subject"
|
||||
(concat mua/msg-reply-prefix (mua/msg-field msg :subject)))
|
||||
|
||||
mua/msg-separator
|
||||
|
||||
(mua/msg-cite-original msg)))
|
||||
|
||||
;; TODO: attachments
|
||||
(defun mua/msg-create-forward (msg)
|
||||
"Create a draft forward message for MSG.
|
||||
|
||||
A forward message has fields:
|
||||
From: - see `mu-msg-from-create'
|
||||
To: - empty
|
||||
Subject: - `mua/msg-forward-prefix' + subject of MSG
|
||||
|
||||
then, the following fields, normally hidden from user:
|
||||
Reply-To: - if `mail-reply-to' has been set
|
||||
References: - see `mua/msg-references-create'
|
||||
User-Agent - see `mua/msg-user-agent'
|
||||
|
||||
Then follows `mua-msg-separator' (for `message-mode' to separate
|
||||
body from headers)
|
||||
|
||||
And finally, the cited body of MSG, as per `mua/msg-cite-original'."
|
||||
(concat
|
||||
(mua/msg-header "From" (or (mua/msg-from-for-new) ""))
|
||||
(when (boundp 'mail-reply-to)
|
||||
(mua/msg-header "Reply-To" mail-reply-to))
|
||||
|
||||
(mua/msg-header "To" "")
|
||||
|
||||
(mua/msg-hidden-header "User-agent" (mua/msg-user-agent))
|
||||
(mua/msg-hidden-header "References" (mua/msg-references-for-reply msg))
|
||||
|
||||
(mua/msg-header"Subject"
|
||||
(concat mua/msg-forward-prefix (mua/msg-field msg :subject)))
|
||||
|
||||
mua/msg-separator
|
||||
|
||||
(mua/msg-cite-original msg)))
|
||||
|
||||
(defun mua/msg-create-new ()
|
||||
"Create a new message.
|
||||
|
||||
A new draft message has fields:
|
||||
From: - see `mu-msg-from-create'
|
||||
To: - empty
|
||||
Subject: - empty
|
||||
|
||||
then, the following fields, normally hidden from user:
|
||||
Reply-To: - if `mail-reply-to' has been set
|
||||
User-Agent - see `mua/msg-user-agent'
|
||||
|
||||
Then follows `mua-msg-separator' (for `message-mode' to separate
|
||||
body from headers)."
|
||||
(concat
|
||||
(mua/msg-header "From" (or (mua/msg-from-for-new) ""))
|
||||
(when (boundp 'mail-reply-to)
|
||||
(mua/msg-header "Reply-To" mail-reply-to))
|
||||
|
||||
(mua/msg-header "To" "")
|
||||
(mua/msg-hidden-header "User-agent" (mua/msg-user-agent))
|
||||
(mua/msg-header "Subject" "")
|
||||
mua/msg-separator))
|
||||
|
||||
(defconst mua/msg-file-prefix "mua" "prefix for mua-generated
|
||||
mail files; we use this to ensure that our hooks don't mess
|
||||
with non-mua-generated messages")
|
||||
|
||||
(defun mua/msg-draft-file-name ()
|
||||
"Create a Maildir-compatible[1], unique file name for a draft
|
||||
message.
|
||||
[1]: see http://cr.yp.to/proto/maildir.html"
|
||||
(format "%s-%x-%x.%s:2,D" ;; 'D': rarely used, but hey, it's available
|
||||
mua/msg-file-prefix
|
||||
(format-time-string "%Y%m%d" (current-time))
|
||||
(emacs-pid)
|
||||
(random t)
|
||||
(replace-regexp-in-string "[:/]" "_" (system-name))))
|
||||
|
||||
|
||||
(defun mua/msg-compose (str)
|
||||
"Create a new draft message in the drafts folder with STR as
|
||||
its contents, and open this message file for editing
|
||||
|
||||
The name of the draft folder is constructed from the concatenation of
|
||||
`mua/maildir' and `mua/drafts-folder' (therefore, these must be set).
|
||||
|
||||
The message file name is a unique name determined by
|
||||
`mua/msg-draft-file-name'.
|
||||
|
||||
The initial STR would be created from either `mua/msg-create-reply',
|
||||
`mua/msg-create-forward' or `mua/msg-create-new'. The editing buffer is
|
||||
using Gnus' `message-mode'."
|
||||
(unless mua/maildir (error "mua/maildir not set"))
|
||||
(unless mua/drafts-folder (error "mua/drafts-folder not set"))
|
||||
|
||||
;; write our draft message to the the drafts folder
|
||||
(let ((draftfile (concat mua/maildir "/" mua/drafts-folder "/cur/"
|
||||
(mua/msg-draft-file-name))))
|
||||
(with-temp-file draftfile (insert str))
|
||||
(find-file draftfile)
|
||||
(rename-buffer mua/msg-draft-name t)
|
||||
(message-mode)
|
||||
(message-goto-body)))
|
||||
|
||||
|
||||
|
||||
(defun mua/msg-is-mua-message ()
|
||||
"Check whether the current buffer refers a mua-message based on
|
||||
the buffer file name; this is used in hooks we install on
|
||||
message-mode to ensure we only do things with mua-generated
|
||||
messages (mua is not the only user of `message-mode' after all)"
|
||||
(let* ((fname (buffer-file-name))
|
||||
(match (and fname (string-match mua/msg-file-prefix fname))))
|
||||
(and (numberp match) (= 0 match))))
|
||||
;; we simply check if file starts with `mu-msg-file-prefix'
|
||||
|
||||
(defun mua/msg-save-to-sent ()
|
||||
"function that moves the current message to the sent folder"
|
||||
(if (mua/msg-is-mua-message)
|
||||
(unless mua/sent-folder (error "mua/sent-folder not set"))
|
||||
|
||||
(let ((sent-msg ;; note, the "" parameter remove the D 'Draft'-flag
|
||||
(mua/msg-move (buffer-file-name) mua/sent-folder "")))
|
||||
(if (sent-msg) ;; change our buffer file-name
|
||||
(set-visited-file-name sent-msg t t)
|
||||
(mua/warn "Failed to save message to the Sent-folder")))))
|
||||
|
||||
;; (defun mua/msg-set-replied-flag ()
|
||||
;; "find the message we replied to, and set its 'Replied' flag."
|
||||
;; (if (mua/msg-is-mua-message)
|
||||
|
||||
;; (let ((msgid (mail-header-parse-addresses
|
||||
;; (message-field-value "In-Reply-To")))
|
||||
;; (path (and msgid (shell-command-to-string
|
||||
;; (concat mua/mu-binary
|
||||
;; " find msgid:" msgid " --exec=echo | head -1")))))
|
||||
;; (if path
|
||||
;; (mu-mv)
|
||||
|
||||
|
||||
|
||||
|
||||
;; add-hook
|
||||
;; add-hook
|
||||
|
||||
|
||||
(provide 'mua-msg)
|
||||
221
toys/mua/mua-view.el
Normal file
221
toys/mua/mua-view.el
Normal file
@ -0,0 +1,221 @@
|
||||
;;; mua-view.el -- part of mua, the mu mail user agent
|
||||
;;
|
||||
;; Copyright (C) 2011 Dirk-Jan C. Binnema
|
||||
|
||||
;; Author: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||
;; Maintainer: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||
;; Keywords: email
|
||||
;; Version: 0.0
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; mu
|
||||
|
||||
;;; Code:
|
||||
|
||||
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
(require 'mua-common)
|
||||
(require 'mua-msg)
|
||||
|
||||
(defconst mua/view-buffer-name " *mua-view*"
|
||||
"buffer name for mua/view buffers")
|
||||
|
||||
(defvar mua/view-headers
|
||||
'(:from :to :cc :subject :flags :date :attachments)
|
||||
"fields to display in the message view")
|
||||
|
||||
(defvar mua/hdrs-buffer nil
|
||||
"headers buffer for the view")
|
||||
|
||||
(defun mua/view (path headersbuf)
|
||||
"display message at PATH in a new buffer; note that the action
|
||||
of viewing a message may cause it to be moved/renamed; this
|
||||
function returns the resulting name. PARENTBUF refers to the
|
||||
buffer who invoked this view; this allows us to return there when
|
||||
we quit from this view. Also, if PARENTBUF is a find buffer (ie.,
|
||||
has mu-headers-mode as its major mode), this allows various
|
||||
commands (navigation, marking etc.) to be applied to this
|
||||
buffer."
|
||||
(let* ((msg (mua/msg-from-path path))
|
||||
(buf (get-buffer-create mua/view-buffer-name))
|
||||
(str (mua/view-message msg)))
|
||||
(when (and msg str)
|
||||
|
||||
(switch-to-buffer buf)
|
||||
(let ((inhibit-read-only t))
|
||||
(erase-buffer)
|
||||
(insert str))
|
||||
|
||||
(mua/view-mode)
|
||||
|
||||
(setq ;; these are buffer-local
|
||||
mua/hdrs-buffer headersbuf
|
||||
mua/parent-buffer headersbuf)
|
||||
(goto-char (point-min)))))
|
||||
|
||||
(defun mua/view-message (msg)
|
||||
"construct a display string for the message"
|
||||
(let ((hdrs
|
||||
(mapconcat
|
||||
(lambda (field)
|
||||
(case field
|
||||
(:subject (mua/view-header msg "Subject" :subject))
|
||||
(:path (mua/view-header msg "Path" :path))
|
||||
(:to (mua/view-contacts msg field))
|
||||
(:from (mua/view-contacts msg field))
|
||||
(:cc (mua/view-contacts msg field))
|
||||
(:bcc (mua/view-contacts msg field))
|
||||
(:date (mua/view-date msg))
|
||||
(:flags (mua/view-flags msg))
|
||||
(:size (mua/view-size msg))
|
||||
(:attachments (mua/view-attachments msg))
|
||||
(t (error "Unsupported field: %S" field))))
|
||||
mua/view-headers ""))
|
||||
(body (mua/msg-body-txt-or-html msg)))
|
||||
(concat hdrs "\n" body)))
|
||||
|
||||
(defun mua/view-header-string (key val face)
|
||||
(if val
|
||||
(concat
|
||||
(propertize key 'face 'mua/header-title-face) ": "
|
||||
(propertize val 'face face) "\n")
|
||||
""))
|
||||
|
||||
(defun mua/view-header (msg key field)
|
||||
"show header FIELD for MSG with KEY. ie. <KEY>: value-of-FIELD\n"
|
||||
(mua/view-header-string key (mua/msg-field msg field) 'mua/header-face))
|
||||
|
||||
(defun mua/view-contacts (msg field)
|
||||
(unless (member field '(:to :from :bcc :cc))
|
||||
(error "Illegal type for contact"))
|
||||
(let* ((lst (mua/msg-field msg field))
|
||||
(contacts
|
||||
(when lst
|
||||
(mapconcat
|
||||
(lambda(c) (let ((name (car c)) (email (cdr c)))
|
||||
(if name
|
||||
(format "%s <%s>" name email)
|
||||
(format "%s" email)))) lst ", "))))
|
||||
(if contacts
|
||||
(mua/view-header-string
|
||||
(case field (:to "To") (:from "From") (:bcc "Bcc") (:cc "Cc"))
|
||||
contacts 'mua/contacts-face)
|
||||
"")))
|
||||
|
||||
(defun mua/view-date (msg)
|
||||
(let* ((date (mua/msg-field msg :date))
|
||||
(datestr (when date (format-time-string "%c" date))))
|
||||
(mua/view-header-string "Date" datestr 'mua/header-face)))
|
||||
|
||||
(defun mua/view-size (msg)
|
||||
(let* ((size (mua/msg-field msg :size))
|
||||
(sizestr (when size (format "%d bytes"))))
|
||||
(mua/view-header-string "Size" sizestr 'mua-header-face)))
|
||||
|
||||
(defun mua/view-flags (msg)
|
||||
""
|
||||
"" ;; todo
|
||||
)
|
||||
|
||||
(defun mua/view-attachments (msg)
|
||||
""
|
||||
"" ;; todo
|
||||
)
|
||||
|
||||
|
||||
|
||||
(defvar mua/view-mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map "q" 'mua/quit-buffer)
|
||||
(define-key map "s" 'mua/view-search)
|
||||
|
||||
(define-key map "f" 'mua/view-forward)
|
||||
(define-key map "r" 'mua/view-reply)
|
||||
(define-key map "c" 'mua/view-compose)
|
||||
|
||||
;; navigation between messages
|
||||
(define-key map "n" 'mua/view-next)
|
||||
(define-key map "p" 'mua/view-prev)
|
||||
|
||||
;; marking/unmarking
|
||||
(define-key map "d" '(lambda (mua/view-mark 'trash)))
|
||||
(define-key map "D" '(lambda (mua/view-mark 'delete)))
|
||||
(define-key map "m" '(lambda (mua/view-mark 'move)))
|
||||
(define-key map "u" '(lambda (mua/view-mark 'unmark)))
|
||||
(define-key map "x" 'mua/view-marked-execute)
|
||||
map)
|
||||
"Keymap for \"*mua-view*\" buffers.")
|
||||
(fset 'mua/view-mode-map mua/view-mode-map)
|
||||
|
||||
(defun mua/view-mode ()
|
||||
"major mode for viewing an e-mail message"
|
||||
(interactive)
|
||||
(kill-all-local-variables)
|
||||
(use-local-map mua/view-mode-map)
|
||||
|
||||
(make-local-variable 'mua/parent-buffer)
|
||||
(make-local-variable 'mua/hdrs-buffer)
|
||||
(make-local-variable 'mua/path)
|
||||
|
||||
(setq major-mode 'mua/view-mode mode-name "*mu-view*")
|
||||
(setq truncate-lines t buffer-read-only t))
|
||||
|
||||
|
||||
(defmacro mua/with-hdrs-buffer (&rest body)
|
||||
"Execute the forms in BODY with the mua/hdrs-buffer temporarily current.
|
||||
Note that this actually switches the buffer, and changes to point
|
||||
etc. persist."
|
||||
(declare (indent 1) (debug t))
|
||||
`(let ((oldbuf (current-buffer)))
|
||||
(if (buffer-live-p mua/hdrs-buffer)
|
||||
(progn
|
||||
(set-buffer mua/hdrs-buffer)
|
||||
(progn ,@body)
|
||||
(set-buffer oldbuf))
|
||||
(mua/warn "hdrs buffer is dead"))))
|
||||
|
||||
(defun mua/view-next ()
|
||||
"move to the next message; note, this will replace the current
|
||||
buffer"
|
||||
(interactive)
|
||||
(mua/with-hdrs-buffer
|
||||
(when (mua/hdrs-next) (mua/hdrs-view))))
|
||||
|
||||
(defun mua/view-prev ()
|
||||
"move to the previous message; note, this will replace the
|
||||
current buffer"
|
||||
(interactive)
|
||||
(mua/with-hdrs-buffer
|
||||
(when (mua/hdrs-prev) (mua/hdrs-view))))
|
||||
|
||||
(defun mua/view-reply ()
|
||||
"Reply to the current message."
|
||||
(interactive) (mua/with-hdrs-buffer (mua/hdrs-reply)))
|
||||
|
||||
(defun mua/view-forward ()
|
||||
"Reply to the current message."
|
||||
(interactive) (mua/with-hdrs-buffer (mua/hdrs-forward)))
|
||||
|
||||
(defun mua/view-compose ()
|
||||
"Write a new message."
|
||||
(interactive) (mua/with-hdrs-buffer (mua/hdrs-compose)))
|
||||
|
||||
|
||||
(provide 'mua-view)
|
||||
Reference in New Issue
Block a user