emacs
/
mu
mirror of https://github.com/djcb/mu.git
1
0
Fork 0
Code Issues Releases Wiki Activity

* mm updates

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

145
toys/mm/mm-common.el
View File

@ -1,145 +0,0 @@
;;; mm-common.el -- part of mm, 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:
;;; Code:
(eval-when-compile (require 'cl))
(require 'ido)
;;; 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))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; other helper function ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(provide 'mm-common)

57
toys/mm/mm-hdrs.el
View File

@ -34,10 +34,8 @@
(eval-when-compile (require 'cl))
(require 'mm-common)
(require 'mm-proc)
;;;; internal variables/constants ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar mm/last-expr nil
"*internal* The most recent search expression.")
@ -194,7 +192,6 @@ after the end of the search results."
;;; hdrs-mode and mode-map ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq mm/hdrs-mode-map nil)
(defvar mm/hdrs-mode-map nil
@ -221,6 +218,7 @@ after the end of the search results."
(define-key map (kbd "<delete>") 'mm/mark-for-delete)
(define-key map "D" 'mm/mark-for-delete)
(define-key map "a" 'mm/mark-for-move-quick)
(define-key map "u" 'mm/unmark)
(define-key map "U" 'mm/unmark-all)
@ -299,13 +297,22 @@ after the end of the search results."
mode-name "*mm-headers*"
truncate-lines t
buffer-read-only t
overwrite-mode 'overwrite-mode-binary))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
overwrite-mode 'overwrite-mode-binary)
;;; headers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq header-line-format
(cons "* "
(map 'list
(lambda (item) ;; FIXME
(let ((field (cdr (assoc (car item) mm/header-names)))
(width (cdr item)))
(concat
(propertize
(if width
(truncate-string-to-width field width 0 ?\s t)
field)
'face 'mm/title-face) " ")))
mm/header-fields))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar mm/msg-map nil
"*internal* A map (hashtable) which maps a database (Xapian)
docid (which uniquely identifies a message to a marker. where
@ -584,11 +591,12 @@ return the new docid. Otherwise, return nil."
(mm/hdrs-search (concat "maildir:" fld))))
(defun mm/mark-for-move ()
"Mark message at point for moving to a maildir."
(defun mm/mark-for-move (&optional target)
"Mark message at point for moving to maildir TARGET. If target is
not provided, function asks for it."
(interactive)
(with-current-buffer mm/hdrs-buffer
(let* ((target (mm/ask-maildir "Target maildir for move: "))
(let* ((target (or target (mm/ask-maildir "Target maildir for move: ")))
(fulltarget (concat mm/maildir target)))
(when (or (file-directory-p fulltarget)
(and (yes-or-no-p
@ -597,6 +605,31 @@ return the new docid. Otherwise, return nil."
(mm/hdrs-mark 'move target)
(mm/next-header)))))
(defun mm/mark-for-move-quick ()
"Mark message at point (or all messages in region) for moving to
a folder; see `mm/move-quick-targets'."
(interactive)
(unless mm/move-quick-targets
(error "`mm/move-quick-targets' has not been defined"))
(let* ((fnames
(mapconcat
(lambda (item)
(concat
"["
(propertize (make-string 1 (cdr item)) 'face 'mm/view-link-face)
"]"
(car item)))
mm/move-quick-targets ", "))
(kar (read-char (concat "Move to: " fnames)))
(targetitem
(find-if (lambda (item) (= kar (cdr item))) mm/move-quick-targets))
(target (and targetitem (car targetitem))))
;; if the target is not found, we simply exit
(when target
(mm/mark-for-move target))))
(defun mm/mark-for-trash ()
"Mark message at point for moving to the trash
folder (`mm/trash-folder')."

33
toys/mm/mm-proc.el
View File

@ -27,8 +27,6 @@
;;; Code:
(eval-when-compile (require 'cl))
(require 'mm-common)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; internal vars
@ -139,16 +137,18 @@ process."
(defun mm/kill-proc ()
"Kill the mu server process."
(let (buf (get-buffer mm/server-name))
(when buf
(let* ((buf (get-buffer mm/server-name))
(proc (and buf (get-buffer-process buf))))
(when proc
(let ((delete-exited-processes t))
;; send SIGINT (C-c) to process, so it can exit gracefully
(signal-process (get-buffer-process buf) 'SIGINT)
;; the mu server signal handler will make it quit after 'quit'
(mm/proc-send-command "quit"))
(setq
mm/mu-proc nil
mm/buf nil))))
;; try sending SIGINT (C-c) to process, so it can exit gracefully
(ignore-errors
(signal-process proc 'SIGINT))))
(setq
mm/mu-proc nil
mm/buf nil))
(defun mm/proc-is-running ()
(and mm/mu-proc (eq (process-status mm/mu-proc) 'run)))
@ -160,10 +160,10 @@ process."
Function returns this sexp, or nil if there was none. `mm/buf' is
updated as well, with all processed sexp data removed."
(when mm/buf
;; TODO: maybe try a non-regexp solution?
(let* ((b (string-match "\376\\([0-9]+\\)\376" mm/buf))
(sexp-len
(when b (string-to-number (match-string 1 mm/buf)))))
;; does mm/buf contain the full sexp?
(when (and b (>= (length mm/buf) (+ sexp-len (match-end 0))))
;; clear-up start
@ -171,10 +171,13 @@ updated as well, with all processed sexp data removed."
;; note: we read the input in binary mode -- here, we take the part that
;; is the sexp, and convert that to utf-8, before we interpret it.
(let ((objcons
(read-from-string
(decode-coding-string (substring mm/buf 0 sexp-len) 'utf-8))))
(setq mm/buf (substring mm/buf sexp-len))
(car objcons))))))
(ignore-errors ;; note: this may fail if we killed the process
;; in the middle
(read-from-string
(decode-coding-string (substring mm/buf 0 sexp-len) 'utf-8)))))
(when objcons
(setq mm/buf (substring mm/buf sexp-len))
(car objcons)))))))
(defun mm/proc-filter (proc str)
@ -292,6 +295,8 @@ terminates."
(t (message (format "mu server process received signal %d" code)))))
((eq status 'exit)
(cond
((eq code 0)
(message nil)) ;; don't do anything
((eq code 11)
(message "Database is locked by another process"))
((eq code 19)

37
toys/mm/mm-send.el
View File

@ -148,8 +148,10 @@ The result is either nil or a string which can be used for the To:-field."
(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)
(if reply-to
(cons `(nil . ,reply-to) to-lst)
(if from
(append to-lst from)
to-lst)))
;; and remove myself from To:
@ -169,8 +171,7 @@ is either nil or a string to be used for the Cc: field."
(let ((cc-lst (plist-get msg :cc)))
(when (and reply-all cc-lst)
(mm/msg-recipients-to-string
(mm/msg-recipients-remove cc-lst
user-mail-address)))))
(mm/msg-recipients-remove cc-lst user-mail-address)))))
(defun mm/msg-from-create ()
"Construct a value for the From:-field of the reply to MSG,
@ -288,18 +289,22 @@ body from headers)."
already exist, and optionally fill it with STR. Function also adds
the new message to the database. When the draft message is added to
the database, `mm/path-docid-map' will be updated, so that we can
use the new docid. Return the full path to the new message."
(let ((draft
(concat mm/maildir mm/drafts-folder "/cur/"
(format "%s-%x%x:2,D" ;; 'D': rarely used, but hey, it's available
(format-time-string "%Y%m%d" (current-time))
(emacs-pid)
(random t)))) ;; TODO: include hostname
(str (case compose-type
(reply (mm/msg-create-reply msg))
(forward (mm/msg-create-forward msg))
(new (mm/msg-create-new))
(t (error "unsupported compose-type %S" compose-type)))))
use the new docid. Returns the full path to the new message."
(let* ((hostname
(downcase
(save-match-data
(substring system-name
(string-match "^[^.]+" system-name) (match-end 0)))))
(draft
(concat mm/maildir mm/drafts-folder "/cur/"
(format "%s-%x%x.%s:2,D" ;; 'D': rarely used, but hey, it's available
(format-time-string "%Y%m%d" (current-time))
(emacs-pid) (random t) hostname)))
(str (case compose-type
(reply (mm/msg-create-reply msg))
(forward (mm/msg-create-forward msg))
(new (mm/msg-create-new))
(t (error "unsupported compose-type %S" compose-type)))))
(when str
(with-temp-file draft
(insert str)

67
toys/mm/mm-view.el
View File

@ -32,7 +32,6 @@
;;; Code:
(eval-when-compile (require 'cl))
(require 'mm-common)
(require 'html2text)
(require 'filladapt)
@ -61,28 +60,34 @@ marking if it still had that."
(insert
(mapconcat
(lambda (field)
(case field
(:subject (mm/view-header "Subject" (plist-get msg :subject)))
(:path (mm/view-header "Path" (plist-get msg :path)))
(:to (mm/view-contacts msg field))
(:from (mm/view-contacts msg field))
(:cc (mm/view-contacts msg field))
(:bcc (mm/view-contacts msg field))
(:date
(let* ((date (plist-get msg :date))
(datestr (when date (format-time-string "%c" date))))
(if datestr (mm/view-header "Date" datestr) "")))
(let ((fieldname (cdr (assoc field mm/header-names)))
(fieldval (plist-get msg field)))
(case field
(:subject (mm/view-header fieldname fieldval))
(:path (mm/view-header fieldname fieldval))
(:maildir (mm/view-header fieldname fieldval))
(:flags (mm/view-header fieldname (format "%S" fieldval)))
;; contact fields
(:to (mm/view-contacts msg field))
(:from (mm/view-contacts msg field))
(:cc (mm/view-contacts msg field))
(:bcc (mm/view-contacts msg field))
(:flags "") ;; TODO
(:maildir (mm/view-header "Maildir" (plist-get msg :maildir)))
(:size (mm/view-size msg)
(let* ((size (plist-get msg :size))
(sizestr (when size (format "%d bytes"))))
(if sizestr (mm/view-header "Size" sizestr))))
(:attachments (mm/view-attachments msg))
(t (error "Unsupported field: %S" field))))
mm/view-headers "")
;; date
(:date
(let ((datestr
(when fieldval (format-time-string "%c" fieldval))))
(if datestr (mm/view-header fieldname datestr) "")))
;; size
(:size (mm/view-size msg)
(let ((sizestr (when size (format "%d bytes"))))
(if sizestr (mm/view-header fieldname sizestr))))
;; attachments
(:attachments (mm/view-attachments msg))
(t (error "Unsupported field: %S" field)))))
mm/view-fields "")
"\n"
(mm/view-body msg))
@ -91,7 +96,7 @@ marking if it still had that."
(setq ;; these are buffer-local
mode-name (if (plist-get msg :subject)
(truncate-string-to-width (plist-get msg :subject) 16 0 nil t)
"No subject")
(propertize "No subject" 'face 'mm/system-face))
mm/current-msg msg
mm/hdrs-buffer hdrsbuf
mm/link-map (make-hash-table :size 32 :rehash-size 2 :weakness nil))
@ -116,7 +121,7 @@ or if not available, :body-html converted to text)."
(defun mm/view-header (key val)
"Show header FIELD for MSG with KEY. ie. <KEY>: value-of-FIELD\n."
"Show header FIELD for MSG with KEY. ie. <KEY>: value-of-FIELD."
(if val
(concat
(propertize key 'face 'mm/view-header-key-face) ": "
@ -125,20 +130,20 @@ or if not available, :body-html converted to text)."
(defun mm/view-contacts (msg field)
(unless (member field '(:to :from :bcc :cc)) (error "Wrong type"))
"Add a header for a contact field (ie., :to, :from, :cc, :bcc)."
(let* ((lst (plist-get msg field))
(fieldname (cdr (assoc field mm/header-names)))
(contacts
(when lst
(and lst
(mapconcat
(lambda(c)
(let ((name (car c)) (email (cdr c)))
(if name
(format "%s <%s>" name email)
(format "%s" email)))) lst ", "))))
(message "%S %S" field fieldname)
(if contacts
(mm/view-header
(case field (:to "To") (:from "From") (:bcc "Bcc") (:cc "Cc"))
contacts)
(mm/view-header fieldname contacts)
"")))
(defvar mm/attach-map nil
@ -207,7 +212,7 @@ or if not available, :body-html converted to text)."
(define-key map (kbd "<delete>") 'mm/view-mark-for-delete)
(define-key map "D" 'mm/view-mark-for-delete)
(define-key map "a" 'mm/mark-for-move-quick)
(define-key map "m" 'mm/view-mark-for-move)
;; misc
@ -249,7 +254,7 @@ or if not available, :body-html converted to text)."
'("Mark for trash" . mm/view-mark-for-trash))
(define-key menumap [mark-move]
'("Mark for move" . mm/view-mark-for-move))
(define-key menumap [sepa2] '("--"))
(define-key menumap [compose-new] '("Compose new" . mm/compose-new))
(define-key menumap [forward] '("Forward" . mm/compose-forward))

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)