* mm updates

toys/mm/mm-hdrs.el

@@ -126,6 +126,15 @@ the current list of headers."
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(defun mm/hdrs-contact-str (contacts)
+  "Turn the list of contacts CONTACTS (with elements (NAME . EMAIL)
+into a string."
+  (mapconcat
+    (lambda (ct)
+      (let ((name (car ct)) (email (cdr ct)))
+	(or name email "?"))) contacts ", "))
+
+
 (defun mm/hdrs-header-handler (msg &optional point)
   "Create a one line description of MSG in this buffer, at POINT,
 if provided, or at the end of the buffer otherwise."
@@ -135,13 +144,18 @@ if provided, or at the end of the buffer otherwise."
 			  (val (plist-get msg field))
 			  (str
 			    (case field
-			      (:subject val)
+			      ((:subject :maildir :path) val)
-			      ((:to :from :cc :bcc)
+			      ((:to :from :cc :bcc) (mm/hdrs-contact-str val))
-				(mapconcat
+			      ;; if we (ie. `user-mail-address' is the 'From', show 'To', otherwise
-				  (lambda (ct)
+			      ;; show From
-				    (let ((name (car ct)) (email (cdr ct)))
+			      (:from-or-to
-				      (or name email "?"))) val ", "))
+			      	(let* ((from-lst (plist-get msg :from))
-			      (:date (format-time-string "%x %X" val))
+					(from (and from-lst (cdar from-lst))))
+			      	  (if (and from (string-match mm/user-mail-address-regexp from))
+			      	    (concat (propertize "To " 'face 'mm/system-face)
+				      (mm/hdrs-contact-str (plist-get msg :to)))
+				    (mm/hdrs-contact-str from-lst))))			      
+			      (:date (format-time-string mm/headers-date-format val))
 			      (:flags (mm/flags-to-string val))
 			      (:size
 				(cond
@@ -155,7 +169,7 @@ if provided, or at the end of the buffer otherwise."
 		      (if (not width)
 			str
 			(truncate-string-to-width str width 0 ?\s t)))))
-		  mm/header-fields " "))
+		  mm/headers-fields " "))
 	  (flags (plist-get msg :flags))
 	  (line	(cond
 		  ((member 'draft flags)
@@ -239,7 +253,7 @@ after the end of the search results."
       (let ((menumap (make-sparse-keymap "Headers")))
 	(define-key map [menu-bar headers] (cons "Headers" menumap))
 
-	(define-key menumap [quit-buffer] '("Quit" . mm/quit-buffer))
+	(define-key menumap [quit-buffer] '("Quit view" . mm/quit-buffer))
 	(define-key menumap [sepa0] '("--"))
 
 	(define-key menumap [execute-marks]  '("Execute marks" . mm/execute-marks))
@@ -313,7 +327,7 @@ after the end of the search results."
 		   (truncate-string-to-width field width 0 ?\s t)
 		   field)
 		 'face 'mm/title-face) " ")))
-	 mm/header-fields))))
+	 mm/headers-fields))))
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (defvar mm/msg-map nil
   "*internal* A map (hashtable) which maps a database (Xapian)

toys/mm/mm-send.el

@@ -78,7 +78,8 @@ or if not available, :body-html converted to text)."
 		   (with-temp-buffer
 		     (plist-get msg :body-html)
 		     (html2text)
-		     (buffer-string)))))
+		     (buffer-string))))
+	  (body (and body (replace-regexp-in-string "[\r\240]" " " body))))
     (when body
       (concat
 	(format "On %s, %s wrote:"
@@ -129,49 +130,32 @@ return nil."
 	(lambda (msgid) (format "<%s>" msgid))
 	refs ","))))
 
-(defun mm/msg-to-create (msg reply-all)
+(defun mm/msg-to-create (msg)
   "Construct the To: header for a reply-message based on some
-message MSG. If REPLY-ALL is nil, this the the Reply-To addresss of
+message MSG. This the the Reply-To address of MSG if it exist, or
-MSG if it exist, or the From:-address othewise.  If reply-all is
+the From:-address otherwise. The result is either nil or a string
-non-nil, the To: is what was in the old To: with either the
+which can be used for the To:-field."
-Reply-To: or From: appended, and then the
-receiver (i.e. `user-mail-address') removed.
-
-So:
-  reply-all nil: Reply-To: or From: of MSG
-  reply-all t  : Reply-To: or From: of MSG + To: of MSG - `user-mail-address'
-
-The result is either nil or a string which can be used for the To:-field."
   (let ((to-lst (plist-get msg :to))
 	 (reply-to (plist-get msg :reply-to))
 	 (from (plist-get msg :from)))
-    (if reply-all
+    (setq to-lst (or reply-to from))
-      (progn ;; reply-all
+    (mm/msg-recipients-to-string to-lst)))
-	(setq to-lst ;; append Reply-To:, or if not set, From: if set
-	  (if reply-to
-	    (cons `(nil . ,reply-to) to-lst)
-	    (if from
-	      (append to-lst from)
-	      to-lst)))
-
-	;; and remove myself from To:
-	(setq to-lst (mm/msg-recipients-remove to-lst user-mail-address))
-	(mm/msg-recipients-to-string to-lst))
-
-      ;; reply single
-      (progn
-	(or reply-to (mm/msg-recipients-to-string from))))))
 
 
 (defun mm/msg-cc-create (msg reply-all)
   "Get the list of Cc-addresses for the reply to MSG. If REPLY-ALL
-is nil this is simply empty, otherwise it is the same list as the
+is nil this is simply empty, otherwise it is the old CC-list
-one in MSG, minus `user-mail-address'. The result of this function
+together with the old TO-list, minus `user-mail-address'. The
-is either nil or a string to be used for the Cc: field."
+result of this function is either nil or a string to be used for
-  (let ((cc-lst (plist-get msg :cc)))
+the Cc: field."
-    (when (and reply-all cc-lst)
+  (let ((cc-lst (plist-get msg :cc))
-      (mm/msg-recipients-to-string
+	 (to-lst (plist-get msg :to)))
-	(mm/msg-recipients-remove cc-lst user-mail-address)))))
+    (when reply-all
+      (setq cc-lst (append cc-lst to-lst)))
+    ;; remove myself from cc
+    (setq cc-lst (mm/msg-recipients-remove cc-lst user-mail-address))
+    (mm/msg-recipients-to-string cc-lst)))
+
 
 (defun mm/msg-from-create ()
   "Construct a value for the From:-field of the reply to MSG,
@@ -212,7 +196,7 @@ And finally, the cited body of MSG, as per `mm/msg-cite-original'."
       (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) ""))
       (mm/msg-header "Cc" (mm/msg-cc-create msg reply-all))
 
       (mm/msg-header "User-agent"  (mm/msg-user-agent))

toys/mm/mm-view.el

@@ -75,10 +75,19 @@ marking if it still had that."
 		(:cc	   (mm/view-contacts msg field))
 		(:bcc	   (mm/view-contacts msg field))
 
+		;; if we (`user-mail-address' are the From, show To, otherwise,
+		;; show From
+		(:from-or-to
+		  (let* ((from (plist-get msg :from))
+			  (from (and from (cdar from))))
+		    (if (and from (string-match mm/user-mail-address-regexp from))
+		      (mm/view-contacts msg :to)
+		      (mm/view-contacts msg :from))))
+	       
 		;; date
 		(:date
 		  (let ((datestr
-			  (when fieldval (format-time-string "%c" fieldval))))
+			  (when fieldval (format-time-string mm/view-date-format fieldval))))
 		    (if datestr (mm/view-header fieldname datestr) "")))
 		;; size
 		(:size	(mm/view-size  msg)
@@ -141,7 +150,6 @@ or if not available, :body-html converted to text)."
 		    (if name
 		      (format "%s <%s>" name email)
 		      (format "%s" email)))) lst ", "))))
-    (message "%S %S" field fieldname)
     (if contacts
       (mm/view-header fieldname contacts)
       "")))
@@ -232,7 +240,7 @@ or if not available, :body-html converted to text)."
       (let ((menumap (make-sparse-keymap "View")))
 	(define-key map [menu-bar headers] (cons "View" menumap))
 	
-	(define-key menumap [quit-buffer] '("Quit" . mm/quit-buffer))
+	(define-key menumap [quit-buffer] '("Quit view" . mm/quit-buffer))
 
 	(define-key menumap [sepa0] '("--"))
 	(define-key menumap [wrap-lines]
@@ -433,7 +441,7 @@ removing '^M' etc."
 (defun mm/view-extract-attachment (attnum)
   "Extract the attachment with ATTNUM"
   (unless mm/attachment-dir (error "`mm/attachment-dir' is not set"))
-  (when (zerop (hash-table-count mm/attach-map))
+  (when (or (null mm/attach-map) (zerop (hash-table-count mm/attach-map)))
     (error "No attachments for this message"))
   (interactive "nAttachment to extract:")
   (let* ((att  (gethash attnum mm/attach-map))
@@ -456,7 +464,6 @@ removing '^M' etc."
     (unless att (error "Not a valid attachment number"))
     (mm/proc-open (plist-get mm/current-msg :docid) (car att))))
 
-
 (defun mm/view-unmark ()
   "Warn user that unmarking only works in the header list."
   (interactive)

toys/mm/mm.el

@@ -33,10 +33,8 @@
 (require 'mm-send)
 (require 'mm-proc)
 
-
+;; mm-version.el is autogenerated, and defines mm/mu-version
-;; TODO: get this version through to Makefile magic
+(require 'mm-version)
-(defconst mm/version "0.9.8pre"
-  "*internal* my version")
 
 ;; Customization
 
@@ -63,7 +61,6 @@ PATH, you can specifiy the full path."
   :safe 'stringp
   :group 'mm)
 
-
 (defcustom mm/get-mail-command nil
   "Shell command to run to retrieve new mail; e.g. 'offlineimap' or
 'fetchmail'."
@@ -77,6 +74,15 @@ PATH, you can specifiy the full path."
   :group 'mm
   :safe 'stringp)
 
+(defvar mm/user-mail-address-regexp "$^" 
+  "Regular expression matching the user's mail address(es). This is
+used to distinguish ourselves from others, e.g. when replying and
+in :from-or-to headers. By default, match nothing.")
+
+
+(defvar mm/date-format-long "%c"
+  "Date format to use in the message view, in the format of
+  `format-time-string'.")
 
 (defvar mm/debug nil
   "When set to non-nil, log debug information to the *mm-log* buffer.")
@@ -133,7 +139,7 @@ designated shortcut character for the maildir.")
   :group 'mm)
 
 
-(defcustom mm/header-fields
+(defcustom mm/headers-fields
     '( (:date          .  25)
        (:flags         .   6)
        (:from          .  22)
@@ -141,7 +147,16 @@ designated shortcut character for the maildir.")
   "A list of header fields to show in the headers buffer, and their
   respective widths in characters. A width of `nil' means
   'unrestricted', and this is best reserved fo the rightmost (last)
-  field. For the complete list of available headers, see `mm/header-names'")
+  field. For the complete list of available headers, see `mm/header-names'"
+       :type (list 'symbol)
+       :group 'mm/headers)
+
+(defcustom mm/headers-date-format "%x %X"
+  "Date format to use in the headers view, in the format of
+  `format-time-string'."
+  :type  'string
+  :group 'mm/headers)
+
 
 ;; the message view
 (defgroup mm/view nil
@@ -151,10 +166,15 @@ designated shortcut character for the maildir.")
 (defcustom mm/view-fields
   '(:from :to :cc :subject :flags :date :maildir :path :attachments)
   "Header fields to display in the message view buffer. For the
-complete list of available headers, see `mm/header-names'"
+complete list of available headers, see `mm/header-names'."
   :type (list 'symbol)
   :group 'mm/view)
 
+(defcustom mm/view-date-format "%c"
+  "Date format to use in the message view, in the format of
+  `format-time-string'."
+  :type 'string
+  :group 'mm/headers)
 
 ;; Composing / Sending messages
 (defgroup mm/compose nil
@@ -264,16 +284,11 @@ flag set)."
 headers)."
   :group 'mm/faces)
 
-
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; internal variables / constants
 (defconst mm/mm-buffer-name "*mm*"
   "*internal* Name of the mm main buffer.")
 
-(defvar mm/mu-version nil
-  "*interal* version of the mu binary")
-
 (defconst mm/header-names
   '( (:attachments   .  "Attach")
      (:bcc           .  "Bcc")
@@ -341,24 +356,16 @@ in which case it will be equal to `:to'.)")
        (insert
 	"* "
 	 (propertize "mm - mail for emacs version " 'face 'mm/title-face)
-	 (propertize  mm/version 'face 'mm/view-header-value-face)
+	 (propertize  mm/mu-version 'face 'mm/view-header-value-face)
 	 " (send: "
 	 (propertize (if smtpmail-queue-mail "queued" "direct")
 	   'face 'mm/view-header-key-face)
 	 ")"
 	 "\n\n"
 	 "  Watcha wanna do?\n\n"
-	 "    * Show me some messages:\n"
+	 "      - " (propertize "j" 'face 'highlight) "ump to some maildir\n"
-	 "      - In your " (propertize "I" 'face 'highlight) "nbox\n"
+	 "      - " (propertize "s" 'face 'highlight) "earch for a specific message\n"
-	 "      - " (propertize "U" 'face 'highlight) "nread messages\n"
+	 "      - " (propertize "c" 'face 'highlight) "ompose a new message\n"
-	 "      - " (propertize "D" 'face 'highlight) "raft messages\n"
-	 "      - Received " (propertize "T" 'face 'highlight) "oday\n"
-	 "      - Received this " (propertize "W" 'face 'highlight) "eek\n"
-	 "\n"
-	 "    * " (propertize "j" 'face 'highlight) "ump to a folder\n"
-	 "    * " (propertize "s" 'face 'highlight) "earch for a specific message\n"
-	 "\n"
-	 "    * " (propertize "c" 'face 'highlight) "ompose a new message\n"
 	 "\n"
 	 "\n"
 
@@ -456,7 +463,6 @@ maildirs under `mm/maildir."
 	    (fnames
 	      (mapconcat
 		(lambda (item)
-		  (message "%S" item)
 		  (concat
 		    "["
 		    (propertize (make-string 1 (cdr item)) 'face 'mm/view-link-face)
@@ -464,11 +470,12 @@ maildirs under `mm/maildir."
 		    (car item)))
 		mlist ", "))
 	    (kar (read-char (concat prompt fnames))))
-      (if  (= kar ?o) ;; user chose 'other'?
+      (if (= kar ?o) ;; user chose 'other'?
 	(ido-completing-read prompt (mm/get-sub-maildirs mm/maildir))
-	(car-safe
+	(unless (car-safe
-	  (find-if (lambda (item) (= kar (cdr item))) mm/maildir-shortcuts))))))
+		  (find-if (lambda (item) (= kar (cdr item))) mm/maildir-shortcuts))
-
+	  (error "Invalid shortcut"))))))
+  
 
 (defun mm/new-buffer (bufname)
   "Return a new buffer BUFNAME; if such already exists, kill the