* mua updates

toys/mua/TODO

@@ -2,23 +2,27 @@
   
   [ ] message un-new in find/view
   [ ] set 'Replied' flag on source when message is replied
-  [ ] update database after changes (CHECK)
   [ ] save message to draft, sent items
   [ ] attachment handling (open, play) in view
 
-  [ ] abstract away mu/binary, shell-command-to-string
+  [ ] fix flags in src/
-  [ ] make flag handling a bit more lispy
+  [ ] version check
+
+  [ ] make add, remove async (use async buffer)
 
   [ ] threads support
   [ ] expandable recipients list in view
   [ ] additive font props in mu find
   [ ] fix headers/view interaction
   
+ 
   [ ] region commands
   [ ] menu
   [ ] mua-dashboard
 
   
+ 
+
 # Local Variables:
 # mode: org; org-startup-folded: nil
 # End:

toys/mua/mua-common.el

@@ -59,7 +59,7 @@ old one first"
   (get-buffer-create bufname))
 
 (defun mua/message (frm &rest args)
-  "print a mua message at point"
+  "print a message at point"
   (let ((str (apply 'format frm args)) (inhibit-read-only t))
     (insert (propertize str 'face 'italic))))
 
@@ -94,10 +94,12 @@ parameter is added automatically if `mua/mu-home' is non-nil."
   (let* ((rv)
 	  (args (append args (when mua/mu-home
 			       (list (concat "--muhome=" mua/mu-home)))))
+	  (cmdstr (concat mua/mu-binary " " (mapconcat 'identity args " ")))
 	  (str (with-output-to-string
 		 (with-current-buffer standard-output ;; but we also get stderr...
 		   (setq rv (apply 'call-process mua/mu-binary nil t nil		  
 			      args))))))
+    (mua/log cmdstr)
     `(,(if (numberp rv) rv 1) . ,str)))
     	  
 (defun mua/mu-binary-version ()
@@ -127,19 +129,18 @@ Function returns the target filename if the move succeeds, or
 \[1\]  http://cr.yp.to/proto/maildir.html." 
   (let ((flagstr
 	  (and flags (mua/maildir-flags-to-string flags))))
-    (if (not (file-readable-p path))
+    (if (not (file-readable-p src))
-      (mua/warn "Path is note a readable file")
+      (mua/warn "Source is not a readable file")
-      (let ((rv (if flagstr
+      (let* ((rv (if flagstr
-		  (mua/run "mv" "--printtarget" path target)
+		  (mua/mu-run "mv" "--printtarget"
-		  (mua/run "mv" "--printtarget"
+		    (concat "--flags=" flagstr) src target)
-		    (concat "--flags=" flagstr) path target))))
+		  (mua/mu-run "mv" "--printtarget" src target)))
-	(if (/= 0 (car rv))
+	      (code (car rv)) (output (cdr rv)))
-	  (mua/warn "Moving message file failed: %s"
+	(if (/= 0 code)
-	    (if (car rv) (car rv) "error"))
+	  (mua/warn "Moving message file failed: %s" (if output output "error"))
-	  (car rv))))))
+	  output))))) ;; the full target path
 	  
-
+(defun mua/maildir-flags-from-path (path)
-(defun mua/mu-get-flags (path)
   "Get the flags for the message at PATH, which does not have to exist.
 The flags are returned as a list consisting of one or more of
 DFNPRST, mean resp. Deleted, Flagged, New, Passed Replied, Seen
@@ -150,29 +151,28 @@ and `mua/maildir-flags-to-string'.
     (mua/maildir-string-to-flags (match-string 1 path))))
 
 
-
 ;; TODO: make this async, but somehow serialize database access
 (defun mua/mu-add (path)
   "Add message file at PATH to the mu database (using the 'mu
 add') command. Return t if it succeed or nil in case of error."
   (if (not (file-readable-p path))
-    (mua/warn "Path is note a readable file")
+    (mua/warn "Path is not a readable file: %s" path)
-    (let ((rv (mua/mu-run "add" path)))
+    (let* ((rv (mua/mu-run "add" path))
-      (if (=/ (car rv) 0)
+	    (code (car rv)) (output (cdr rv)))
-	(mua/warn "mu add failed (%d): %s"
+      (if (/= code 0)
-	  code (if (cdr rv) (cdr rv) "error"))
+	(mua/warn "mu add failed (%d): %s" code (if output output "error")
-	t))))
+	t)))))
 
 ;; TODO: make this async, but somehow serialize database access
 (defun mua/mu-remove (path)
   "Remove message with PATH from the mu database (using the 'mu
 remove') command. PATH does not have to exist. Return t if it
 succeed or nil in case of error."
-  (let ((rv (mua/mu-run "remove" path)))
+  (let* ((rv (mua/mu-run "remove" path))
-    (when (=/ (car rv) 0)
+	  (code (car rv)) (output (cdr rv)))
-      (mua/warn "mu remove failed (%d): %s"
+    (if (/= code 0)
-	code (if (cdr rv) (cdr rv) "error"))
+      (mua/warn "mu remove failed (%d): %s" code (if output output "error")
-      t)))
+	t))))
 
 (defun mua/mu-view-sexp (path)
   "Return a string with an s-expression representing the message
@@ -187,6 +187,26 @@ that function converts the string into a Lisp object (plist)"
 	(mua/warn "mu view failed (%d): %s"
 	  code (if str str "error"))))))
 
+(defun mua/maildir-from-path (path &optional dont-strip-prefix)
+  "Get the maildir from path; in this context, 'maildir' is the
+part between the `mua/maildir' and the /cur or /new; so
+e.g. \"/home/user/Maildir/foo/bar/cur/12345:2,S\" would have
+\"/foo/bar\" as its maildir. If DONT-STRIP-PREFIX is non-nil,
+function will instead _not_ remove the `mua/maildir' from the
+front - so in that case, the example would return
+\"/home/user/Maildir/foo/bar/\". If the maildir cannot be
+determined, return `nil'."
+  (when (and (string-match "^\\(.*\\)/\\(cur\\|new\\)/\[^/\]*$" path))
+    (let ((mdir (match-string 1 path)))	 
+      (when (and (< (length mua/maildir) (length mdir))
+	      (string= (substring mdir 0 (length mua/maildir)) mua/maildir))
+	(if dont-strip-prefix
+	  mdir
+	  (substring mdir (length mua/maildir)))))))
+
+;; TODO: ensure flag string have the chars in ASCII-order (as per maildir spec)
+;; TODO: filter-out duplicate flags
+
 (defun mua/maildir-flags-to-string (flags)
   "Convert a list of flags into a string as seen in Maildir
 message files; flags are symbols draft, flagged, new, passed,
@@ -202,7 +222,6 @@ Also see `mua/maildir-string-to-flags'.
 	    (case (car flags) 
 	      ('draft    ?D) 
 	      ('flagged  ?F)
-	      ('new      ?N)
 	      ('passed   ?P)
 	      ('replied  ?R)
 	      ('seen     ?S)
@@ -224,7 +243,6 @@ Also see `mua/maildir-flags-to-string'.
 	    (case (string-to-char str)
 	      (?D   'draft)
 	      (?F   'flagged)
-	      (?N   'new)
 	      (?P   'passed)
 	      (?R   'replied)
 	      (?S   'seen)

toys/mua/mua-hdrs.el

@@ -307,18 +307,14 @@ fitting in WIDTH"
   (interactive) ;; TODO: check if next line has path, if not, don't go there
   (if (or (/= 0 (forward-line 1)) (not (mua/hdrs-get-path)))
     (mua/warn "No message after this one")
-    (progn
+    t))
-      (mua/log "At: %d [%S]" (point) (mua/hdrs-get-path)) t)))
-
 
 (defun mua/hdrs-prev  ()
   "go to the previous line; t if it worked, nil otherwise"
   (interactive)
   (if (or (/= 0 (forward-line -1)) (not (mua/hdrs-get-path)))
     (mua/warn "No message before this one")
-    (progn
+    t))
-      (mua/log "At: %d [%S]" (point) (mua/hdrs-get-path)) t)))
-
 
 (defun mua/hdrs-view ()
   (interactive)

toys/mua/mua-msg.el

@@ -38,9 +38,10 @@
 (require 'mua-common)
 
 (defun mua/msg-from-string (str)
-  "Get the plist describing an email message, from a string
+  "Get the plist describing an email message, from STR containing
-contain a message sexp; a message sexp looks something like: The
+a message sexp.
-message sexp looks something like:
+
+ a message sexp looks something like:
  \(
   :from ((\"Donald Duck\" . \"donald@example.com\"))
   :to ((\"Mickey Mouse\" . \"mickey@example.com\"))
@@ -50,6 +51,7 @@ message sexp looks something like:
   :references (\"200208121222.g7CCMdb80690@msg.id\")
   :in-reply-to \"200208121222.g7CCMdb80690@msg.id\"
   :message-id \"foobar32423847ef23@pluto.net\"
+  :maildir: \"/archive\"
   :path \"/home/mickey/Maildir/inbox/cur/1312254065_3.32282.pluto,4cd5bd4e9:2,\"
   :priority high
   :flags (new unread)
@@ -88,7 +90,11 @@ as described in `mua/msg-from-string'
 There is also the special field :body (which is either :body-txt,
 or if not available, :body-html converted to text)."
   (case field
-    (:body (mua/msg-body-txt-or-html msg))
+    (:body
+      (mua/msg-body-txt-or-html msg))
+    (:maildir ;; messages gotten from mu-view don't have their maildir set...
+      (or (plist-get msg :maildir)
+	(mua/maildir-from-path (mua/msg-field msg :path))))
     (t (plist-get msg field))))
 
 
@@ -113,13 +119,13 @@ Function returns the target filename if the move succeeds, or
 `nil'.
 
 \[1\]  http://cr.yp.to/proto/maildir.html."
-  (let ((fulltarget (mua/mu-mv str target flags)))
+  (let ((fulltarget (mua/mu-mv src targetdir flags)))
-    (when fulltarget
+    (if fulltarget
       (mua/mu-remove src)
       (unless (string= targetdir "/dev/null")
-	mua/mu-add fulltarget))
+	(mua/mu-add fulltarget))
-    
+      fulltarget)
-    fulltarget))
+    (mua/warn "Moving message failed")))
 
 
 ;; functions for composing new messages (forward, reply and new)
@@ -416,33 +422,37 @@ messages (mua is not the only user of `message-mode' after all)"
 ;; we simply check if file starts with `mu-msg-file-prefix'    
 
 (defun mua/msg-save-to-sent ()
-  "function that moves the current message to the sent folder"
+  "Move the message in this buffer to the sent folder. This is
-  (if (mua/msg-is-mua-message)
+meant to be called from message mode's `message-sent-hook'."
+  (if (mua/msg-is-mua-message) ;; only if we are mua
     (unless mua/sent-folder (error "mua/sent-folder not set"))
-    
+    (let* ;; TODO: remove duplicate flags
-    (let ((sent-msg ;; note, the "" parameter remove the D 'Draft'-flag
+      ((newflags ;; remove Draft; maybe set 'Seen' as well?
- 	    (mua/msg-move (buffer-file-name) mua/sent-folder "")))
+	 (delq 'draft (mua/maildir-flags-from-path (buffer-file-name))))
-      (if (sent-msg) ;; change our buffer file-name
+	(sent-msg
+	  (mua/msg-move (buffer-file-name) mua/sent-folder newflagstr)))
+      (if sent-msg ;; change our buffer file-name
 	(set-visited-file-name sent-msg t t)
 	(mua/warn "Failed to save message to the Sent-folder")))))
 
-;; (defun mua/msg-set-replied-flag ()
-;;   "find the message we replied to, and set its 'Replied' flag."
-;;   (if (mua/msg-is-mua-message)
 
-;;     (let ((msgid (mail-header-parse-addresses
+(defun mua/msg-set-replied-flag ()
-;; 		   (message-field-value "In-Reply-To")))
+  "Find the message we replied to, and set its 'Replied'
-;; 	   (path (and msgid (shell-command-to-string
+flag. This is meant to be called from message mode's
-;; 			      (concat mua/mu-binary
+`message-sent-hook'."
-;; 				" find msgid:" msgid " --exec=echo | head -1")))))
+  (if (mua/msg-is-mua-message) ;; only if we are mua
-;;       (if path
+    (let ((msgid (mail-header-parse-addresses
-;;         (mu-mv)
+		   (message-field-value "In-Reply-To")))
+	   (path (and msgid (mua/mu-run
+			      "find"  (concat "msgid:" msgid) "--exec=echo"))))
+      (if path
+	(let ((newflags (cons 'replied (mua/maildir-flags-from-path path))))
+	  (mua/msg-move path (mua/maildir-from-path path t) newflags))))))
       
 	    
-	    
+;; hook our functions up with sending of the message
-    
+(add-hook 'message-sent-hook 'mua/msg-save-to-sent)
-;; add-hook
+(add-hook 'message-sent-hook 'mua/msg-set-replied-flag)
-;; add-hook
 
 
 (provide 'mua-msg)

toys/mua/mua-view.el

@@ -38,7 +38,7 @@
   "buffer name for mua/view buffers")
 
 (defvar mua/view-headers
-  '(:from :to :cc :subject :flags :date :attachments)
+  '(:from :to :cc :subject :flags :date :maildir :attachments)
  "fields to display in the message view")
 
 (defvar mua/hdrs-buffer nil
@@ -66,7 +66,19 @@ buffer."
       (setq ;; these are buffer-local
 	mua/hdrs-buffer headersbuf
 	mua/parent-buffer headersbuf)
-      (goto-char (point-min)))))
+      (goto-char (point-min))
+      (mua/view-mark-as-read path))))
+
+(defun mua/view-mark-as-read (path)
+  "Mark the currently viewed as read if it is not so already. In
+  Maildir terms, this means moving the message from \"new/\" to
+  \"cur/\" (if it's not yet there), and setting the \"S\" flag."
+  (let ((flags (mua/maildir-flags-from-path path)))
+    (unless (member 'seen flags) ;; do we need to do something?
+      (let ((newflags (delq 'new (cons 'seen flags)))
+	     (newpath (mua/maildir-from-path path t)))
+	(unless (mua/msg-move path newpath newflags)
+	  (mua/warn "Failed to mark message as read"))))))
 
 (defun mua/view-message (msg)
   "construct a display string for the message"
@@ -82,6 +94,7 @@ buffer."
 	       (:bcc		(mua/view-contacts msg field))
 	       (:date		(mua/view-date  msg))
 	       (:flags		(mua/view-flags msg))
+	       (:maildir	(mua/view-header msg "Maildir" :maildir))
 	       (:size		(mua/view-size  msg))
 	       (:attachments    (mua/view-attachments msg))
 	       (t               (error "Unsupported field: %S" field))))