🚀 go-pugleaf

This isn't my day.  Last posting was a personal reply to Jamie; he sent
me his jwz-vm-summary.el which does the same, but better.  Here it is:

;;; -*- Mode:Emacs-Lisp -*-

;;; Created 10-dec-90 by Jamie Zawinski <jwz@lucid.com>
;;;  7-Aug-91 small bugfix: The regexp-quote for vm-uninteresting-senders.
;;; 15-feb-91 added %H directive, and var vm-summary-no-newlines-in-subject.
;;;  4-mar-91 made %U/%u display Newsgroups: if the From: and To: are both me.
;;;
;;; I store my outgoing and incoming mail in the same file so that conversation
;;; threads are preserved in order.  In other mail readers, I have grown used
;;; to seeing the user-name of the sender of the message displayed in the
;;; summary, unless the sender is me, in which case I see the recipient (along
;;; with some notation that this is happening).
;;; 
;;; Here are the (almost trivial) changes necessary to make VM 5.18 do
;;; that; I have defined two new 'vm-summary-format' directives, %U and %u,
;;; which are like a combination of %F/%f and %T/%t.  Mnemonic: "user" as
;;; in "appropriate user."  All the good ones are taken...
;;; 
;;; The variable 'vm-uninteresting-senders' is a regular expression matching
;;; those From: addresses which should cause the To: addresses to be shown
;;; instead.  This defaults to any set of addresses containing the current
;;; user-id, which should be good enough.
;;; 
;;; The variable 'vm-uninteresting-arrow' contains the string used to show that
;;; the To: field is being shown instead of From:.  Defaults to "=> ".
;;;
;;; If the message is from you and has no To: field, but does have a 
;;; Newsgroups: field, then the %U/%u format directives will display that field
;;; instead.  (I FCC all of my outgoing posts to one file, and this lets me see
;;; the actual destination of the message in the summary.)
;;; 
;;; Think of %U and %u as meaning "the more interesting of the fields From, 
;;; To, and Newsgroups."
;;; 
;;; This file defines the %H format directive as well, which is like the %h
;;; format directive, but excludes the seconds (hh:mm instead of hh:mm:ss).
;;;
;;; If the variable `vm-summary-no-newlines-in-subject' is true, then any
;;; newlines in the subject of a message will be replaced with spaces in the
;;; summary buffer, so that when you get a multi-line subject, it won't uglify
;;; your summary buffer.

(require 'vm)

(defvar vm-summary-no-newlines-in-subject t
  "*If true, then any newlines in the subject of a message will be replaced 
with spaces in the summary buffer.")

(if (not (fboundp 'vm-compile-format)) (load-library "vm-summary"))

(defun vm-compile-format (format-variable)
  (if (null vm-uninteresting-senders) ; jwz: added this.
      (setq vm-uninteresting-senders
	    (concat "\\b" (regexp-quote (user-login-name)) "\\b")))
  (let ((format (symbol-value format-variable))
	sexp sexp-fmt conv-spec last-match-end case-fold-search)
    (store-match-data nil)
    (while (string-match   ; jwz: added "uUH".
"%\\(-\\)?\\([0-9]+\\)?\\(\\.\\([0-9]+\\)\\)?\\([aAcdfFhHilmMnstTuUwyz*%]\\)"
	    format (match-end 0))
      (setq conv-spec (aref format (match-beginning 5)))
      (if (memq conv-spec '(?a ?A ?c ?d ?f ?F ?h ?H ?i ?l ?M
			    ?m ?n ?s ?t ?T ?u ?U ?w ?y ?z ?*)) ; jwz: ?[uUH]
	  (progn
	    (cond ((= conv-spec ?a)
		   (setq sexp (cons (list 'vm-su-attribute-indicators
					  'vm-su-message) sexp)))
		  ((= conv-spec ?A)
		   (setq sexp (cons (list 'vm-su-attribute-indicators-long
					  'vm-su-message) sexp)))
		  ((= conv-spec ?c)
		   (setq sexp (cons (list 'vm-su-byte-count
					  'vm-su-message) sexp)))
		  ((= conv-spec ?d)
		   (setq sexp (cons (list 'vm-su-monthday
					  'vm-su-message) sexp)))
		  ((= conv-spec ?f)
		   (setq sexp (cons (list 'vm-su-from
					  'vm-su-message) sexp)))
		  ((= conv-spec ?F)
		   (setq sexp (cons (list 'vm-su-full-name
					  'vm-su-message) sexp)))
		  ((= conv-spec ?h)
		   (setq sexp (cons (list 'vm-su-hour
					  'vm-su-message) sexp)))
		  ;; jwz: added this.
		  ((= conv-spec ?H)
		   (setq sexp (cons (list 'vm-su-hour-short
					  'vm-su-message) sexp)))
		  ((= conv-spec ?i)
		   (setq sexp (cons (list 'vm-su-message-id
					  'vm-su-message) sexp)))
		  ((= conv-spec ?l)
		   (setq sexp (cons (list 'vm-su-line-count
					  'vm-su-message) sexp)))
		  ((= conv-spec ?m)
		   (setq sexp (cons (list 'vm-su-month
					  'vm-su-message) sexp)))
		  ((= conv-spec ?M)
		   (setq sexp (cons (list 'vm-su-month-number
					  'vm-su-message) sexp)))
		  ((= conv-spec ?n)
		   (setq sexp (cons (list 'vm-su-message-number
					  'vm-su-message) sexp)))
		  ((= conv-spec ?s)
		   (setq sexp (cons (list (if vm-summary-no-newlines-in-subject
					      'vm-su-subject-no-newlines
					      'vm-su-subject)
					  'vm-su-message) sexp)))
		  ((= conv-spec ?T)
		   (setq sexp (cons (list 'vm-su-to-names
					  'vm-su-message) sexp)))
		  ((= conv-spec ?t)
		   (setq sexp (cons (list 'vm-su-to
					  'vm-su-message) sexp)))
		  ;; jwz: added this.
		  ((= conv-spec ?U)
		   (setq sexp (cons (list 'vm-su-dwim-user-name
					  'vm-su-message) sexp)))
		  ;; jwz: added this.
		  ((= conv-spec ?u)
		   (setq sexp (cons (list 'vm-su-dwim-user
					  'vm-su-message) sexp)))
		  ((= conv-spec ?w)
		   (setq sexp (cons (list 'vm-su-weekday
					  'vm-su-message) sexp)))
		  ((= conv-spec ?y)
		   (setq sexp (cons (list 'vm-su-year
					  'vm-su-message) sexp)))
		  ((= conv-spec ?z)
		   (setq sexp (cons (list 'vm-su-zone
					  'vm-su-message) sexp)))
		  ((= conv-spec ?*)
		   (setq sexp (cons (list 'vm-su-mark
					  'vm-su-message) sexp))))
	    (cond ((match-beginning 1)
		   (setcar sexp
			   (list 'vm-left-justify-string (car sexp)
				 (string-to-int (substring format
							   (match-beginning 2)
							   (match-end 2))))))
		  ((match-beginning 2)
		   (setcar sexp
			   (list 'vm-right-justify-string (car sexp)
				 (string-to-int (substring format
							   (match-beginning 2)
							   (match-end 2)))))))
	    (cond ((match-beginning 3)
		   (setcar sexp
			   (list 'vm-truncate-string (car sexp)
				 (string-to-int (substring format
							   (match-beginning 4)
							   (match-end 4)))))))
	    (setq sexp-fmt
		  (cons "%s"
			(cons (substring format
					 (or last-match-end 0)
					 (match-beginning 0))
			      sexp-fmt))))
	(setq sexp-fmt
	      (cons "%%"
		    (cons (substring format
				     (or last-match-end 0)
				     (match-beginning 0))
			  sexp-fmt))))
      (setq last-match-end (match-end 0)))
    (setq sexp-fmt 
	  (cons (substring format
			   (or last-match-end 0)
			   (length format))
		sexp-fmt)
	  sexp-fmt (apply 'concat (nreverse sexp-fmt))
	  sexp (cons 'format (cons sexp-fmt (nreverse sexp))))
    (put format-variable 'vm-format-sexp sexp)
    (put format-variable 'vm-compiled-format format)))

(defvar vm-uninteresting-senders nil
  "*A regular expression matching those user-ids which are considered
\"uninteresting\" in the VM summary buffer; messages whose From: field
contains addresses which match this will have their recipient displayed
in the summary buffer rather than the sender if the \"%u\" or \"%U\"
format directive is used.  See also variable vm-uninteresting-arrow.")

(defvar vm-uninteresting-arrow "=> "
  "*The string used when the \"%u\" or \"%U\" format directive is 
indicating the recipient of a message rather than the sender.")

(defun vm-su-dwim-user (m)
  (let ((from (vm-su-from m)))
    (if (string-match vm-uninteresting-senders from)
	(concat vm-uninteresting-arrow 
	  (let ((to (vm-su-to m)))
	    (if (string= to (user-login-name)) ;; vm-do-recipients returns this if
		(or (vm-get-header-contents m "Newsgroups")  ;; there's no To: line
		    to)
		to)))
	from)))

(defun vm-su-dwim-user-name (m)
  (if (string-match vm-uninteresting-senders (vm-su-from m))
      (concat vm-uninteresting-arrow 
	(let ((to (vm-su-to-names m)))
	  (if (string= to (user-login-name)) ;; vm-do-recipients returns this if
	      (or (vm-get-header-contents m "Newsgroups")  ;; there's no To: line
		  to)
	      to)))
      (vm-su-full-name m)))

(defun vm-su-hour-short (m)
  (let ((string (vm-su-hour m)))
    (cond ((eq 8 (length string))
	   (substring string 0 5))
	  ((eq 7 (length string))
	   (concat "0" (substring string 0 4)))
	  (t string))))

(defun vm-su-subject-no-newlines (m)
  (let ((s (vm-su-subject m)))
    (while (string-match "[ \t]*\n[ \t\n]*" s)
      (setq s (concat (substring s 0 (match-beginning 0)) " "
		      (substring s (match-end 0)))))
    s))