* mm updates (WIP)

toys/mm/mm-hdrs.el

@@ -97,23 +97,30 @@ headers."
   (when (buffer-live-p mm/hdrs-buffer)
     (with-current-buffer mm/hdrs-buffer
       (let* ((docid (plist-get msg :docid))
-	      (marker (gethash docid mm/msg-map)))
+	      (marker (gethash docid mm/msg-map))
+	      (point (when marker (marker-position marker))))
 	(unless docid (error "Invalid update %S" update))
-	(when marker ;; is the message present in this list?
+	(when point ;; is the message present in this list?
 	  (save-excursion
-	    (goto-char (marker-position marker))
+	    (goto-char point)
 	    ;; sanity check
-	    (unless (eq docid (mm/hdrs-get-docid)) (error "Unexpected docid"))
+	    (unless (eq docid (mm/hdrs-get-docid))
+	      (error "Unexpected docid: %S <=> %S" docid (mm/hdrs-get-docid)))
+
 	    ;; if it's marked, unmark it now
 	    (when (mm/hdrs-docid-is-marked docid)
 	      (mm/hdrs-mark 'unmark))
-	    (mm/hdrs-remove-header docid)
+
+	    ;; 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.
-	    (unless is-move
+	    (when (not is-move)
-	      (mm/hdrs-header-handler msg (beginning-of-line)))))))))
+	      (mm/hdrs-header-handler msg point))))))))
 
 (defun mm/hdrs-remove-handler (docid)
   "Remove handler, will be called when a message has been removed
@@ -122,7 +129,7 @@ the current list of headers."
   (with-current-buffer mm/hdrs-buffer
     (let ((marker (gethash docid mm/msg-map)))
       (unless marker (error "Message %d not found" docid))
-      (mm/hdrs-remove-header docid))))
+      (mm/hdrs-remove-header docid (marker-position marker)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -181,6 +188,8 @@ point. Line does not include a newline or any text-properties."
     (define-key map "p" 'mm/prev-header)
     (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)
@@ -189,6 +198,10 @@ point. Line does not include a newline or any text-properties."
     (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)
@@ -256,39 +269,39 @@ provided, put it at the end of the buffer."
 	  (goto-char point)
 	  ;; Update `mm/msg-map' with MSG, and MARKER pointing to the buffer
 	  ;; position for the message header."
-	  (puthash docid (point-marker) mm/msg-map)
+	  (puthash docid (copy-marker point) mm/msg-map)
-	  (insert "  " (propertize str 'docid docid) "\n"))))))
+	  (insert (propertize (concat "  " str "\n")  'docid docid)))))))
 
-(defun mm/hdrs-remove-header (docid)
+(defun mm/hdrs-remove-header (docid point)
-  "Add header STR with DOCID to the buffer. If POINT is not
+  "Remove header with DOCID at POINT."
-provided, put it at the end of the buffer."
+  (with-current-buffer mm/hdrs-buffer
-  (unless docid (error "No docid found"))
+    (save-excursion
-  (let ((marker (gethash docid mm/msg-map)))
+      (goto-char point)
-    (unless marker (error "Unregistered message"))
+      ;; sanity check
-    (remhash docid mm/msg-map)
+      (unless (eq docid (mm/hdrs-get-docid)) (error "Unexpected docid"))
-    (with-current-buffer mm/hdrs-buffer
+      (let ((inhibit-read-only t))
-      (save-excursion
+	(delete-region (line-beginning-position) (line-beginning-position 2)))
-	(goto-char (marker-position marker))
+       (remhash docid mm/msg-map))))
-	(let ((inhibit-read-only t))
-	  (delete-region (line-beginning-position) (line-beginning-position 2)))))))
 
 (defun mm/hdrs-mark-header (docid mark)
   "(Visually) mark the header for DOCID with character MARK."
   (let ((marker (gethash docid mm/msg-map)))
-    (unless marker (error "Unregistered message"))
+    ;; (unless marker (error "Unregistered message"))
-    (with-current-buffer mm/hdrs-buffer
+    (when marker
-      (save-excursion
+      (with-current-buffer mm/hdrs-buffer
-	(let ((inhibit-read-only t))
+	(save-excursion
-	  (goto-char (marker-position marker))
+	  (let ((inhibit-read-only t) (pos (marker-position marker)))
-	  (move-beginning-of-line 1)
+	    (goto-char pos)
-	  (delete-char 2)
+	    (delete-char 2)
-	  (insert mark " "))))))
+	    (insert mark " ")
+	    (put-text-property pos
+	      (line-beginning-position 2) 'docid docid)))))))
+  
 	  
 (defun mm/hdrs-get-docid ()
   "Get the docid for the message at point, or nil if there is none"
   (with-current-buffer mm/hdrs-buffer
-    (when (> (- (line-end-position) (line-beginning-position)) 2)
+      (get-text-property (point) 'docid)))
-      (get-text-property (+ 2 (line-beginning-position)) 'docid))))
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 
@@ -323,14 +336,16 @@ The following marks are available, and the corresponding props:
 	      ('move    "m")
 	      ('trash   "d")
 	      ('delete  "D")
+	      ('select  "*")
 	      ('unmark  " ")
 	      (t (error "Invalid mark %S" mark)))))
     (unless docid (error "No message on this line"))
     (save-excursion
       (when (mm/hdrs-mark-header docid markkar))
-      ;; update the hash
+      ;; update the hash -- remove everything current, and if add the new stuff,
-      (if (eql mark 'unmark)
+      ;; unless we're unmarking
-	(remhash docid mm/marks-map)
+      (remhash docid mm/marks-map)
+      (unless (eql mark 'unmark)
 	(puthash docid (list (point-marker) mark target) mm/marks-map)))))
 
 
@@ -445,9 +460,10 @@ do a new search."
 the new docid. Otherwise, return nil."
   (interactive)
   (with-current-buffer mm/hdrs-buffer
-    (if (= 0 (forward-line 1))
+    (let ((old (line-number-at-pos)))      
-      (let ((docid (mm/hdrs-get-docid)))
+      (if (= 0 (forward-line 1))
-	(if docid docid (mm/next-header)))))) ;; skip non-headers
+	(let ((docid (mm/hdrs-get-docid)))
+	  (if docid docid (mm/next-header)))))))
 
 (defun mm/prev-header ()
   "Move point to the previous message header. If this succeeds,
@@ -466,6 +482,27 @@ return the new docid. Otherwise, return nil."
     (mm/hdrs-search (concat "maildir:" fld))))
 
 
+;; (defun mm/select ()
+;;   "Select the current messsage."
+;;   (interactive)
+;;   (with-current-buffer mm/hdrs-buffer
+;;     (mm/hdrs-mark 'select)
+;;     (mm/next-header)))
+
+;; (defun mm/mark-selected (marktype)
+;;   "If any headers have been selected, set the mark for all of them;
+;; otherwise, return nil."
+;;   (let ((selected) (target))
+;;     (maphash
+;;       (lambda (docid val)
+;; 	(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)

toys/mm/mm-proc.el

@@ -110,6 +110,8 @@ process."
   (unless (file-executable-p mm/mu-binary)
     (error (format "%S is not executable" mm/mu-binary)))
   (let* ((process-connection-type nil) ;; use a pipe
+	  (coding-system-for-read 'utf-8)
+	  (coding-system-for-write 'no-conversion)
 	  (args '("server"))
 	  (args (append args (when mm/mu-home
 			       (list (concat "--muhome=" mm/mu-home))))))
@@ -214,17 +216,27 @@ updated as well, with all processed sexp data removed."
 	  (funcall mm/proc-header-func sexp))
 	((plist-get sexp :view)
 	  (funcall mm/proc-view-func (plist-get sexp :view)))
+
+	;; something got moved/flags changed
 	((plist-get sexp :update)
 	  (funcall mm/proc-update-func
 	    (plist-get sexp :update) (plist-get sexp :move)))
+
+	;; a message got removed
 	((plist-get sexp :remove)
 	  (funcall mm/proc-remove-func (plist-get sexp :remove)))
+
+	;; start composing a new message
 	((plist-get sexp :compose)
 	  (funcall mm/proc-compose-func
 	    (plist-get sexp :compose)
 	    (plist-get sexp :action)))
+
+	;; get some info
 	((plist-get sexp :info)
 	  (funcall mm/proc-info-func sexp))
+
+	;; receive an error
 	((plist-get sexp :error)
 	  (funcall mm/proc-error-func sexp))
 	(t (message "Unexpected data from server [%S]" sexp)))
@@ -362,4 +374,34 @@ The result will be delivered to the function registered as
     (mm/proc-send-command "compose %s %d" action docid)))
 
 
+
+(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
+    (let ((buf (get-buffer-create "*mm-retrieve*"))
+	   (cmd mm/get-mail-command))
+      (message "Retrieving mail...")
+      (let ((proc (start-process "*mm-retrieve*" buf "sh" "-c" cmd)))
+	(set-process-sentinel proc 'mm/proc-retrieve-mail-sentinel)))))
+
+
+(defun mm/proc-retrieve-mail-sentinel (proc msg)
+  "Function that will be called when the mail retrieval process
+terminates."
+  (let ((status (process-status proc)) (code (process-exit-status proc)))
+    (cond
+      ((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

@@ -252,7 +252,7 @@ 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-for-reply msg))
+      (mm/msg-hidden-header "References"  (mm/msg-references-create msg))
        (mm/msg-header"Subject"
 	 (concat mm/msg-forward-prefix (plist-get msg :subject)))
 
@@ -292,12 +292,11 @@ with non-mm-generated messages")
   "Create a Maildir-compatible[1], unique file name for a draft
 message.
  [1]: see http://cr.yp.to/proto/maildir.html"
-  (format "%s-%s-%x.%s:2,D" ;; 'D': rarely used, but hey, it's available
+  (format "%s-%x%x:2,D" ;; 'D': rarely used, but hey, it's available
-    mm/msg-prefix
     (format-time-string "%Y%m%d" (current-time))
     (emacs-pid)
-    (random t)
+    (random t)))
-    (replace-regexp-in-string "[:/]" "_" (system-name))))
+;;;    (replace-regexp-in-string "[:/]" "_" (system-name))))
 
 
 (defvar mm/send-reply-docid nil   "Docid of the message this is a reply to.")
@@ -345,6 +344,10 @@ using Gnus' `message-mode'."
     (make-local-variable 'mm/send-forward-docid)
     (make-local-variable 'mm/mm-msg)
     
+    ;; 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)
@@ -403,9 +406,8 @@ 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
@@ -422,11 +424,6 @@ This is meant to be called from message mode's
   (when mm/send-forward-docid (mm/proc-flag-msg mm/send-forward-docid "+P")))
 
 
-;; hook our functions up with sending of the message
-(add-hook 'message-sent-hook 'mm/msg-save-to-sent)
-(add-hook 'message-sent-hook 'mm/send-set-parent-flag)
-
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; some interactive function
 

toys/mm/mm-view.el

@@ -34,6 +34,7 @@
 (eval-when-compile (require 'cl))
 (require 'mm-common)
 (require 'html2text)
+(require 'filladapt)
 
 (defconst mm/view-buffer-name "*mm-view*"
   "*internal* Name for the message view buffer")
@@ -45,10 +46,11 @@
 (defvar mm/current-msg nil
   "*internal* The plist describing the current message.")
 
-(defun mm/view (msg hdrsbuf)
+(defun mm/view (msg hdrsbuf &optional update)
   "Display the message MSG in a new buffer, and keep in sync with HDRSBUF.
 'In sync' here means that moving to the next/previous message in
-the the message view affects HDRSBUF, as does marking etc.
+the the message view affects HDRSBUF, as does marking etc. If
+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."
@@ -86,7 +88,7 @@ marking if it still had that."
       ;; initialize view-mode
       (mm/view-mode)
       (setq ;; these are buffer-local
-	mode-name (format "%s" mm/view-buffer-name (plist-get msg :docid))
+	mode-name (format "%s %d" mm/view-buffer-name (plist-get msg :docid))
 	mm/current-msg msg
 	mm/hdrs-buffer hdrsbuf
 	mm/link-map (make-hash-table :size 32 :rehash-size 2 :weakness nil))
@@ -94,7 +96,9 @@ marking if it still had that."
       (switch-to-buffer buf)
       (goto-char (point-min))
       (mm/view-beautify)
-      (mm/view-mark-as-read-maybe))))
+
+      (unless update
+	(mm/view-mark-as-read-maybe)))))
 
 
 (defun mm/view-body (msg)
@@ -184,6 +188,9 @@ or if not available, :body-html converted to text)."
     (define-key map "D" 'mm/view-mark-for-delete)
     (define-key map "m" 'mm/view-mark-for-move)
 
+    ;; misc
+    (define-key map "w" 'mm/view-toggle-wrap-lines)
+
     ;; next 3 only warn user
     (define-key map "u" 'mm/view-unmark)
     (define-key map "U" 'mm/view-unmark)
@@ -202,6 +209,7 @@ 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)
 
   (setq major-mode 'mm/view-mode mode-name mm/view-buffer-name)
   (setq truncate-lines t buffer-read-only t))
@@ -233,20 +241,21 @@ Seen; if the message is not New/Unread, do nothing."
 removing '^M' etc."
   (let ((num 0))
   (save-excursion
-    (goto-char (point-min))
 
     ;; remove the stupid CRs
-    (while (search-forward "
+    (goto-char (point-min))
+    (while (search-forward "
 \\| " nil t)
       (replace-match "" nil t))
 
+    ;; give the footer a different color...
     (goto-char (point-min))
     (let ((p (search-forward "\n-- \n" nil t)))
       (when p
 	(add-text-properties p (point-max) '(face mm/view-footer-face))))
 
     ;; this is fairly simplistic...
-    (goto-char (point-min))
+    (goto-char (point-min))
     (while (re-search-forward "\\(https?://.*\\)\\>" nil t)
       (let ((subst (propertize (match-string-no-properties 0)
 		     'face 'mm/view-link-face)))
@@ -256,8 +265,28 @@ removing '^M' etc."
 			 (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
+
+(defun mm/view-toggle-wrap-lines ()
+  "Toggle line wrap in the message body."
+  (interactive)
+  (save-excursion
+    (if mm/wrap-lines
+      (progn
+	(setq mm/wrap-lines nil)
+	(mm/view mm/current-msg mm/hdrs-buffer t)) ;; back to normal
+      (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-quit-buffer ()
   "Quit the message view and return to the headers."
@@ -265,7 +294,6 @@ removing '^M' etc."
   (let ((inhibit-read-only t))
     (kill-buffer)
     (switch-to-buffer mm/hdrs-buffer)))
-
 
 (defun mm/view-next-header ()
   "View the next header."

toys/mm/mm.el

@@ -257,7 +257,7 @@ be sure it no longer matches)."
     (define-key map "c" 'mm/compose-new)
 
     (define-key map "r" 'mm/retrieve-mail)
-    (define-key map "u" 'mm/update-database)
+    (define-key map "u" 'mm/retrieve-mail-update-db)
 
     map)
   "Keymap for the *mm* buffer.")
@@ -301,8 +301,7 @@ be sure it no longer matches)."
 	 "\n"
 	 "    * " (propertize "c" 'face 'highlight) "ompose a new message\n"
 	 "\n"
-	 "    * " (propertize "r" 'face 'highlight) "etrieve new mail\n"
+	 "    * " (propertize "u" 'face 'highlight) "pdate email\n"
-	 "    * " (propertize "u" 'face 'highlight) "pdate the message database\n"
 	 "\n"
 	 "    * " (propertize "q" 'face 'highlight) "uit mm\n")
 
@@ -333,21 +332,10 @@ be sure it no longer matches)."
   (interactive)
   (mm/hdrs-search "date:7d..now"))
 
-(defun mm/retrieve-mail ()
+(defun mm/retrieve-mail-update-db ()
-  "Get new mail."
+  "Get new mail and update the database."
   (interactive)
-  (unless mm/get-mail-command
+  (mm/proc-retrieve-mail-update-db))
-    (error "`mm/get-mail-command' is not set"))
-  (when (y-or-n-p "Sure you want to retrieve new mail?")
-    (shell-command mm/get-mail-command)))
-
-(defun mm/update-database ()
-  "Update the database (ie., 'mu index')."
-  (interactive)
-  (unless mm/maildir (error "`mm/maildir' not set"))
-  (when (y-or-n-p "Sure you want to update the database?")
-    (mm/proc-index mm/maildir)))
-
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;