From 3692fc1b39ac59e7ae6e35f161dafbd9942ae137 Mon Sep 17 00:00:00 2001
From: "Dirk-Jan C. Binnema" <djcb@djcbsoftware.nl>
Date: Mon, 29 Aug 2011 23:39:25 +0300
Subject: [PATCH] * mua updates

---
 toys/mua/mua-hdrs.el     | 216 ++++++++++++++++++---------------------
 toys/mua/mua-msg-file.el |  24 +++--
 toys/mua/mua-mu.el       |  63 ------------
 toys/mua/mua-view.el     |  61 +++++------
 4 files changed, 146 insertions(+), 218 deletions(-)

diff --git a/toys/mua/mua-hdrs.el b/toys/mua/mua-hdrs.el
index ad6b9a8d..d69c35b9 100644
--- a/toys/mua/mua-hdrs.el
+++ b/toys/mua/mua-hdrs.el
@@ -24,6 +24,10 @@
 
 ;;; Commentary:
 
+;; In this file are function related to creating the list of one-line
+;; descriptions of emails, aka 'headers' (not to be confused with headers like
+;; 'To:' or 'Subject:')
+
 ;; mu
 
 ;;; Code:
@@ -34,29 +38,26 @@
 (require 'mua-msg)
 
 ;; note: these next two are *not* buffer-local, so they persist during a session
-(defvar mua/hdrs-sortfield nil "field to sort headers by")
-(defvar mua/hdrs-sort-descending nil "whether to sort in descending order")
+(defvar mua/hdrs-sortfield nil
+  "*internal* Field to sort headers by")
+(defvar mua/hdrs-sort-descending nil
+  "*internal Whether to sort in descending order")
 
-(defvar mua/header-fields
+(defvar mua/hdrs-fields
   '( (:date          .  25)
      (:from-or-to    .  22)
      (:subject       .  40))
-  "a list of fields and their widths")
-
+  "A list of header fields and their character widths")
 
 ;; internal stuff
 (defvar mua/buf ""
   "*internal* Buffer for results data.")
 (defvar mua/last-expression nil
   "*internal* The most recent search expression.")
-(defvar mua/hdrs-process nil
+(defvar mua/hdrs-proc nil
   "*internal* The mu-find process.")
-(defvar mua/hdrs-hash nil
-  "*internal* The bol->uid hash.")
 
-
-
-(defconst mua/eom "\n;;eom\n"
+(defconst mua/eom-mark "\n;;eom\n"
   "*internal* Marker for the end of message in the mu find
   output.")
 (defconst mua/hdrs-buffer-name "*mua-headers*"
@@ -66,20 +67,24 @@
   "A process-filter for the 'mu find --format=sexp output; it
   accumulates the strings into valid sexps by checking of the
   ';;eom' end-of-msg marker, and then evaluating them."
-  (let ((procbuf (process-buffer proc)))
-    (when (buffer-live-p procbuf)
-      (with-current-buffer procbuf
-	(save-excursion
-	  (setq mua/buf (concat mua/buf str))
-	  (let ((eom (string-match mua/eom mua/buf)))
-	    (while (numberp eom)
-	      (let* ((msg (mua/msg-from-string(substring mua/buf 0 eom))))
-		(save-match-data (mua/hdrs-append-message msg))
-		(setq mua/buf (substring mua/buf (match-end 0)))
-		(setq eom (string-match mua/eom mua/buf))))))))))
-
+  (setq mua/buf (concat mua/buf str)) ;; update our buffer
+  (let ((buf (process-buffer proc)))  ;; check the buffer
+    (unless (buffer-live-p buf)
+      (error "No live buffer for process filter"))
+    (while ;; for-each-sex
+      ;; Process the sexp in `mua/buf', and remove it if it worked and return
+      ;; t. If no complete sexp is found, return nil."
+      (let ((eom (string-match mua/eom-mark mua/buf))
+	     (after-eom (match-end 0)) (inhibit-read-only t))
+	(when (numberp eom) ;; was the marker found?
+	  (with-current-buffer buf
+	    (mua/hdrs-append-message (mua/msg-from-string
+				       (substring mua/buf 0 eom))))
+	  (setq mua/buf (substring mua/buf after-eom)) t)))))
+          
+  
 (defun mua/hdrs-proc-sentinel (proc msg)
-  "Check the process upon completion."
+  "Sentinel funtion for the mu-find process -- ie., will be called upon its ."
   (let ((procbuf (process-buffer proc))
 	 (status (process-status proc))
 	 (exit-status (process-exit-status proc)))
@@ -90,93 +95,86 @@
 		('exit
 		  (if (= 0 exit-status)
 		    "End of search results"
-		    (mua/mu-error exit-status))))))
-		  
+		    (mua/mu-error exit-status))))))	  
 	      (with-current-buffer procbuf
 		(save-excursion
 		  (goto-char (point-max))
 		  (mua/message "%s" msg)))))))
 
-(defun mua/hdrs-search-execute (expr buf)
-  "search in the mu database; output the results in buffer BUF"
-  (let ((args `("find" "--format=sexp" ,expr)))
-    (when mua/mu-home
-      (add-to-list args (concat "--muhome=" mua/mu-home)))
-    (when mua/hdrs-sortfield
-      (add-to-list args (concat "--sortfield=" mua/hdrs-sortfield)))
-    (when mua/hdrs-sort-descending
-	(add-to-list args "--descending"))
-    (mua/log (concat mua/mu-binary " " (mapconcat 'identity args " ")))
-    ;; now, do it!
-    (let ((proc (apply 'start-process "*mua-headers*" buf mua/mu-binary args)))
-      (setq
-	mua/buf ""
-	mua/hdrs-process proc)
-      (set-process-filter   proc 'mua/hdrs-proc-filter)
-      (set-process-sentinel proc 'mua/hdrs-proc-sentinel))))
+(defun mua/hdrs-search-execute (expr)
+  "Search in the mu database, and output the results in the current
+buffer."
+  (let* ((argl
+	   (remove-if 'not
+	     (list "find" "--format=sexp" "--threads"
+	       (when mua/mu-home (concat "--muhome=" mua/mu-home))
+	       (when mua/hdrs-sortfield
+		 (concat "--sortfield=" mua/hdrs-sortfield))
+	       (when mua/hdrs-sort-descending "--descending")
+	       expr)))
+	  (mua/buf "") 
+	  ;; start the process
+	  (proc (apply 'start-process
+		  mua/hdrs-buffer-name (current-buffer) mua/mu-binary argl)))
+    (setq mua/hdrs-proc proc)
+    (set-process-filter   proc 'mua/hdrs-proc-filter)
+    (set-process-sentinel proc 'mua/hdrs-proc-sentinel)
+    (mua/log (concat mua/mu-binary " " (mapconcat 'identity argl " ")))))
 
 ;; Note, the 'mu find --format=sexp' sexp is almost the same as the ones that
 ;; 'mu view --format=sexp' produces (see mu-get-message), with the difference
 ;; that former may give more than one result, and that mu-headers output comes
 ;; from the database rather than file, and does _not_ contain the message body
 (defun mua/hdrs-search (expr)
-  "search in the mu database"
+  "Search in the mu database for EXPR, and switch to the output
+buffer for the results."
   (interactive "s[mu] search for: ")
-  (setq debug-on-error t)
-
-  ;; kill running process if needed
-  (when (and mua/hdrs-process
-	  (eq (process-status mua/hdrs-process) 'run))
-    (kill-process mua/hdrs-process))
-  
+  ;; kill a running process if needed
+  (when (and mua/hdrs-proc (eq (process-status mua/hdrs-proc) 'run))
+    (kill-process mua/hdrs-proc))
   (let ((buf (mua/new-buffer mua/hdrs-buffer-name)))
     (switch-to-buffer buf)
     (mua/hdrs-mode)
-    (setq
-      mua/last-expression expr
-      mua/hdrs-hash       (make-hash-table :size 256 :rehash-size 2)
-      mua/hdrs-marks-hash (make-hash-table :size 16  :rehash-size 2))
-    (mua/hdrs-search-execute expr buf)))
+    (mua/hdrs-search-execute expr)))
 
 
 (defun mua/hdrs-mode ()
-  "major mode for displaying mua search results"
+  "Major mode for displaying mua search results."
   (interactive)
   (kill-all-local-variables)
   (use-local-map mua/hdrs-mode-map)
   
   (make-local-variable 'mua/buf)
   (make-local-variable 'mua/last-expression)
-  (make-local-variable 'mua/hdrs-process)
+  (make-local-variable 'mua/hdrs-proc)
   (make-local-variable 'mua/hdrs-hash)
   (make-local-variable 'mua/hdrs-marks-hash)
 
   (setq
+    mua/last-expression expr
+    mua/hdrs-marks-hash (make-hash-table :size 16  :rehash-size 2)
     major-mode 'mua/mua/hdrs-mode mode-name "*mua-headers*"
-    truncate-lines t buffer-read-only t
+    truncate-lines t
+    buffer-read-only t
     overwrite-mode 'overwrite-mode-binary))
 
 (defun mua/hdrs-line (msg)
-  "return line describing a message (ie., a header line)"
-  (let
-    ((hdr
-       (mapconcat
-	 (lambda(fieldpair)
-	   (let ((field (car fieldpair)) (width (cdr fieldpair)))
-	     (case field
-	       (:subject (mua/hdrs-header   msg :subject width))
-	       (:to      (mua/hdrs-contact  msg field width))
-	       (:from    (mua/hdrs-contact  msg field width))
-	       ;;(:from-or-to (mua/msg-header-header-from-or-to msg width 'mua/header-face))
-	       (:cc      (mua/hdrs-contact  msg field width))
-	       (:bcc     (mua/hdrs-contact  msg field width))
-	       (:date    (mua/hdrs-date     msg width))
-	       (:flags   (mua/hdrs-flags    msg width))
-	       (:size    (mua/hdrs-size     msg width))
-	       (t        (error "Unsupported field: %S" field))
-	       )))
-	 mua/header-fields " ")))
-    hdr))
+  "Return line describing a message (ie., a header line)."
+  (mapconcat
+    (lambda(fieldpair)
+      (let ((field (car fieldpair)) (width (cdr fieldpair)))
+	(case field
+	  (:subject (mua/hdrs-header   msg :subject width))
+	  (:to      (mua/hdrs-contact  msg field width))
+	  (:from    (mua/hdrs-contact  msg field width))
+	  ;;(:from-or-to (mua/msg-header-header-from-or-to msg width 'mua/header-face))
+	  (:cc      (mua/hdrs-contact  msg field width))
+	  (:bcc     (mua/hdrs-contact  msg field width))
+	  (:date    (mua/hdrs-date     msg width))
+	  (:flags   (mua/hdrs-flags    msg width))
+	  (:size    (mua/hdrs-size     msg width))
+	  (t        (error "Unsupported field: %S" field)))))
+    mua/header-fields " "))
 
 ;;
 ;; Note: we maintain a hash table to remember what message-path corresponds to a
@@ -188,37 +186,33 @@
 ;;
 ;;    point-of-bol -> path
 ;;
-
-(defun mua/hdrs-set-path (path)
-  "Map the bol of the current header to an entry in
-`mua/msg-map', and return the uid."
-  (let ((uid (mua/msg-map-add path)))
-    (puthash (line-beginning-position 1) uid mua/hdrs-hash)
-    uid))
-
 (defun mua/hdrs-get-uid ()
   "Get the uid for the message header at point."
-  (gethash (line-beginning-position 1) mua/hdrs-hash))
+  (get-text-property (point) 'uid))
 
 (defun mua/hdrs-get-path ()
   "Get the current path for the header at point."
   (mua/msg-map-get-path (mua/hdrs-get-uid)))
 
 (defun mua/hdrs-append-message (msg)
-  "append a message line to the buffer and register the message"
-  (let ((line (mua/hdrs-line msg)) (inhibit-read-only t))
+  "Append a one-line description of MSG to the buffer, and register
+it with `mua/msg-map-add' to `mua/msg-map'; add the uid for this
+message as a text-property `uid'."
+  (let* ((uid (mua/msg-map-add (mua/msg-field msg :path)))
+	  (line (propertize (concat "  " (mua/hdrs-line msg) "\n") 'uid uid))
+	  (inhibit-read-only t))
     (save-excursion
       (goto-char (point-max))
-      (mua/hdrs-set-path (mua/msg-field msg :path))
-      (insert "  " line "\n"))))
+      (insert line))))
 
 
+
 ;; Now follow a bunch of function to turn some message field in a
 ;; string for display
 
 (defun mua/hdrs-header (msg field width)
-  "get a string at WIDTH (truncate or ' '-pad) for display as a
-header"
+  "Get a string at WIDTH (truncate or ' '-pad) for display as a
+header."
   (let* ((str (mua/msg-field msg field)) (str (if str str "")))
     (propertize (truncate-string-to-width str width 0 ?\s t)
       'face 'mua/header-face)))
@@ -250,24 +244,15 @@ fitting in WIDTH"
 
 
 (defun mua/hdrs-date (msg width)
-  "return a string for the date of MSG of WIDTH"
+  "Return a string for the date of MSG of WIDTH."
   (let* ((date (mua/msg-field msg :date)))
     (if date
       (propertize  (truncate-string-to-width (format-time-string "%x %X" date)
 		     width 0 ?\s) 'face 'mua/date-face))))
 
 (defun mua/hdrs-flags (msg width)
-  (let* ((flags (mua/msg-field msg :flags))
-	  (flagstr
-	    (mapconcat
-	      (lambda(flag)
-		(case flag
-		  ('unread    "U")
-		  ('seen      "S")
-		  ('replied   "R")
-		  ('attach    "a")
-		  ('encrypted "x")
-		  ('signed    "s"))) flags "")))
+  "Return a string describing the flags of MSG at WIDTH."
+  (let ((flagstr (mua/msg-flags-to-string (mua/msg-field msg :flags))))
     (propertize  (truncate-string-to-width flagstr width 0 ?\s)
       'face 'mua/header-face)))
 
@@ -312,12 +297,14 @@ fitting in WIDTH"
     (mua/warn "No message after this one")
     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")
-    t))
+(defun mua/hdrs-prev ()  
+  "Go to the previous line; t if it worked, nil otherwise."
+  (when (buffer-live-p mua/hdrs-buffer)
+    (with-current-buffer mua/hdrs-buffer
+      (if (or (/= 0 (forward-line -1)) (not (mua/hdrs-get-uid)))
+	(mua/warn "No message before this one")))
+    (when mua/view-uid ;; are we in view buffer?
+      (mua/view (mua/hdrs-get-uid) mua/hdrs-buffer))))
 
 (defun mua/hdrs-view ()
   (interactive)
@@ -336,7 +323,8 @@ fitting in WIDTH"
   "Re-run the query for the current search expression, but only
 if the search process is not already running"
   (interactive)
-  (when mua/last-expression (mua/hdrs-search mua/last-expression)))
+  (when mua/last-expression
+    (mua/hdrs-search mua/last-expression)))
 
 
 ;;; functions for sorting
@@ -483,7 +471,7 @@ latter two are pseudo-markings."
       (mua/msg-reply msg uid)	  
       (mua/warn "No message at point"))))
 
-(defun mua/hdrs-for ()
+(defun mua/hdrs-for-reply ()
   "Forward the message at point."
   (interactive)
   (let* ((uid (mua/hdrs-get-uid))
diff --git a/toys/mua/mua-msg-file.el b/toys/mua/mua-msg-file.el
index f6ada87e..b0c79dcf 100644
--- a/toys/mua/mua-msg-file.el
+++ b/toys/mua/mua-msg-file.el
@@ -170,9 +170,8 @@ determined, return `nil'."
 (defun mua/msg-flags-to-string (flags)
   "Remove duplicates and sort the output of `mua/msg-flags-to-string-1'."
   (concat
-    (sort 
-      (remove-duplicates
-	(append (mua/msg-flags-to-string-1 flags) nil)) '>)))
+    (sort (remove-duplicates
+	     (append (mua/msg-flags-to-string-1 flags) nil)) '>)))
 
 (defun mua/msg-flags-to-string-1 (flags)
   "Convert a list of flags into a string as seen in Maildir
@@ -185,14 +184,17 @@ Also see `mua/msg-string-to-flags'.
 
 \[1\]: http://cr.yp.to/proto/maildir.html"
   (when flags
-    (let ((kar
-	    (case (car flags) 
-	      ('draft    ?D) 
-	      ('flagged  ?F)
-	      ('passed   ?P)
-	      ('replied  ?R)
-	      ('seen     ?S)
-	      ('trashed  ?T))))
+    (let ((kar (case (car flags) 
+		 ('draft     ?D) 
+		 ('flagged   ?F)
+		 ('new       ?N)
+		 ('passed    ?P)
+		 ('replied   ?R)
+		 ('seen      ?S)
+		 ('trashed   ?T)
+		 ('encrypted ?x)
+		 ('signed    ?s)
+		 ('unread    ?u))))
       (concat (and kar (string kar))
 	(mua/msg-flags-to-string-1 (cdr flags))))))
 
diff --git a/toys/mua/mua-mu.el b/toys/mua/mua-mu.el
index 71b6de99..bad3f1b8 100644
--- a/toys/mua/mua-mu.el
+++ b/toys/mua/mua-mu.el
@@ -141,67 +141,4 @@ them."
   (mua/mu-db-update-execute))
 
 
-
-;; generated with:
-;; cat mu-util.h | sed 's/\([A-Z_]\+\).*=\(.*\),/(defconst \L\1 \2)/' < "$<" \
-;;     	| sed 's/_/-/g' > mu-errors.el
-(defconst mu-error  1)
-(defconst mu-error-in-parameters  2)
-(defconst mu-error-internal  3)	
-(defconst mu-error-no-matches  4)
-(defconst mu-error-xapian  11)
-(defconst mu-error-xapian-query	 13)
-(defconst mu-error-xapian-dir-not-accessible  14)
-(defconst mu-error-xapian-not-up-to-date  15)
-(defconst mu-error-xapian-missing-data	16)
-(defconst mu-error-xapian-corruption  17)
-(defconst mu-error-xapian-cannot-get-writelock	18)
-(defconst mu-error-gmime  30)
-(defconst mu-error-contacts  50)
-(defconst mu-error-contacts-cannot-retrieve  51)
-(defconst mu-error-file	 70)
-(defconst mu-error-file-invalid-name  71)
-(defconst mu-error-file-cannot-link  72)
-(defconst mu-error-file-cannot-open  73)
-(defconst mu-error-file-cannot-read  74)
-(defconst mu-error-file-cannot-create  75)
-(defconst mu-error-file-cannot-mkdir  76)
-(defconst mu-error-file-stat-failed  77)
-(defconst mu-error-file-readdir-failed	78)
-(defconst mu-error-file-invalid-source	79)
-(defconst mu-error-file-target-equals-source 80)
-
-
-(defun mua/mu-error (err)
-  "Convert an exit code from mu into a string."
-  (cond 
-    ((eql err mu-error)					"General error")
-    ((eql err mu-error-in-parameters)			"Error in parameters")
-    ((eql err mu-error-internal)			"Internal error")
-    ((eql err mu-error-no-matches)			"No matches")
-    ((eql err mu-error-xapian)				"Xapian error")
-    ((eql err mu-error-xapian-query)			"Error in query")
-    ((eql err mu-error-xapian-dir-not-accessible)	"Database dir not accessible")
-    ((eql err mu-error-xapian-not-up-to-date)		"Database is not up-to-date")
-    ((eql err mu-error-xapian-missing-data)		"Missing data")
-    ((eql err mu-error-xapian-corruption)		"Database seems to be corrupted")
-    ((eql err mu-error-xapian-cannot-get-writelock)	"Database is locked")
-    ((eql err mu-error-gmime)				"GMime-related error")
-    ((eql err mu-error-contacts)			"Contacts-related error")
-    ((eql err mu-error-contacts-cannot-retrieve)	"Failed to retrieve contacts")
-    ((eql err mu-error-file)				"File error")
-    ((eql err mu-error-file-invalid-name)		"Invalid file name")
-    ((eql err mu-error-file-cannot-link)		"Failed to link file")
-    ((eql err mu-error-file-cannot-open)		"Cannot open file")
-    ((eql err mu-error-file-cannot-read)		"Cannot read file")
-    ((eql err mu-error-file-cannot-create)		"Cannot create file")
-    ((eql err mu-error-file-cannot-mkdir)		"mu-mkdir failed")
-    ((eql err mu-error-file-stat-failed)		"stat(2) failed")
-    ((eql err mu-error-file-readdir-failed)		"readdir failed")
-    ((eql err mu-error-file-invalid-source)		"Invalid source file")
-    ((eql err mu-error-file-target-equals-source)	"Source is same as target")
-    (t (format						"Unknown error (%d)" err))))
-
-
 (provide 'mua-mu)
-
diff --git a/toys/mua/mua-view.el b/toys/mua/mua-view.el
index 237e9769..ccde57ca 100644
--- a/toys/mua/mua-view.el
+++ b/toys/mua/mua-view.el
@@ -42,45 +42,46 @@
  "Fields to display in the message view buffer.")
 
 (defvar mua/hdrs-buffer nil
-  "Headers buffer for the view in this buffer.")
+  "*internal* Headers buffer for the view in this buffer.")
 
 (defvar mua/view-uid nil
-  "The UID for the message being viewed in this buffer.")
+  "*internal* The UID for the message being viewed in this buffer.")
 
 
-(defun mua/view (uid headersbuf)
-  "display message identified by UID in a new buffer. Note that
-the action of viewing a message may cause it to be moved/renamed;
-this function returns the resulting name. PARENTBUF refers to the
-buffer who invoked this view; this allows us to return there when
-we quit from this view. Also, if PARENTBUF is a find buffer (ie.,
-has mu-headers-mode as its major mode), this allows various
-commands (navigation, marking etc.) to be applied to this
-buffer.
+(defun mua/view (uid hdrsbuf)
+  "Display the message identified by UID in a new buffer, and mark
+is as no longer unread, -- note that the action of viewing a
+message may cause it to be moved/renamed; this function returns the
+resulting name. PARENTBUF refers to the buffer who invoked this
+view; this allows us to return there when we quit from this
+view. Also, if PARENTBUF is a find buffer (ie., has mu-headers-mode
+as its major mode), this allows various commands (navigation,
+marking etc.) to be applied to this buffer.
 
 For the reasoning to use UID here instead of just the path, see
-`mua/msg-map'.
-"
-  (let* ((path (mua/msg-map-get-path uid))
-	  (sexp (and path (mua/mu-view-sexp path)))
-	  (msg (and sexp (mua/msg-from-string sexp))))
-    (if (not msg)
-      (mua/warn "Cannot view message %S %S" uid path)
-      (progn
-	(switch-to-buffer (get-buffer-create mua/view-buffer-name))
-	(let ((inhibit-read-only t))
-	  (erase-buffer)
-	  (insert (mua/view-message msg)))
-	
+`mua/msg-map'."
+  (condition-case err
+    (let* ((path (mua/msg-map-get-path uid))
+	    (sexp (mua/mu-view-sexp path))
+	    (msg (and sexp (mua/msg-from-string sexp))))
+      (unless (buffer-live-p hdrsbuf) (error "Headers buffer is dead"))
+      (unless msg (error "Cannot view message %S" path))
+      (let ((buf (get-buffer-create mua/view-buffer-name))
+	     (inhibit-read-only t))
+	;; fill buffer with the message
+	(erase-buffer)
+	(insert (mua/view-message msg))
 	(mua/view-mode)
+	(goto-char (point-min))
 	
 	(setq ;; these are buffer-local
 	  mua/view-uid uid
-	  mua/hdrs-buffer headersbuf
-	  mua/parent-buffer headersbuf)
-	;; mark as read
-	(unless (mua/msg-move uid nil "+S-N" t)
-	  (mua/warn "Failed to mark message as read"))))))
+	  mua/hdrs-buffer hdrsbuf
+	  mua/parent-buffer hdrsbuf)
+	
+	(unless (mua/msg-move uid nil "+S-N" t) ;; mark as read
+	  (error "Failed to mark message as read"))))
+    (debug (error))));; (mua/warn "error: %s" (error-message-string err)))))
 
 
 
@@ -228,7 +229,7 @@ own safety)."
   "move to the next message; note, this will replace the current
 buffer"
   (interactive)
-  (mua/with-hdrs-buffer
+  (with-current-buffer mua/hdrs-buffer
     (when (mua/hdrs-next) (mua/hdrs-view))))
 
 (defun mua/view-prev ()