🚀 go-pugleaf

------- Start of forwarded message -------
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 "stig@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-emacs-request@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-0000M7C@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: <9308170254.AA05851@stigma.key.amdahl.com>
Cc: bug-gnu-emacs@prep.ai.mit.edu, help-gnu-emacs@prep.ai.mit.edu
In-Reply-To: maechler@stat.math.ethz.CH's message of 6 Aug 1993 10:11:46 -0400
Resent-From: bug-gnu-emacs-request@prep.ai.mit.edu
From: stig@key.amdahl.com (Jonathan Stigelman)
Subject: General overstrike support (was: E19.17: Man-set-fonts  in  man.el --- very useful general function --)
Sender: gnulists@ai.mit.edu
To: Martin Maechler <maechler@stat.math.ethz.ch>
Return-Path: <gnulists@ai.mit.edu>
Reply-To: Stig@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))))