displaying sender instead of recipient in summary
Carlos Carvalho
I installed JZ's patch for displaying the sender instead of the
recipient in the summary buffer. It worked fine for my folders and the
one where I keep the messages I send. However, for many messages now I
get nothing in the summary! Here's a forwarding of one of these msgs
header. vm-uninteresting-senders is nil (or set to "carlos"). Below is
a diff of the original 5.33 file and the one I made.
Carlos
Status: RO
X-VM-v5-Data: ([nil nil nil nil nil nil nil nil nil]
[nil "Mon" "16" "August" "93" "19:54:01" "PDT" nil "st...@key.amdahl.com " nil "106" "General overstrike support (was: E19.17: Man-set-fonts in man.el --- very useful general function --)" "^From:" nil nil "8"])
Received: from life.ai.mit.edu by snfep1.if.usp.br (SUN1+/4.1/IFUSP-1.0)
id AA05378
Posted-Date: Mon, 16 Aug 93 19:54:01 PDT
Received-Date: Wed, 18 Aug 93 17:30:38 EST
Received: by life.ai.mit.edu (4.1/AI-4.10) id AA13550; Mon, 16 Aug 93 23:10:28 EDT
Received: from pop-tarts (pop-tarts.ai.mit.edu) by life.ai.mit.edu (4.1/AI-4.10) for /usr/lib/sendmail -odq -oi -fbug-gnu-em...@prep.ai.mit.edu bug-gnu-emacs-inbox id AA13516; Mon, 16 Aug 93 23:09:41 EDT
Received: by pop-tarts (4.1/AI-4.10) id AA02654; Mon, 16 Aug 93 23:09:38 EDT
Resent-Date: Mon, 16 Aug 93 19:54:01 PDT
Resent-Message-Id: <9308170309.AA02654@pop-tarts>
Received: from amdahl.com by life.ai.mit.edu (4.1/AI-4.10) for gnulists id AA12483; Mon, 16 Aug 93 22:55:01 EDT
Received: by amdahl.com (/\==/\ Smail #25.32)
id <m0oSHBt...@amdahl.com>; Mon, 16 Aug 93 19:54 PDT
Received: by stigma.key.amdahl.com (4.0/SMI-4.1/DNS)
id AA05851; Mon, 16 Aug 93 19:54:01 PDT
Message-Id: <930817025...@stigma.key.amdahl.com>
Cc: bug-gn...@prep.ai.mit.edu, help-gn...@prep.ai.mit.edu
In-Reply-To: maec...@stat.math.ethz.CH's message of 6 Aug 1993 10:11:46 -0400
Resent-From: bug-gnu-em...@prep.ai.mit.edu
From: st...@key.amdahl.com (Jonathan Stigelman)
Subject: General overstrike support (was: E19.17: Man-set-fonts in man.el --- very useful general function --)
Sender: gnul...@ai.mit.edu
To: Martin Maechler <maec...@stat.math.ethz.ch>
Return-Path: <gnul...@ai.mit.edu>
Reply-To: St...@netcom.com (Jonathan Stigelman)
Date: Mon, 16 Aug 93 19:54:01 PDT
*** vm-summary.el.ORIG Mon Aug 16 20:34:09 1993
--- vm-summary.el Wed Aug 18 14:26:36 1993
***************
*** 256,270 ****
(eval (get format-variable 'vm-format-sexp))))
(defun vm-compile-format (format-variable)
(let ((format (symbol-value format-variable))
sexp sexp-fmt conv-spec last-match-end case-fold-search)
(store-match-data nil)
! (while (string-match
! "%\\(-\\)?\\([0-9]+\\)?\\(\\.\\([0-9]+\\)\\)?\\([aAcdfFhilmMnstTwyz*%]\\)"
format (match-end 0))
(setq conv-spec (aref format (match-beginning 5)))
! (if (memq conv-spec '(?a ?A ?c ?d ?f ?F ?h ?i ?l ?M
! ?m ?n ?s ?t ?T ?w ?y ?z ?*))
(progn
(cond ((= conv-spec ?a)
(setq sexp (cons (list 'vm-su-attribute-indicators
--- 256,272 ----
(eval (get format-variable 'vm-format-sexp))))
(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
***************
*** 287,292 ****
--- 289,298 ----
((= 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)))
***************
*** 311,316 ****
--- 317,330 ----
((= 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)))
***************
*** 453,458 ****
--- 467,480 ----
(or (vm-hour-of m)
(progn (vm-su-do-date m) (vm-hour-of 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-zone (m)
(or (vm-zone-of m)
(progn (vm-su-do-date m) (vm-zone-of m))))
***************
*** 473,479 ****
(buffer-substring (match-beginning 1) (match-end 1)))))))
(defun vm-su-do-date (m)
! (let (date)
(setq date (or (vm-get-header-contents m "Date") (vm-grok-From_-date m)))
(cond
((null date)
--- 495,502 ----
(buffer-substring (match-beginning 1) (match-end 1)))))))
(defun vm-su-do-date (m)
! (let (date
! (case-fold-search t))
(setq date (or (vm-get-header-contents m "Date") (vm-grok-From_-date m)))
(cond
((null date)
***************
*** 565,570 ****
--- 588,609 ----
(if (looking-at "From \\([^ \t\n]+\\)")
(buffer-substring (match-beginning 1) (match-end 1)))))))
+ ;;; There are many systems where the user's real name is encoded in the
+ ;;; user id. This version of vm-su-do-author parses the user-id to extract
+ ;;; the real name, so that the %F directive does what you want more of the
+ ;;; time. It handles the following forms of addresses:
+ ;;;
+ ;;; Jamie.Zawinski@somehost --> "Jamie Zawinski"
+ ;;; Jamie_Zawinski@somehost --> "Jamie Zawinski"
+ ;;; Jamie_W._Zawinski@somehost --> "Jamie W. Zawinski"
+ ;;; Jamie.W.Zawinski@somehost --> "Jamie W Zawinski"
+ ;;; "Jamie Zawinski"@somehost --> "Jamie Zawinski"
+ ;;; also
+ ;;; jwz ("Jamie Zawinski") --> "Jamie Zawinski"
+ ;;; jwz (Jamie Zawinski (comment)) --> "Jamie Zawinski"
+ ;;; jwz (Jamie Zawinski -- comment) --> "Jamie Zawinski"
+ ;;; and likewise in the "name <uid>" form.
+
(defun vm-su-do-author (m)
(let (full-name from)
(setq full-name (vm-get-header-contents m "Full-Name"))
***************
*** 575,585 ****
(setq full-name "???")))
((string-match "^\\([^< \t\n]+\\([ \t\n]+[^< \t\n]+\\)*\\)?[ \t\n]*\\(<\\([^>]+\\)>\\)"
from)
(if (and (match-beginning 1) (null full-name))
(setq full-name
(substring from (match-beginning 1) (match-end 1))))
(setq from (substring from (match-beginning 4) (match-end 4))))
! ((string-match "[\000-\177]*(\\([^)]+\\))[\000-\177]*" from)
(if (null full-name)
(setq full-name (substring from (match-beginning 1)
(match-end 1))))
--- 614,627 ----
(setq full-name "???")))
((string-match "^\\([^< \t\n]+\\([ \t\n]+[^< \t\n]+\\)*\\)?[ \t\n]*\\(<\\([^>]+\\)>\\)"
from)
+ ;; Matches "Real Name <uid>"
(if (and (match-beginning 1) (null full-name))
(setq full-name
(substring from (match-beginning 1) (match-end 1))))
(setq from (substring from (match-beginning 4) (match-end 4))))
! ((string-match "^[^(]*(\\(.*\\))[^)]*$" from)
! ;; Matches "uid (Real Name)" as well as "uid (real (really) name)"
! ;; and "uid (real name (comment))"
(if (null full-name)
(setq full-name (substring from (match-beginning 1)
(match-end 1))))
***************
*** 602,612 ****
(substring from (match-beginning 1)
(or (match-end 2) (match-end 1)))
(if (match-end 2) "" ".UUCP"))))
! (if (or (null full-name) (string-match "^[ \t\n]*$" full-name))
(setq full-name from))
(vm-set-full-name-of m full-name)
(vm-set-from-of m from)))
(autoload 'rfc822-addresses "rfc822")
(defun vm-su-do-recipients (m)
--- 644,688 ----
(substring from (match-beginning 1)
(or (match-end 2) (match-end 1)))
(if (match-end 2) "" ".UUCP"))))
! (if (or (null full-name) (string-match "^[ \t]*$" full-name))
(setq full-name from))
+ ;; derive username from address if address is of the form "User.Name@Host"
+ ;; or "User_Name@Host" or "\"User Name\"@Host".
+ (if (or (string-match "^[^!@%]+[._][^._%@]*[^@%][@%]" full-name)
+ (string-match "^[^!@%]*\"[^!@%]+ [^ %@]*[^@%][@%]" full-name))
+ (setq full-name (substring full-name 0 (1- (match-end 0)))))
+ (setq full-name (vm-clean-username full-name))
(vm-set-full-name-of m full-name)
(vm-set-from-of m from)))
+ (defun vm-clean-username (string)
+ "Strips garbage from the user full name string."
+ (if (string-match "[%@!]" string) ; this ain't no user name! It's an address! string
+ (let ((case-fold-search t))
+ ;; take off leading and trailing non-alpha chars (quotes, parens, digits, etc)
+ (if (string-match "\\`[^a-z]+" string)
+ (setq string (substring string (match-end 0))))
+ (if (string-match "[^a-z]+\\'" string)
+ (setq string (substring string 0 (match-beginning 0))))
+ ;; replace tabs, multiple spaces, dots, and underscores with a single
+ ;; space but don't replace ". " with " " because that could be an initial.
+ (while (string-match "\\(\t\\| +\\|\\(\\.\\)[^ \t_]\\|_+\\)" string)
+ (setq string (concat (substring string 0
+ (or (match-beginning 2)
+ (match-beginning 1)))
+ " "
+ (substring string (or (match-end 2)
+ (match-end 1))))))
+ ;; If the string contains trailing parenthesized comments, nuke 'em.
+ ;; (As in "John Doe -- Pinhead" or "John Doe (Pinhead)".)
+ (if (string-match "[^ \t]\\([ \t]*\\((\\| --\\)\\)" string)
+ (progn
+ (setq string (substring string 0 (match-beginning 1)))
+ ;; lose any non-alpha rubbish this may have exposed.
+ (if (string-match "[^a-z]+\\'" string)
+ (setq string (substring string 0 (match-beginning 0))))))
+ string)))
+
(autoload 'rfc822-addresses "rfc822")
(defun vm-su-do-recipients (m)
***************
*** 669,674 ****
--- 745,771 ----
(defun vm-su-to (m)
(or (vm-to-of m) (progn (vm-su-do-recipients m) (vm-to-of m))))
+
+ (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
+ (or (vm-get-header-contents m "Newsgroups") ; if there's no To:
+ 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
+ (or (vm-get-header-contents m "Newsgroups") ;; if there's no To:
+ to)
+ to)))
+ (vm-su-full-name m)))
(defun vm-su-to-names (m)
(or (vm-to-names-of m) (progn (vm-su-do-recipients m) (vm-to-names-of m))))