🚀 go-pugleaf

Here's a new version of my summary hack that defines the %u, %U, and %H
directives.  I've modified it so that 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 the newsgroup name instead of your name.  I find this useful
because I FCC all of my outgoing posts to one file, and this lets me see the
actual destination of them in the summary.

I'm pretty sure Kyle will think this is feeping creaturism and overkill, but
someone might like it.  :-)

	-- Jamie

---------- slice 'n' dice ---------------------------- file: jwz-vm-summary.el
;;; -*- Mode:Emacs-Lisp -*-

;;; Created 10-dec-90 by Jamie Zawinski <jwz@lucid.com>
;;; 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" (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))