alx/mu4e
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

* mm updates

Browse Source
This commit is contained in:
djcb
2011-11-05 10:26:24 +02:00
parent 19e93a52f1
commit cc7a09bd93
6 changed files with 261 additions and 242 deletions
Download Patch File Download Diff File Expand all files Collapse all files

164
toys/mm/mm.el
View File

@ -1,4 +1,4 @@
;;; mm.el -- part of mm, the mu mail user agent
;;
;; Copyright (C) 2011 Dirk-Jan C. Binnema
@ -31,7 +31,6 @@
(require 'mm-hdrs)
(require 'mm-view)
(require 'mm-send)
(require 'mm-common)
(require 'mm-proc)
@ -79,11 +78,9 @@ PATH, you can specifiy the full path."
:safe 'stringp)
(defvar mm/debug nil
"When set to non-nil, log debug information to the *mm-log* buffer.")
;; Folders
(defgroup mm/folders nil
@ -119,6 +116,18 @@ PATH, you can specifiy the full path."
:group 'mm/folders)
(defcustom mm/move-quick-targets nil
"A list of targets quickly moving messages towards (i.e.,
archiving or refiling). The list contains elements of the form
(foldername . shortcut), where FOLDERNAME is a maildir (such as
\"/archive/\"), and shortcut a single shortcut character. With
this, in the header buffer and view buffer you can execute
`mm/mark-for-move-quick' (or 'a', by default) followed by the designated
character for the target folder, and the message at point (or all
the messages in the region) will be marked for moving to the target
folder.")
;; the headers view
(defgroup mm/headers nil
"Settings for the headers view."
@ -133,20 +142,17 @@ PATH, you can specifiy the full path."
"A list of header fields to show in the headers buffer, and their
respective widths in characters. A width of `nil' means
'unrestricted', and this is best reserved fo the rightmost (last)
field.")
(defcustom mm/hdrs-on-top t
"If non-nil, display headers above the message view; otherwise, display the headers on the left of the message view"
)
field. For the complete list of available headers, see `mm/header-names'")
;; the message view
(defgroup mm/view nil
"Settings for the message view."
:group 'mm)
(defcustom mm/view-headers
(defcustom mm/view-fields
'(:from :to :cc :subject :flags :date :maildir :path :attachments)
"Header fields to display in the message view buffer."
"Header fields to display in the message view buffer. For the
complete list of available headers, see `mm/header-names'"
:type (list 'symbol)
:group 'mm/view)
@ -253,7 +259,6 @@ flag set)."
"Face for the mark in the headers list."
:group 'mm/faces)
(defface mm/system-face
'((t :inherit font-lock-comment-face :slant italic))
"Face for system message (such as the footers for message
@ -263,13 +268,31 @@ headers)."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; internal variables / constant
;; internal variables / constants
(defconst mm/mm-buffer-name "*mm*"
"*internal* Name of the mm main buffer.")
(defvar mm/mu-version nil
"*interal* version of the mu binary")
(defconst mm/header-names
'( (:attachments . "Attach")
(:bcc . "Bcc")
(:cc . "Cc")
(:date . "Date")
(:flags . "Flags")
(:from . "From")
(:from-or-to . "From/To")
(:maildir . "Maildir")
(:path . "Path")
(:subject . "Subject")
(:to . "To"))
"A alist of all possible header fields; this is used in the UI (the
column headers in the header list, and the fields the message
view). Most fields should be self-explanatory. A special one is
`:from-or-to', which is equal to `:from' unless `:from' matches ,
in which case it will be equal to `:to'.)")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; mm mode + keybindings
(defvar mm/mm-mode-map
@ -344,18 +367,8 @@ headers)."
" * toggle " (propertize "m" 'face 'highlight) "ail sending mode "
"\n"
" * " (propertize "q" 'face 'highlight) "uit mm\n")
(mm/mm-mode)
(switch-to-buffer buf))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; window management
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -402,9 +415,11 @@ headers)."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; General helper functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun mm/quit-mm()
"Quit the mm session."
(interactive)
@ -413,4 +428,105 @@ headers)."
(mm/kill-proc)
(kill-buffer)))
;; TODO: make this recursive
(defun mm/get-sub-maildirs (maildir)
"Get all readable sub-maildirs under MAILDIR."
(let ((maildirs (remove-if
(lambda (dentry)
(let ((path (concat maildir "/" dentry)))
(or
(string= dentry ".")
(string= dentry "..")
(not (file-directory-p path))
(not (file-readable-p path))
(file-exists-p (concat path "/.noindex")))))
(directory-files maildir))))
(map 'list (lambda (dir) (concat "/" dir)) maildirs)))
(defun mm/ask-maildir (prompt)
"Ask user with PROMPT for a maildir name, if fullpath is
non-nill, return the fulpath (i.e., `mm/maildir' prepended to the
chosen folder)."
(unless (and mm/inbox-folder mm/drafts-folder mm/sent-folder)
(error "`mm/inbox-folder', `mm/drafts-folder' and
`mm/sent-folder' must be set"))
(unless mm/maildir (error "`mm/maildir' must be set"))
(interactive)
(ido-completing-read prompt (mm/get-sub-maildirs mm/maildir)))
(defun mm/new-buffer (bufname)
"Return a new buffer BUFNAME; if such already exists, kill the
old one first."
(when (get-buffer bufname)
(progn
(message (format "Killing %s" bufname))
(kill-buffer bufname)))
(get-buffer-create bufname))
;;; converting flags->string and vice-versa ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun mm/flags-to-string (flags)
"Remove duplicates and sort the output of `mm/flags-to-string-raw'."
(concat
(sort (remove-duplicates (append (mm/flags-to-string-raw flags) nil)) '>)))
(defun mm/flags-to-string-raw (flags)
"Convert a list of flags into a string as seen in Maildir
message files; flags are symbols draft, flagged, new, passed,
replied, seen, trashed and the string is the concatenation of the
uppercased first letters of these flags, as per [1]. Other flags
than the ones listed here are ignored.
Also see `mm/flags-to-string'.
\[1\]: http://cr.yp.to/proto/maildir.html"
(when flags
(let ((kar (case (car flags)
('draft ?D)
('flagged ?F)
('new ?N)
('passed ?P)
('replied ?R)
('seen ?S)
('trashed ?T)
('attach ?a)
('encrypted ?x)
('signed ?s)
('unread ?u))))
(concat (and kar (string kar))
(mm/flags-to-string-raw (cdr flags))))))
(defun mm/string-to-flags (str)
"Remove duplicates from the output of `mm/string-to-flags-1'"
(remove-duplicates (mm/string-to-flags-1 str)))
(defun mm/string-to-flags-1 (str)
"Convert a string with message flags as seen in Maildir
messages into a list of flags in; flags are symbols draft,
flagged, new, passed, replied, seen, trashed and the string is
the concatenation of the uppercased first letters of these flags,
as per [1]. Other letters than the ones listed here are ignored.
Also see `mu/flags-to-string'.
\[1\]: http://cr.yp.to/proto/maildir.html"
(when (/= 0 (length str))
(let ((flag
(case (string-to-char str)
(?D 'draft)
(?F 'flagged)
(?P 'passed)
(?R 'replied)
(?S 'seen)
(?T 'trashed))))
(append (when flag (list flag))
(mm/string-to-flags-1 (substring str 1))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(provide 'mm)