* mm: updates

toys/mm/mm-common.el

@@ -116,6 +116,7 @@ Also see `mu/flags-to-string'.
     (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

toys/mm/mm-hdrs.el

@@ -99,43 +99,38 @@ headers."
       (let* ((docid (plist-get msg :docid))
 	      (marker (gethash docid mm/msg-map))
 	      (point (when marker (marker-position marker))))
-	(unless docid (error "Invalid update %S" update))
 	(when point ;; is the message present in this list?
-	  (save-excursion
+	  ;; if it's marked, unmark it now
-	    (goto-char point)
+	  (when (mm/hdrs-docid-is-marked docid) (mm/hdrs-mark 'unmark))
-	    ;; sanity check
+	  ;; first, remove the old one (otherwise, we'd have to headers with
-	    (unless (eq docid (mm/hdrs-get-docid))
+	  ;; the same docid...
-	      (error "Unexpected docid: %S <=> %S" docid (mm/hdrs-get-docid)))
+	  (mm/hdrs-remove-handler docid)
+	  ;; now, if this update was about *moving* a message, we don't show it
+	  ;; anymore (of course, we cannot be sure if the message really no
+	  ;; longer matches the query, but this seem a good heuristic.
+	  ;; if it was only a flag-change, show the message with its updated flags.
+	  (unless is-move
+	    (mm/hdrs-header-handler msg point)))))))
 
-	    ;; if it's marked, unmark it now
-	    (when (mm/hdrs-docid-is-marked docid)
-	      (mm/hdrs-mark 'unmark))
-
-	    ;; first, remove the old one (otherwise, we'd have to headers with
-	    ;; the same docid...
-	    (mm/hdrs-remove-header docid point)
-
-	    ;; now, if this update was about *moving* a message, we don't show it
-	    ;; anymore (of course, we cannot be sure if the message really no
-	    ;; longer matches the query, but this seem a good heuristic.
-	    ;; if it was only a flag-change, show the message with its updated flags.
-	    (when (not is-move)
-	      (mm/hdrs-header-handler msg point))))))))
 
 (defun mm/hdrs-remove-handler (docid)
   "Remove handler, will be called when a message has been removed
 from the database. This function will hide the remove message in
 the current list of headers."
   (with-current-buffer mm/hdrs-buffer
-    (let ((marker (gethash docid mm/msg-map)))
+    (let* ((marker (gethash docid mm/msg-map))
+	    (pos (and marker (marker-position marker)))
+	    (docid-at-pos (and pos (mm/hdrs-get-docid pos))))
       (unless marker (error "Message %d not found" docid))
-      (mm/hdrs-remove-header docid (marker-position marker)))))
+      (unless (eq docid docid-at-pos)
+	(error "At point %d, expected docid %d, but got %d" pos docid docid-at-pos))
+      (mm/hdrs-remove-header docid pos))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defun mm/hdrs-header-handler (msg &optional point)
-  "Create a one line description of MSG in this buffer at
+  "Create a one line description of MSG in this buffer, at POINT,
-point. Line does not include a newline or any text-properties."
+if provided, or at the end of the buffer otherwise."
   (let* ((line (mapconcat
 		(lambda (f-w)
 		  (let* ((field (car f-w)) (width (cdr f-w))
@@ -167,7 +162,8 @@ point. Line does not include a newline or any text-properties."
 		  ((member 'trashed flags) (propertize line 'face 'mm/trashed-face))
 		  ((member 'unread flags)  (propertize line 'face 'mm/unread-face))
 	      (t                       (propertize line 'face 'mm/header-face)))))
-    (mm/hdrs-add-header line (plist-get msg :docid) point)))
+    (mm/hdrs-add-header line (plist-get msg :docid)
+      (if point point (point-max)))))
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 
@@ -189,23 +185,30 @@ point. Line does not include a newline or any text-properties."
     (define-key map "j" 'mm/jump-to-maildir)
 
 
-    
+
     ;; marking/unmarking/executing
     (define-key map "m" 'mm/mark-for-move)
+
     (define-key map "d" 'mm/mark-for-trash)
+    (define-key map (kbd "<backspace>") 'mm/mark-for-trash)
+
     (define-key map "D" 'mm/mark-for-delete)
+    (define-key map (kbd "<delete>") 'mm/mark-for-delete)
+
     (define-key map "u" 'mm/unmark)
     (define-key map "U" 'mm/unmark-all)
     (define-key map "x" 'mm/execute-marks)
 
     (define-key map " " 'mm/select)
     (define-key map "*" 'mm/select)
-    
+
-    
+
     ;; message composition
     (define-key map "r" 'mm/compose-reply)
     (define-key map "f" 'mm/compose-forward)
     (define-key map "c" 'mm/compose-new)
+    (define-key map "e" 'mm/edit-draft)
+
 
     (define-key map (kbd "RET") 'mm/view-message)
     map)
@@ -261,27 +264,27 @@ provided, put it at the end of the buffer."
   (unless docid (error "Invalid message"))
   (when (buffer-live-p mm/hdrs-buffer)
     (with-current-buffer mm/hdrs-buffer
-      (let ((inhibit-read-only t)
+      (let ((inhibit-read-only t))
-	     (bol (line-beginning-position))
-	     (eol (line-beginning-position 2))
-	     (point (if point point (point-max))))
 	(save-excursion
 	  (goto-char point)
 	  ;; Update `mm/msg-map' with MSG, and MARKER pointing to the buffer
 	  ;; position for the message header."
-	  (puthash docid (copy-marker point) mm/msg-map)
+	  (insert (propertize (concat "  " str "\n")  'docid docid))
-	  (insert (propertize (concat "  " str "\n")  'docid docid)))))))
+	  (puthash docid (copy-marker point t) mm/msg-map))))))
 
 (defun mm/hdrs-remove-header (docid point)
   "Remove header with DOCID at POINT."
   (with-current-buffer mm/hdrs-buffer
-    (save-excursion
+    (goto-char point)
-      (goto-char point)
+    ;; sanity check
-      ;; sanity check
+    (unless (eq docid (mm/hdrs-get-docid))
-      (unless (eq docid (mm/hdrs-get-docid)) (error "Unexpected docid"))
+      (error "%d: Expected %d, but got %d"
-      (let ((inhibit-read-only t))
+	(line-number-at-pos) docid (mm/hdrs-get-docid)))
-	(delete-region (line-beginning-position) (line-beginning-position 2)))
+    (let ((inhibit-read-only t))
-       (remhash docid mm/msg-map))))
+      ;; (put-text-property (line-beginning-position line-beginning-positio 2)
+      ;; 	'invisible t))
+      (delete-region (line-beginning-position) (line-beginning-position 2)))
+    (remhash docid mm/msg-map)))
 
 (defun mm/hdrs-mark-header (docid mark)
   "(Visually) mark the header for DOCID with character MARK."
@@ -295,13 +298,26 @@ provided, put it at the end of the buffer."
 	    (delete-char 2)
 	    (insert mark " ")
 	    (put-text-property pos
-	      (line-beginning-position 2) 'docid docid)))))))
+	      (line-beginning-position 2) 'docid docid)
-  
+	    ;; update the msg-map, ie., move it back to the start of the line
-	  
+	    (puthash docid
-(defun mm/hdrs-get-docid ()
+	      (copy-marker (line-beginning-position) t)
-  "Get the docid for the message at point, or nil if there is none"
+	      mm/msg-map)))))))
+
+
+(defun mm/hdrs-get-docid (&optional point)
+  "Get the docid for the message at POINT, if provided, or (point), otherwise."
   (with-current-buffer mm/hdrs-buffer
-      (get-text-property (point) 'docid)))
+    (get-text-property (if point point (point)) 'docid)))
+
+(defun mm/dump-msg-map ()
+  "*internal* dump the message map (for debugging)."
+  (with-current-buffer mm/hdrs-buffer
+    (message "msg-map (%d)" (hash-table-count mm/msg-map))
+    (maphash
+      (lambda (k v)
+	(message "%s => %s" k v))
+      mm/msg-map)))
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 
@@ -317,8 +333,8 @@ where
    MARK is the type of mark (move, trash, delete)
    TARGET (optional) is the target directory (for 'move')")
 
-(defun mm/hdrs-mark (mark &optional target)
+(defun mm/hdrs-mark-message (mark &optional target)
-  "Mark (or unmark) header line at point. MARK specifies the
+  "Mark (or unmark) message at point. MARK specifies the
   mark-type. For `move'-marks there is also the TARGET argument,
   which specifies to which maildir the message is to be moved.
 
@@ -349,6 +365,24 @@ The following marks are available, and the corresponding props:
 	(puthash docid (list (point-marker) mark target) mm/marks-map)))))
 
 
+(defun mm/hdrs-mark (mark &optional target)
+  "Mark the header at point, or, if
+region is active, mark all headers in the region. Als see
+`mm/hdrs-mark-message'."
+  (with-current-buffer mm/hdrs-buffer
+    (if (use-region-p)
+      ;; mark all messages in the region.
+      (save-excursion
+	(let ((b (region-beginning)) (e (region-end)))
+	  (goto-char b)
+	  (while (<= (line-beginning-position) e)
+	    (mm/hdrs-mark-message mark target)
+	    (forward-line 1))))
+      ;; just a single message
+      (mm/hdrs-mark-message mark target))))
+
+
+
 (defun mm/hdrs-marks-execute ()
   "Execute the actions for all marked messages in this
 buffer. After the actions have been executed succesfully, the
@@ -393,12 +427,13 @@ work well."
     (unless docid (error "No message at point."))
     (mm/proc-view-msg docid)))
 
-(defun mm/hdrs-compose (reply-or-forward)
+(defun mm/hdrs-compose (compose-type)
-  "Compose either a reply or a forward based on the message at
+  "Compose either a reply/forward based on the message at point. or
-point."
+start editing it. COMPOSE-TYPE is either `reply', `forward' or
+`draft'."
   (let ((docid (mm/hdrs-get-docid)))
     (unless docid (error "No message at point."))
-    (mm/proc-compose-msg docid reply-or-forward)))
+    (mm/proc-compose-msg docid compose-type)))
 
 
 (defun mm/hdrs-docid-is-marked (docid)
@@ -460,17 +495,16 @@ do a new search."
 the new docid. Otherwise, return nil."
   (interactive)
   (with-current-buffer mm/hdrs-buffer
-    (let ((old (line-number-at-pos)))      
+    (when (= 0 (forward-line 1))
-      (if (= 0 (forward-line 1))
+      (let ((docid (mm/hdrs-get-docid)))
-	(let ((docid (mm/hdrs-get-docid)))
+	(if docid docid (mm/next-header))))))
-	  (if docid docid (mm/next-header)))))))
 
 (defun mm/prev-header ()
   "Move point to the previous message header. If this succeeds,
 return the new docid. Otherwise, return nil."
   (interactive)
   (with-current-buffer mm/hdrs-buffer
-    (if (= 0 (forward-line -1))
+    (when (= 0 (forward-line -1))
       (let ((docid (mm/hdrs-get-docid)))
 	(if docid docid (mm/prev-header)))))) ;; skip non-headers
 
@@ -498,11 +532,14 @@ return the new docid. Otherwise, return nil."
 ;; 	(when (eq (car val) 'select)
 ;; 	  (setq selected t)
 ;; 	  (case marktype
-	    
+
 ;;       mm/marks-map
 
 
 
+
+
+
 (defun mm/mark-for-move ()
   "Mark message at point for moving to a maildir."
   (interactive)
@@ -572,6 +609,12 @@ folder (`mm/trash-folder')."
   (with-current-buffer mm/hdrs-buffer
     (mm/hdrs-compose 'forward)))
 
+(defun mm/edit-draft ()
+  "Start editing the existing draft message at point."
+  (interactive)
+  (with-current-buffer mm/hdrs-buffer
+    (mm/hdrs-compose 'draft)))
+
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 

toys/mm/mm-proc.el

@@ -72,6 +72,7 @@ for the format of <msg-plist>.")
   "*internal* A function called for each (:info type ....) sexp
 received from the server process.")
 
+
 (defvar mm/buf nil
   "*internal* Buffer for results data.")
 
@@ -92,7 +93,10 @@ process."
 	;; add draft messages to the db, so when we're sending them, we can move
 	;; to the sent folder using the `mm/proc-move'.
 	(puthash (plist-get info :path) (plist-get info :docid) mm/path-docid-map))
-      ((eq type 'version) (setq mm/mu-version (plist-get info :version)))
+      ((eq type 'version)
+	(setq
+	  mm/version  (plist-get info :version)
+	  mm/doccount (plist-get-info :doccount)))
       ((eq type 'index)
 	(if (eq (plist-get info :status) 'running)
 	  (message (format "Indexing... processed %d, updated %d"
@@ -104,11 +108,16 @@ process."
       ((plist-get info :message) (message "%s" (plist-get info :message))))))
 
 
+(defconst mm/server-name "*mm-server"
+  "*internal* Name of the server process, buffer.")
+
+
+
 (defun mm/start-proc ()
   "Start the mu server process."
   ;; TODO: add version check
   (unless (file-executable-p mm/mu-binary)
-    (error (format "%S is not executable" mm/mu-binary)))
+    (error (format "%S not found" mm/mu-binary)))
   (let* ((process-connection-type nil) ;; use a pipe
 	  (coding-system-for-read 'utf-8)
 	  (coding-system-for-write 'no-conversion)
@@ -116,7 +125,7 @@ process."
 	  (args (append args (when mm/mu-home
 			       (list (concat "--muhome=" mm/mu-home))))))
     (setq mm/buf "")
-    (setq mm/mu-proc (apply 'start-process "*mu-server*" "*mu-server*"
+    (setq mm/mu-proc (apply 'start-process mm/server-name mm/server-name
 		       mm/mu-binary args))
     ;; register a function for (:info ...) sexps
     (setq mm/proc-info-func 'mm/proc-info-handler)
@@ -126,9 +135,10 @@ process."
 
 (defun mm/kill-proc ()
   "Kill the mu server process."
-  (when (mm/proc-is-running)
+  (let (buf (get-buffer mm/server-name))
-    (let ((delete-exited-processes t))
+    (when buf
-      (kill-process mm/mu-proc)
+      (let ((delete-exited-processes t))
+	(kill-buffer buf))
       (setq
 	mm/mu-proc nil
 	mm/buf nil))))
@@ -142,16 +152,17 @@ process."
        \376<len-of-sexp>\376<sexp>
 Function returns this sexp, or nil if there was none. `mm/buf' is
 updated as well, with all processed sexp data removed."
-  (let* ((b (string-match "\376\\([0-9]+\\)\376" mm/buf))
+  (when mm/buf
-	  (sexp-len
+    (let* ((b (string-match "\376\\([0-9]+\\)\376" mm/buf))
-	    (when b (string-to-number (match-string 1 mm/buf)))))
+	    (sexp-len
-    ;; does mm/buf contain the full sexp?
+	      (when b (string-to-number (match-string 1 mm/buf)))))
-    (when (and b (>= (length mm/buf) (+ sexp-len (match-end 0))))
+      ;; does mm/buf contain the full sexp?
-      ;; clear-up start
+      (when (and b (>= (length mm/buf) (+ sexp-len (match-end 0))))
-      (setq mm/buf (substring mm/buf (match-end 0)))
+	;; clear-up start
-      (let ((objcons (read-from-string mm/buf)))
+	(setq mm/buf (substring mm/buf (match-end 0)))
-	(setq mm/buf (substring mm/buf sexp-len))
+	(let ((objcons (read-from-string mm/buf)))
-	(car objcons)))))
+	  (setq mm/buf (substring mm/buf sexp-len))
+	  (car objcons))))))
 
 
 (defun mm/proc-filter (proc str)
@@ -252,7 +263,8 @@ terminates."
     (cond
       ((eq status 'signal)
 	(cond
-	  ((eq code 9) (message "the mu server process has been stopped"))
+	  ((eq code 9) (message nil))
+	    ;;(message "the mu server process has been stopped"))
 	  (t (message (format "mu server process received signal %d" code)))))
       ((eq status 'exit)
 	(cond
@@ -361,18 +373,14 @@ 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 reply-or-forward)
+(defun mm/proc-compose-msg (docid compose-type)
-  "Start composing a message as either a forward or reply to
+  "Start composing a message with DOCID and COMPOSE-TYPE (a symbol,
-message with DOCID. REPLY-OR-FORWARD is either 'reply or 'forward.
+  either `forward', `reply' or `draft'.
-
 The result will be delivered to the function registered as
 `mm/proc-compose-func'."
-  (let ((action (cond
+  (unless (member compose-type '(forward reply draft))
-		  ((eq reply-or-forward 'forward) "forward")
+    (error "Unsupported compose-type"))
-		  ((eq reply-or-forward 'reply) "reply")
+  (mm/proc-send-command "compose %s %d" (symbol-name compose-type) docid))
-		  (t (error "symbol must be eiter 'reply or 'forward")))))
-    (mm/proc-send-command "compose %s %d" action docid)))
-
 
 
 (defun mm/proc-retrieve-mail-update-db ()

toys/mm/mm-send.el

@@ -42,9 +42,6 @@
 (defconst mm/msg-draft-name "*mm-draft*"
   "Name for draft messages.")
 
-(defconst mm/msg-separator "--text follows this line--\n\n"
-  "separator between headers and body, needed for `message-mode'")
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 ;; FIXME
@@ -68,8 +65,6 @@ or if not available, :body-html converted to text)."
       (buffer-string))
     "No body found"))
 
-
-
 (defun mm/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
@@ -188,6 +183,9 @@ 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"
+  "*internal* The reply-to-docid header.")
+
 (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.
@@ -204,7 +202,7 @@ A reply message has fields:
   In-Reply-To: - message-id of MSG
   User-Agent   - see  `mm/msg-user-agent'
 
-Then follows `mm/msg-separator' (for `message-mode' to separate
+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'."
@@ -217,16 +215,21 @@ And finally, the cited body of MSG, as per `mm/msg-cite-original'."
        (mm/msg-header "Cc" (mm/msg-cc-create msg reply-all))
 
        (mm/msg-hidden-header "User-agent"  (mm/msg-user-agent))
+       (mm/msg-hidden-header mm/reply-docid-header  (plist-get msg :docid))
        (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"Subject"
+       (mm/msg-header "Subject"
 	 (concat mm/msg-reply-prefix (plist-get msg :subject)))
 
-       mm/msg-separator
+       (propertize mail-header-separator 'read-only t 'intangible t) '"\n"
        (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)
   "Create a draft forward message for MSG.
@@ -241,7 +244,7 @@ then, the following fields, normally hidden from user:
   References:  - see `mm/msg-references-create'
   User-Agent   - see  `mm/msg-user-agent'
 
-Then follows `mm/msg-separator' (for `message-mode' to separate
+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'."
@@ -253,10 +256,12 @@ And finally, the cited body of MSG, as per `mm/msg-cite-original'."
       (mm/msg-header "To" "")
       (mm/msg-hidden-header "User-agent"  (mm/msg-user-agent))
       (mm/msg-hidden-header "References"  (mm/msg-references-create msg))
-       (mm/msg-header"Subject"
+      (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)))
 
-      mm/msg-separator
+      (propertize mail-header-separator 'read-only t 'intangible t) "\n"
 
       (mm/msg-cite-original msg)))
 
@@ -272,7 +277,7 @@ then, the following fields, normally hidden from user:
   Reply-To:    - if `mail-reply-to' has been set
   User-Agent   - see  `mm/msg-user-agent'
 
-Then follows `mm/msg-separator' (for `message-mode' to separate
+Then follows `mail-header-separator' (for `message-mode' to separate
 body from headers)."
   (concat
     (mm/msg-header "From" (or (mm/msg-from-create) ""))
@@ -282,7 +287,7 @@ body from headers)."
     (mm/msg-header "To" "")
     (mm/msg-hidden-header "User-agent"  (mm/msg-user-agent))
     (mm/msg-header "Subject" "")
-    mm/msg-separator))
+    (propertize mail-header-separator 'read-only t 'intangible t) "\n"))
 
 (defconst mm/msg-prefix "mm" "prefix for mm-generated
 mail files; we use this to ensure that our hooks don't mess
@@ -298,12 +303,6 @@ message.
     (random t)))
 ;;;    (replace-regexp-in-string "[:/]" "_" (system-name))))
 
-
-(defvar mm/send-reply-docid nil   "Docid of the message this is a reply to.")
-(defvar mm/send-forward-docid nil "Docid of the message being forwarded.")
-
-(defvar mm/mm-msg nil "Whether the current message is an mm msg.")
-
 (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.
@@ -337,58 +336,62 @@ using Gnus' `message-mode'."
     ;; the new docid from `mm/path-docid-map'.
     (write-file draftfile)
     (mm/proc-add draftfile mm/drafts-folder)
-
     (message-mode)
 
-    (make-local-variable 'mm/send-reply-docid)
+    (make-local-variable 'write-file-functions)
-    (make-local-variable 'mm/send-forward-docid)
-    (make-local-variable 'mm/mm-msg)
     
+    ;; update the db when the file is saved...]
+    (add-to-list 'write-file-functions
+      (lambda() (mm/proc-add (buffer-file-name) mm/drafts-folder)))
+
     ;; 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)
-    
-    (setq mm/mm-msg t)
 
-    (if (eq reply-or-forward 'reply)
+    (let ((message-hidden-headers
-      (setq mm/send-reply-docid   parent-docid)
+	    `("^References:" "^Face:" "^X-Face:" "^X-Draft-From:"
-      (setq mm/send-forward-docid parent-docid))
+	       ,(concat mm/reply-docid-header ":")
+	       ,(concat mm/forward-docid-header ":")
+	       "^User-agent:")))
+      (message-hide-headers))
 
     (message-goto-body)))
 
 
-(defun mm/send-compose-handler (msg reply-or-forward)
+(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 REPLY-OR-FORWARD is a symbol, either 'reply or 'forward.
+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
-  (unless (member reply-or-forward '(reply forward))
+    ((eq compose-type 'forward) ;; forward
-    (error "unexpected type in compose handler"))
+      (when (mm/msg-compose (mm/msg-create-forward msg)
-  (let ((parent-docid (plist-get msg :docid)))
+	      (plist-get msg :docid) 'forward)
-
+	(message-goto-to)))
-    (if (eq reply-or-forward 'forward)
+    ((eq compose-type 'reply) ;; reply
-
-      ;; forward
-      (when (mm/msg-compose (mm/msg-create-forward msg) parent-docid 'forward)
-	(message-goto-to))
-
-      ;; reply
       (let* ((recipnum (+ (length (plist-get msg :to))
-			 (length (plist-get msg :cc))))
+			   (length (plist-get msg :cc))))
 	      (replyall (when (> recipnum 1)
 			  (yes-or-no-p
-			    (format "Reply to all ~%d recipients (y) or only the sender (n)? "
+			    (format "Reply to all ~%d recipients? "
 			      (+ recipnum))))))
 	;; exact num depends on some more things
-	(when (mm/msg-compose (mm/msg-create-reply msg replyall) parent-docid 'reply)
+	  (when (mm/msg-compose (mm/msg-create-reply msg replyall)
-	  (message-goto-body))))))
+		  (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 ()
@@ -413,15 +416,46 @@ edit buffer with the draft message"
   "Set the 'replied' flag on messages we replied to, and the
 'passed' flag on message we have forwarded.
 
-NOTE: This does not handle the case yet of message which are
+We do this by checking for our special header, either
-edited from drafts. That case could be solved by searching for
+`mm/reply-docid-header' or `mm/forward-docid-header'. Doing it this
-the In-Reply-To message-id for replies.
+way ensure that we know the parent-docid even when re-editing
+drafts (alternatively, we could try to the 'parent' message
+using "In-reply-to"/"References", but since that is not necessarily
+accurate, doing it the way we do, is better.
+
+TODO: remove this header again, before really sending.
 
 This is meant to be called from message mode's
 `message-sent-hook'."
   ;; handle the replied-to message
-  (when mm/send-reply-docid (mm/proc-flag-msg mm/send-reply-docid "+R"))
+  (save-excursion
-  (when mm/send-forward-docid (mm/proc-flag-msg mm/send-forward-docid "+P")))
+    (goto-char (point-min))
+    (let ((eoh (when (search-forward mail-header-separator nil t)
+		 (point))) (reply-docid) (forward-docid))
+      (when eoh ;; end-of-headers
+	(goto-char (point-min))
+	(if (re-search-forward
+	      (concat "^" mm/reply-docid-header ":[:blank:]*\\([0-9]+\\)") eoh t)
+	  (setq reply-docid (string-to-int (match-string 1)))
+	  (when (re-search-forward
+		(concat "^" mm/forward-docid-header ":[:blank:]*\\([0-9]+\\)") eoh t)
+	    (setq forward-docid (string-to-int (match-string 1))))))
+
+      (when reply-docid   (mm/proc-flag-msg reply-docid "+R"))
+      (when forward-docid (mm/proc-flag-msg forward-docid "+P")))))
+
+(defun mm/edit-draft (docid path)
+  "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))
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

toys/mm/mm-view.el

@@ -54,7 +54,8 @@ UPDATE is non-nil, the current message will be (visually) updated.
 
 As a side-effect, a message that is being viewed loses its 'unread'
 marking if it still had that."
-  (let ((buf (get-buffer-create mm/view-buffer-name)) (inhibit-read-only t))
+  (let ((buf (get-buffer-create mm/view-buffer-name))
+	 (inhibit-read-only t))
     (with-current-buffer buf
       (erase-buffer)
       (insert
@@ -88,11 +89,13 @@ marking if it still had that."
       ;; initialize view-mode
       (mm/view-mode)
       (setq ;; these are buffer-local
-	mode-name (format "%s %d" mm/view-buffer-name (plist-get msg :docid))
+	mode-name (if (plist-get msg :subject)
+		    (truncate-string-to-width (plist-get msg :subject) 16 0 nil t)
+		    "No subject")
 	mm/current-msg msg
 	mm/hdrs-buffer hdrsbuf
 	mm/link-map (make-hash-table :size 32 :rehash-size 2 :weakness nil))
-      
+
       (switch-to-buffer buf)
       (goto-char (point-min))
       (mm/view-beautify)
@@ -174,6 +177,15 @@ or if not available, :body-html converted to text)."
     (define-key map "f" 'mm/compose-forward)
     (define-key map "r" 'mm/compose-reply)
     (define-key map "c" 'mm/compose-new)
+    (define-key map "e" 'mm/edit-draft)
+
+    ;; intra-message navigation
+    (define-key map (kbd "SPC") 'scroll-up)
+    (define-key map (kbd "<home>")
+      '(lambda () (interactive) (goto-char (point-min))))
+    (define-key map (kbd "<end>")
+      '(lambda () (interactive) (goto-char (point-max))))
+
 
     ;; navigation between messages
     (define-key map "n" 'mm/view-next-header)
@@ -185,13 +197,20 @@ or if not available, :body-html converted to text)."
 
     ;; marking/unmarking
     (define-key map "d" 'mm/view-mark-for-trash)
+    (define-key map (kbd "<backspace>") 'mm/mark-for-trash)
+
     (define-key map "D" 'mm/view-mark-for-delete)
+    (define-key map (kbd "<delete>") 'mm/view-mark-for-delete)
+
     (define-key map "m" 'mm/view-mark-for-move)
 
     ;; 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)
 
-    ;; next 3 only warn user
+
+    ;; 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)
     (define-key map "x" 'mm/view-marked-execute)
@@ -200,6 +219,15 @@ or if not available, :body-html converted to text)."
 (fset 'mm/view-mode-map mm/view-mode-map)
 
 
+(defvar mm/wrap-lines nil
+  "*internal* Whether to wrap lines or not (variable controlled by
+  `mm/view-toggle-wrap-lines').")
+
+(defvar mm/hide-cited nil
+  "*internal* Whether to hide cited lines or not (the variable can
+  be changed with `mm/view-toggle-hide-cited').")
+
+
 (defun mm/view-mode ()
   "Major mode for viewing an e-mail message."
   (interactive)
@@ -209,12 +237,13 @@ or if not available, :body-html converted to text)."
   (make-local-variable 'mm/hdrs-buffer)
   (make-local-variable 'mm/current-msg)
   (make-local-variable 'mm/link-map)
+
   (make-local-variable 'mm/wrap-lines)
+  (make-local-variable 'mm/hide-cited)
 
   (setq major-mode 'mm/view-mode mode-name mm/view-buffer-name)
   (setq truncate-lines t buffer-read-only t))
 
-
 ;;;;;;
 
 
@@ -229,7 +258,6 @@ 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))
-	;; if so, mark it as non-new and read
 	(mm/proc-flag-msg docid "+S-u-N")))))
 
 
@@ -263,11 +291,7 @@ removing '^M' etc."
 	(replace-match (concat subst
 			 (propertize (format "[%d]" num)
 			   'face 'mm/view-url-number-face))))))))
-    
 
-(defvar mm/wrap-lines nil
-  "*internal* Whether to wrap lines or not (variable controlled by
-  `mm/view-toggle-wrap-lines').")
 
 
 ;; Interactive functions
@@ -275,17 +299,36 @@ removing '^M' etc."
 (defun mm/view-toggle-wrap-lines ()
   "Toggle line wrap in the message body."
   (interactive)
-  (save-excursion
+  (if mm/wrap-lines
-    (if mm/wrap-lines
+    (progn
-      (progn
+      (setq mm/wrap-lines nil)
-	(setq mm/wrap-lines nil)
+      (mm/view-refresh)) ;; back to normal
-	(mm/view mm/current-msg mm/hdrs-buffer t)) ;; back to normal
+    (save-excursion
       (let ((inhibit-read-only t))
 	(setq mm/wrap-lines t)
 	(goto-char (point-min))
 	(when (search-forward "\n\n") ;; search for the message body
 	  (fill-region (point) (point-max)))))))
 
+(defun mm/view-toggle-hide-cited ()
+  "Toggle hiding of cited lines in the message body."
+  (interactive)
+  (if mm/hide-cited
+    (progn
+      (setq mm/hide-cited nil)
+      (mm/view-refresh))
+    (save-excursion
+      (let ((inhibit-read-only t))
+	(goto-char (point-min))
+	(flush-lines "^[:blank:]*>")
+	(setq mm/hide-cited t)))))
+
+
+(defun mm/view-refresh ()
+  "Redisplay the current message."
+  (interactive)
+  (mm/view mm/current-msg mm/hdrs-buffer t))
+
 
 (defun mm/view-quit-buffer ()
   "Quit the message view and return to the headers."

toys/mm/mm.el

@@ -34,6 +34,11 @@
 (require 'mm-common)
 (require 'mm-proc)
 
+
+;; TODO: get this version through to Makefile magic
+(defconst mm/version "0.9.8pre"
+  "*internal* my version")
+
 ;; Customization
 
 (defgroup mm nil
@@ -73,6 +78,8 @@ PATH, you can specifiy the full path."
   :group 'mm
   :safe 'stringp)
 
+
+
 (defvar mm/debug nil
   "When set to non-nil, log debug information to the *mm-log* buffer.")
 
@@ -112,12 +119,12 @@ PATH, you can specifiy the full path."
   :group 'mm/folders)
 
 
-
 ;; the headers view
 (defgroup mm/headers nil
   "Settings for the headers view."
   :group 'mm)
 
+
 (defcustom mm/header-fields
     '( (:date          .  25)
        (:flags         .   6)
@@ -128,6 +135,10 @@ PATH, you can specifiy the full path."
   '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"
+  )
+
 ;; the message view
 (defgroup mm/view nil
   "Settings for the message view."
@@ -250,6 +261,7 @@ be sure it no longer matches)."
     (define-key map "T" 'mm/search-today)
     (define-key map "W" 'mm/search-last-7-days)
     (define-key map "U" 'mm/search-unread)
+    (define-key map "D" 'mm/search-drafts)
 
     (define-key map "s" 'mm/search)
     (define-key map "q" 'mm/quit-mm)
@@ -278,21 +290,24 @@ be sure it no longer matches)."
     buffer-read-only t
     overwrite-mode 'overwrite-mode-binary))
 
+
 (defun mm()
-  "Start mm."
+  "Start mm; should not be called directly, instead, use `mm'"
   (interactive)
   (let ((buf (get-buffer-create mm/mm-buffer-name))
 	 (inhibit-read-only t))
-     (with-current-buffer buf
+    (with-current-buffer buf
        (erase-buffer)
        (insert
 	"* "
-	 (propertize "mm - mail for emacs\n" 'face 'mm/title-face)
+	 (propertize "mm - mail for emacs version " 'face 'mm/title-face)
-	 "\n"
+	 (propertize  mm/version 'face 'mm/view-header-value-face)
+	 "\n\n"
 	 "  Watcha wanna do?\n\n"
 	 "    * Show me some messages:\n"
 	 "      - In your " (propertize "I" 'face 'highlight) "nbox\n"
 	 "      - " (propertize "U" 'face 'highlight) "nread messages\n"
+	 "      - " (propertize "D" 'face 'highlight) "raft messages\n"
 	 "      - Received " (propertize "T" 'face 'highlight) "oday\n"
 	 "      - Received this " (propertize "W" 'face 'highlight) "eek\n"
 	 "\n"
@@ -309,6 +324,18 @@ be sure it no longer matches)."
       (switch-to-buffer buf))))
 
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; window management
+
+
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; interactive functions
 
@@ -317,6 +344,11 @@ be sure it no longer matches)."
   (interactive)
   (mm/hdrs-search (concat "maildir:" mm/inbox-folder)))
 
+(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")))
+
 (defun mm/search-unread ()
   "List all your unread messages."
   (interactive)
@@ -340,7 +372,6 @@ be sure it no longer matches)."
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 
-
 (defun mm/quit-mm()
   "Quit the mm session."
   (interactive)