diff --git a/toys/mm/mm-common.el b/toys/mm/mm-common.el deleted file mode 100644 index d5f5f13b..00000000 --- a/toys/mm/mm-common.el +++ /dev/null @@ -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 -;; Maintainer: Dirk-Jan C. Binnema -;; 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 . - -;;; 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) diff --git a/toys/mm/mm-hdrs.el b/toys/mm/mm-hdrs.el index b2c7ef53..2ab57c19 100644 --- a/toys/mm/mm-hdrs.el +++ b/toys/mm/mm-hdrs.el @@ -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 "") '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')." diff --git a/toys/mm/mm-proc.el b/toys/mm/mm-proc.el index 848ea838..4bc85e86 100644 --- a/toys/mm/mm-proc.el +++ b/toys/mm/mm-proc.el @@ -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) diff --git a/toys/mm/mm-send.el b/toys/mm/mm-send.el index 945fa4ca..af7e90a5 100644 --- a/toys/mm/mm-send.el +++ b/toys/mm/mm-send.el @@ -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) diff --git a/toys/mm/mm-view.el b/toys/mm/mm-view.el index 523cd1e3..76a13a6a 100644 --- a/toys/mm/mm-view.el +++ b/toys/mm/mm-view.el @@ -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. : value-of-FIELD\n." + "Show header FIELD for MSG with KEY. ie. : 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 "") '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)) diff --git a/toys/mm/mm.el b/toys/mm/mm.el index 5074f5de..1ed5a922 100644 --- a/toys/mm/mm.el +++ b/toys/mm/mm.el @@ -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)