* mm: many updates (still WIP)

toys/mm/mm-hdrs.el

@@ -430,10 +430,18 @@ work well."
 (defun mm/hdrs-compose (compose-type)
   "Compose either a reply/forward based on the message at point. or
 start editing it. COMPOSE-TYPE is either `reply', `forward' or
-`draft'."
+`edit'."
-  (let ((docid (mm/hdrs-get-docid)))
+  (if (eq compose-type 'new)
-    (unless docid (error "No message at point."))
+    (mm/send-compose-handler 'new)
-    (mm/proc-compose-msg docid compose-type)))
+    (let ((docid (mm/hdrs-get-docid)))
+      (when (and (not docid) (not ))
+	(error "No message at point."))
+      (cond
+	((member compose-type '(reply forward))
+	  (mm/proc-compose compose-type docid))
+	((eq compose-type 'edit)
+	  (mm/proc-compose 'edit docid))
+	(t (error "invalid compose type %S" compose-type))))))
 
 
 (defun mm/hdrs-docid-is-marked (docid)
@@ -609,14 +617,21 @@ folder (`mm/trash-folder')."
   (with-current-buffer mm/hdrs-buffer
     (mm/hdrs-compose 'forward)))
 
+(defun mm/compose-new ()
+  "Compose a new, empty message."
+  (interactive)
+  (mm/hdrs-compose 'new))
+
 (defun mm/edit-draft ()
   "Start editing the existing draft message at point."
   (interactive)
   (with-current-buffer mm/hdrs-buffer
-    (mm/hdrs-compose 'draft)))
+    (mm/hdrs-compose 'edit)))
+
+
+
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (provide 'mm-hdrs)
-

toys/mm/mm-proc.el

@@ -240,8 +240,8 @@ updated as well, with all processed sexp data removed."
 	;; start composing a new message
 	((plist-get sexp :compose)
 	  (funcall mm/proc-compose-func
-	    (plist-get sexp :compose)
+	    (plist-get sexp :compose-type)
-	    (plist-get sexp :action)))
+	    (plist-get sexp :compose)))
 
 	;; get some info
 	((plist-get sexp :info)
@@ -345,10 +345,10 @@ or (:error ) sexp, which are handled my `mm/proc-update-func' and
     ;; note, we send the maildir, *not* the full path
     (mm/proc-send-command "move %d \"%s\" \"%s\"" docid targetmdir flagstr)))
 
-(defun mm/proc-flag-msg (docid flags)
+(defun mm/proc-flag (docid-or-msgid flags)
-  "Set FLAGS for the message identified by DOCID."
+  "Set FLAGS for the message identified by either DOCID-OR-MSGID."
   (let ((flagstr (if (stringp flags) flags (mm/flags-to-string flags))))
-    (mm/proc-send-command "flag %d %s" docid flagstr)))
+    (mm/proc-send-command "flag %S %s" docid-or-msgid flagstr)))
 
 (defun mm/proc-index (maildir)
   "Update the message database for MAILDIR."
@@ -373,43 +373,35 @@ set to e.g. '/drafts'; if this works, we will receive (:info :path
 be delivered to the function registered as `mm/proc-message-func'."
   (mm/proc-send-command "view %d" docid))
 
-(defun mm/proc-compose-msg (docid compose-type)
+(defun mm/proc-compose (compose-type docid)
   "Start composing a message with DOCID and COMPOSE-TYPE (a symbol,
-  either `forward', `reply' or `draft'.
+  either `forward', `reply' or `edit'.
 The result will be delivered to the function registered as
 `mm/proc-compose-func'."
-  (unless (member compose-type '(forward reply draft))
+  (unless (member compose-type '(forward reply edit))
     (error "Unsupported compose-type"))
   (mm/proc-send-command "compose %s %d" (symbol-name compose-type) docid))
 
 
+(defconst mm/update-buffer-name "*update*"
+  "*internal* Name of the buffer to download mail")
+
 (defun mm/proc-retrieve-mail-update-db ()
   "Try to retrieve mail (using the user-provided shell command),
 and update the database afterwards."
-  (when mm/get-mail-command
+  (unless mm/get-mail-command
-    (let ((buf (get-buffer-create "*mm-retrieve*"))
+    (error "`mm/get-mail-command' is not defined"))
-	   (cmd mm/get-mail-command))
+  (let ((buf (get-buffer-create  mm/update-buffer-name)))
-      (message "Retrieving mail...")
+    (split-window-vertically -8)
-      (let ((proc (start-process "*mm-retrieve*" buf "sh" "-c" cmd)))
+    (switch-to-buffer-other-window buf)
-	(set-process-sentinel proc 'mm/proc-retrieve-mail-sentinel)))))
+    (with-current-buffer buf
-
+      (erase-buffer))
-
+    (message "Retrieving mail...")
-(defun mm/proc-retrieve-mail-sentinel (proc msg)
+    (call-process mm/get-mail-command nil buf t)
-  "Function that will be called when the mail retrieval process
+    (message "Updating the database...")
-terminates."
+    (mm/proc-index mm/maildir)
-  (let ((status (process-status proc)) (code (process-exit-status proc)))
+    (with-current-buffer buf
-    (cond
+      (kill-buffer-and-window))))
-      ((eq status 'signal)
-	(cond
-	  ((eq code 9) (message "the mail retrieval process has been stopped"))
-	  (t (message (format "mu server process received signal %d" code)))))
-      ((eq status 'exit)
-	(if (eq code 0) ;; all went well, it seems
-	  (progn
-	    (message "Updating the database...")
-	    (mm/proc-index mm/maildir))
-	  (progn
-	    (message "Received code %d from mail retrieval process" code)))))))
 
 
 (provide 'mm-proc)

toys/mm/mm-send.el

@@ -109,10 +109,6 @@ or if not available, :body-html converted to text)."
 	  (format "%s <%s>" name email)
 	  (format "%s" email)))) lst ", "))
 
-(defun mm/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 mm/msg-header (hdr val)
   "Return a header line of the form HDR: VAL\n. If VAL is nil,
@@ -126,10 +122,12 @@ 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 (plist-get msg :references))
-	 (msgid (plist-get msg :message-id)))
+	 (old-msgid (plist-get msg :message-id)))
-    (if msgid ;; every received message should have one...
+    (when old-msgid
-      (mapconcat 'identity (append refs (list msgid)) ",")
+      (setq refs (append refs (list old-msgid)))
-      (mapconcat 'identity refs ","))))
+      (mapconcat
+	(lambda (msgid) (format "<%s>" msgid))
+	refs ","))))
 
 (defun mm/msg-to-create (msg reply-all)
   "Construct the To: header for a reply-message based on some
@@ -183,12 +181,8 @@ nil, function returns nil."
       (format "%s <%s>" user-full-name user-mail-address)
       (format "%s" user-mail-address))))
 
-(defconst mm/reply-docid-header "Reply-docid"
+(defun mm/msg-create-reply (msg)
-  "*internal* The reply-to-docid header.")
+  "Create a draft message as a reply to MSG.
-
-(defun mm/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'
@@ -206,29 +200,30 @@ Then follows `mail-header-separator' (for `message-mode' to separate
 body from headers)
 
 And finally, the cited body of MSG, as per `mm/msg-cite-original'."
-     (concat
+  (let* ((recipnum (+ (length (plist-get msg :to))
-       (mm/msg-header "From" (or (mm/msg-from-create) ""))
+		     (length (plist-get msg :cc))))
-       (when (boundp 'mail-reply-to)
+	  (reply-all (when (> recipnum 1)
-	 (mm/msg-header "Reply-To" mail-reply-to))
+		      (yes-or-no-p
+			(format "Reply to all ~%d recipients? "
+			  (+ recipnum))))))
+    (concat
+      (mm/msg-header "From" (or (mm/msg-from-create) ""))
+      (when (boundp 'mail-reply-to)
+	(mm/msg-header "Reply-To" mail-reply-to))
 
-       (mm/msg-header "To" (or (mm/msg-to-create msg reply-all) ""))
+      (mm/msg-header "To" (or (mm/msg-to-create msg reply-all) ""))
-       (mm/msg-header "Cc" (mm/msg-cc-create msg reply-all))
+      (mm/msg-header "Cc" (mm/msg-cc-create msg reply-all))
 
-       (mm/msg-hidden-header "User-agent"  (mm/msg-user-agent))
+      (mm/msg-header "User-agent"  (mm/msg-user-agent))
-       (mm/msg-hidden-header mm/reply-docid-header  (plist-get msg :docid))
+      (mm/msg-header "References"  (mm/msg-references-create msg))
-       (mm/msg-hidden-header "References"  (mm/msg-references-create msg))
 
-       (mm/msg-hidden-header "In-reply-to" (plist-get msg :message-id))
+      (mm/msg-header "In-reply-to" (format "<%s>" (plist-get msg :message-id)))
 
-       (mm/msg-header "Subject"
+      (mm/msg-header "Subject"
-	 (concat mm/msg-reply-prefix (plist-get msg :subject)))
+	(concat mm/msg-reply-prefix (plist-get msg :subject)))
 
-       (propertize mail-header-separator 'read-only t 'intangible t) '"\n"
+      (propertize mail-header-separator 'read-only t 'intangible t) '"\n"
-       (mm/msg-cite-original msg)))
+      (mm/msg-cite-original msg))))
-
-
-(defconst mm/forward-docid-header "Forward-docid"
-  "*internal* The reply-to-docid header.")
 
 ;; TODO: attachments
 (defun mm/msg-create-forward (msg)
@@ -254,13 +249,10 @@ And finally, the cited body of MSG, as per `mm/msg-cite-original'."
 	 (mm/msg-header "Reply-To" mail-reply-to))
 
       (mm/msg-header "To" "")
-      (mm/msg-hidden-header "User-agent"  (mm/msg-user-agent))
+      (mm/msg-header "User-agent"  (mm/msg-user-agent))
-      (mm/msg-hidden-header "References"  (mm/msg-references-create msg))
+      (mm/msg-header "References"  (mm/msg-references-create msg))
-      (mm/msg-hidden-header mm/forward-docid-header  (plist-get msg :docid))
-
       (mm/msg-header"Subject"
 	 (concat mm/msg-forward-prefix (plist-get msg :subject)))
-
       (propertize mail-header-separator 'read-only t 'intangible t) "\n"
 
       (mm/msg-cite-original msg)))
@@ -283,63 +275,76 @@ body from headers)."
     (mm/msg-header "From" (or (mm/msg-from-create) ""))
     (when (boundp 'mail-reply-to)
       (mm/msg-header "Reply-To" mail-reply-to))
-
     (mm/msg-header "To" "")
-    (mm/msg-hidden-header "User-agent"  (mm/msg-user-agent))
+    (mm/msg-header "User-agent"  (mm/msg-user-agent))
     (mm/msg-header "Subject" "")
     (propertize mail-header-separator 'read-only t 'intangible t) "\n"))
 
-(defconst mm/msg-prefix "mm" "prefix for mm-generated
+(defun mm/msg-open-draft (compose-type &optional msg)
-mail files; we use this to ensure that our hooks don't mess
+  "Open a draft file for a new message, creating it if it does not
-with non-mm-generated messages")
+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)))))
+    (when str
+      (with-temp-file draft
+	(insert str)
+	(write-file draft)))
 
-(defun mm/msg-draft-file-name ()
+    ;; save our file immediately, add add it to the db; thus, we can retrieve
-  "Create a Maildir-compatible[1], unique file name for a draft
+    ;; the new docid from `mm/path-docid-map'.
-message.
+    (mm/proc-add draft mm/drafts-folder)
- [1]: see http://cr.yp.to/proto/maildir.html"
+    draft))
-  (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)))
-;;;    (replace-regexp-in-string "[:/]" "_" (system-name))))
 
-(defun mm/msg-compose (str &optional parent-docid reply-or-forward)
-  "Create a new draft message in the drafts folder with STR as
-its contents, and open this message file for editing.
 
-For replies/forewards, you can specify PARENT-DOCID so the
+(defun mm/send-compose-handler (compose-type &optional msg)
-corresponding message can get its Passed or Replied flag set when
+  "Create a new draft message, or open an existing one.
-this one is sent. If PARENT-DOCID is specified, also
-reply-or-forward should be specified, which is a symbol, either
-'reply or 'forward.
 
-The name of the draft folder is constructed from the concatenation of
+COMPOSE-TYPE determines the kind of message to compose and is a
- `mm/maildir' and `mm/drafts-folder' (therefore, these must be set).
+symbol, either `reply', `forward', `edit', `new'. `edit' is for
+editing existing messages.
+
+When COMPOSE-TYPE is `reply' or `forward', MSG should be a message
+plist.  If COMPOSE-TYPE is `new', MSG should be nil.
+
+The name of the draft folder is constructed from the concatenation
+ of `mm/maildir' and `mm/drafts-folder' (therefore, these must be
+ set).
 
 The message file name is a unique name determined by
 `mm/msg-draft-file-name'.
 
 The initial STR would be created from either `mm/msg-create-reply',
-`mm/msg-create-forward' or `mm/msg-create-new'. The editing buffer is
+ar`mm/msg-create-forward' or `mm/msg-create-new'. The editing buffer is
 using Gnus' `message-mode'."
   (unless mm/maildir       (error "mm/maildir not set"))
   (unless mm/drafts-folder (error "mm/drafts-folder not set"))
+  (let ((draft
+	  (if (member compose-type '(reply forward new))
+	    (mm/msg-open-draft compose-type msg)
+	    (if (eq compose-type 'edit)
+	      (plist-get msg :path)
+	      (error "unsupported compose-type %S" compose-type)))))
 
-  ;; write our draft message to the the drafts folder
+    (unless (file-readable-p draft)
-  (let ((draftfile (concat mm/maildir mm/drafts-folder "/cur/"
+      (error "Cannot read %s" path))
-		     (mm/msg-draft-file-name))))
-    (with-temp-file draftfile (insert str))
-    (find-file draftfile)
-    (rename-buffer mm/msg-draft-name t)
 
-    ;; save our file immediately, add add it to the db; thus, we can retrieve
+    (find-file draft)
-    ;; the new docid from `mm/path-docid-map'.
-    (write-file draftfile)
-    (mm/proc-add draftfile mm/drafts-folder)
     (message-mode)
 
     (make-local-variable 'write-file-functions)
-    
+
     ;; update the db when the file is saved...]
     (add-to-list 'write-file-functions
       (lambda() (mm/proc-add (buffer-file-name) mm/drafts-folder)))
@@ -350,56 +355,17 @@ using Gnus' `message-mode'."
 
     (let ((message-hidden-headers
 	    `("^References:" "^Face:" "^X-Face:" "^X-Draft-From:"
-	       ,(concat mm/reply-docid-header ":")
-	       ,(concat mm/forward-docid-header ":")
 	       "^User-agent:")))
       (message-hide-headers))
 
     (message-goto-body)))
-
-
-(defun mm/send-compose-handler (msg compose-type)
-  "This function is registered as the compose handler in
-`mm/proc-compose-func', and will be called when a new message is to
-be composed, based on some existing one. MSG is a message sexp,
-while COMPOSE-TYPE is a symbol, either 'reply or 'forward.
-
-In case of 'forward, create a draft forward for MSG, and switch to
-an edit buffer with the draft message.
-
-In case of 'reply, create a draft reply to MSG, and swith to an
-edit buffer with the draft message"
-  (cond
-    ((eq compose-type 'forward) ;; forward
-      (when (mm/msg-compose (mm/msg-create-forward msg)
-	      (plist-get msg :docid) 'forward)
-	(message-goto-to)))
-    ((eq compose-type 'reply) ;; reply
-      (let* ((recipnum (+ (length (plist-get msg :to))
-			   (length (plist-get msg :cc))))
-	      (replyall (when (> recipnum 1)
-			  (yes-or-no-p
-			    (format "Reply to all ~%d recipients? "
-			      (+ recipnum))))))
-	;; exact num depends on some more things
-	  (when (mm/msg-compose (mm/msg-create-reply msg replyall)
-		  (plist-get msg :docid) 'reply)
-	    (message-goto-body))))
-    ((eq compose-type 'draft)
-      (unless (member 'draft (plist-get msg :flags))
-	(error "Cannot edit a non-draft message"))
-      (mm/edit-draft (plist-get msg :docid) (plist-get msg :path)))
-
-    (t (error "unexpected type %S in compose handler" compose-type))))
-
 
 
 (defun mm/msg-save-to-sent ()
   "Move the message in this buffer to the sent folder. This is
  meant to be called from message mode's `message-sent-hook'."
   (unless mm/sent-folder (error "mm/sent-folder not set"))
-  (when mm/mm-msg ;; only if we are mm
+  (let ((docid (gethash (buffer-file-name)  mm/path-docid-map)))
-    (let ((docid (gethash (buffer-file-name)  mm/path-docid-map)))
       (unless docid (error "unknown message (%S)" (buffer-file-name)))
       ;; ok, all seems well, well move the message to the sent-folder
       (mm/proc-move-msg docid mm/sent-folder "-T-D+S")
@@ -409,67 +375,44 @@ edit buffer with the draft message"
       ;; mark the buffer as read-only, as its pointing at a non-existing file
       ;; now...
       (message "Message has been sent")
-      (setq buffer-read-only t))))
+      (setq buffer-read-only t)))
 
 
 (defun mm/send-set-parent-flag ()
   "Set the 'replied' flag on messages we replied to, and the
 'passed' flag on message we have forwarded.
 
-We do this by checking for our special header, either
+If a message has a 'in-reply-to' header, it is considered a reply
-`mm/reply-docid-header' or `mm/forward-docid-header'. Doing it this
+to the message with the corresponding message id. If it does not
-way ensure that we know the parent-docid even when re-editing
+have an 'in-reply-to' header, but does have a 'references' header,
-drafts (alternatively, we could try to the 'parent' message
+it is considered to be a forward message for the message
-using "In-reply-to"/"References", but since that is not necessarily
+corresponding with the /last/ message-id in the references header.
-accurate, doing it the way we do, is better.
 
-TODO: remove this header again, before really sending.
+Now, if the message has been determined to be either a forwarded
+message or a reply, we instruct the server to update that message
+with resp. the 'P' (passed) flag for a forwarded message, or the
+'R' flag for a replied message.
 
 This is meant to be called from message mode's
 `message-sent-hook'."
-  ;; handle the replied-to message
+  (let ((in-reply-to (message-fetch-field "in-reply-to"))
-  (save-excursion
+	 (forwarded-from)
-    (goto-char (point-min))
+	 (references (message-fetch-field "references")))
-    (let ((eoh (when (search-forward mail-header-separator nil t)
+    (unless in-reply-to
-		 (point))) (reply-docid) (forward-docid))
+      (when references
-      (when eoh ;; end-of-headers
+	(with-temp-buffer ;; inspired by `message-shorten-references'.
-	(goto-char (point-min))
+	  (insert references)
-	(if (re-search-forward
+	  (goto-char (point-min))
-	      (concat "^" mm/reply-docid-header ":[:blank:]*\\([0-9]+\\)") eoh t)
+	  (let ((refs))
-	  (setq reply-docid (string-to-int (match-string 1)))
+	    (while (re-search-forward "<[^ <]+@[^ <]+>" nil t)
-	  (when (re-search-forward
+	      (push (match-string 0) refs))
-		(concat "^" mm/forward-docid-header ":[:blank:]*\\([0-9]+\\)") eoh t)
+	    (setq forwarded-from (last refs))
-	    (setq forward-docid (string-to-int (match-string 1))))))
+	    (message "refs: %S, forwarded-from %S" refs forwarded-from)))))
 
-      (when reply-docid   (mm/proc-flag-msg reply-docid "+R"))
+    (when in-reply-to
-      (when forward-docid (mm/proc-flag-msg forward-docid "+P")))))
+      (mm/proc-flag in-reply-to "+R"))
-
+    (when forwarded-from
-(defun mm/edit-draft (docid path)
+      (mm/proc-flag forwarded-from "+P"))))
-  "Edit a draft message."
-
-  (unless (file-readable-p path) (error "Cannot read %s" path))
-  (find-file path)
-  (message-mode)
-
-  ;; hook our functions up with sending of the message
-  (add-hook 'message-sent-hook 'mm/msg-save-to-sent nil t)
-  (add-hook 'message-sent-hook 'mm/send-set-parent-flag nil t)
-
-  (message-goto-body))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; some interactive function
-
-(defun mm/compose-new ()
-  "Create a draft message, and switch to an edit buffer with the
-draft message."
-  (interactive)
-  (when (mm/msg-compose (mm/msg-create-new))
-    (message-goto-to)))
 
 
 (provide 'mm-send)
-
-
-

toys/mm/mm-view.el

@@ -207,9 +207,9 @@ or if not available, :body-html converted to text)."
     ;; misc
     (define-key map "w" 'mm/view-toggle-wrap-lines)
     (define-key map "h" 'mm/view-toggle-hide-quoted)
-    (define-key map "g" 'mm/view-refresh)
-
 
+    (define-key map "R" 'mm/view-refresh)
+    
     ;; next 3 only warn user when attempt in the message view
     (define-key map "u" 'mm/view-unmark)
     (define-key map "U" 'mm/view-unmark)
@@ -258,7 +258,7 @@ Seen; if the message is not New/Unread, do nothing."
 	   (docid (plist-get mm/current-msg :docid)))
       ;; is it a new message?
       (when (or (member 'unread flags) (member 'new flags))
-	(mm/proc-flag-msg docid "+S-u-N")))))
+	(mm/proc-flag docid "+S-u-N")))))
 
 
 (defvar mm/link-map nil
@@ -272,7 +272,7 @@ removing '^M' etc."
 
     ;; remove the stupid CRs
     (goto-char (point-min))
-    (while (search-forward "
\\| " nil t)
+    (while (re-search-forward "
\\| " nil t)
       (replace-match "" nil t))
 
     ;; give the footer a different color...

toys/mm/mm.el

@@ -347,7 +347,7 @@ be sure it no longer matches)."
 (defun mm/search-drafts ()
   "Jump to your Drafts folder (as specified in `mm/draft-folder')."
   (interactive)
-  (mm/hdrs-search (concat "maildir:" mm/drafts-folder  " OR ;; flag:draft")))
+  (mm/hdrs-search (concat "maildir:" mm/drafts-folder  " OR flag:draft")))
 
 (defun mm/search-unread ()
   "List all your unread messages."