🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: gnu.emacs.vm.bug
Article #8644

vm-summary.el: vm-su-do-author

#8644
From: Kevin Rodgers
Date: Fri, 16 Jul 1993 17:44
166 lines
7268 bytes
Previously I posted a patch to vm-su-do-author to better handle the
"address (full-name)" and "full-name <address>" formats in the From:
header.  However, I noted this problem:

> There is one minor deficiency: any whitespace between the
> attributes isn't yet stripped from the attribute which it
> follows.  If this proves to be a problem, it will be necessary to
> trim the attribute's trailing whitespace with a separate
> string-match and substring call, since adding "\\s *" to the
> header regexps would just be subsumed by the immediately
> preceding "[^<]+" and "[^(]+" patterns.

There was also a typographical error in the clause that handles the
"address (full-name)" format.

Here are two patches to fix these problems: the first is applicable if
you installed my original patch, and the second is applicable to the VM
5.33 distribution:

SCCS/s.vm-summary.el: 1.2 vs. 1.3
*** /tmp/geta7244	Fri Jul 16 11:42:08 1993
--- /tmp/getb7244	Fri Jul 16 11:42:08 1993
***************
*** 566,572 ****
  	    (buffer-substring (match-beginning 1) (match-end 1)))))))
  
  (defun vm-su-do-author (m)
!   (let (full-name from)
      (setq full-name (vm-get-header-contents m "Full-Name"))
      (setq from (or (vm-get-header-contents m "From") (vm-grok-From_-author m)))
      (cond ((null from)
--- 566,580 ----
  	    (buffer-substring (match-beginning 1) (match-end 1)))))))
  
  (defun vm-su-do-author (m)
!   (let ((trim-func (function (lambda (string)
! 			       (let ((match-data (match-data)))
! 				 (unwind-protect
! 				     (if (string-match "\\s +$" string)
! 					 (substring string
! 						    0 (match-beginning 0))
! 				       string)
! 				   (store-match-data match-data))))))
! 	full-name from)
      (setq full-name (vm-get-header-contents m "Full-Name"))
      (setq from (or (vm-get-header-contents m "From") (vm-grok-From_-author m)))
      (cond ((null from)
***************
*** 576,582 ****
  	  ((string-match "^\\s *\\([^<]+\\)<\\(.+\\)>\\s *$" from)
  	   (if (null full-name)
  	       (setq full-name
! 		     (substring from (match-beginning 1) (match-end 1))))
  	   (setq from (substring from (match-beginning 2) (match-end 2))))
  	  ((string-match "^\\s *\\([^(]+\\)(\\(.+\\))\\s *$" from)
  	   (if (null full-name)
--- 584,592 ----
  	  ((string-match "^\\s *\\([^<]+\\)<\\(.+\\)>\\s *$" from)
  	   (if (null full-name)
  	       (setq full-name
! 		     (funcall trim-func
! 			      (substring from
! 					 (match-beginning 1) (match-end 1)))))
  	   (setq from (substring from (match-beginning 2) (match-end 2))))
  	  ((string-match "^\\s *\\([^(]+\\)(\\(.+\\))\\s *$" from)
  	   (if (null full-name)
***************
*** 583,589 ****
  	       (setq full-name
  		     (substring from (match-beginning 2) (match-end 2))))
  	   (setq from
! 		 (substring from (match-beginning 1) (match-beginning 1)))))
      ;; ewe ewe see pee...
      (if (and vm-gargle-uucp (string-match
  "\\([^!@:.]+\\)\\(\\.[^!@:]+\\)?!\\([^!@: \t\n]+\\)\\(@\\([^!@:. \t\n]+\\)\\(.[^ \t\n]+\\)?\\)?[ \t\n]*$"
--- 593,601 ----
  	       (setq full-name
  		     (substring from (match-beginning 2) (match-end 2))))
  	   (setq from
! 		 (funcall trim-func
! 			  (substring from
! 				     (match-beginning 1) (match-end 1))))))
      ;; ewe ewe see pee...
      (if (and vm-gargle-uucp (string-match
  "\\([^!@:.]+\\)\\(\\.[^!@:]+\\)?!\\([^!@: \t\n]+\\)\\(@\\([^!@:. \t\n]+\\)\\(.[^ \t\n]+\\)?\\)?[ \t\n]*$"

Here's the patch, relative to the original vm-summary.el:

SCCS/s.vm-summary.el: 1.1 vs. 1.3
*** /tmp/geta7259	Fri Jul 16 11:43:33 1993
--- /tmp/getb7259	Fri Jul 16 11:43:34 1993
***************
*** 566,572 ****
  	    (buffer-substring (match-beginning 1) (match-end 1)))))))
  
  (defun vm-su-do-author (m)
!   (let (full-name from)
      (setq full-name (vm-get-header-contents m "Full-Name"))
      (setq from (or (vm-get-header-contents m "From") (vm-grok-From_-author m)))
      (cond ((null from)
--- 566,580 ----
  	    (buffer-substring (match-beginning 1) (match-end 1)))))))
  
  (defun vm-su-do-author (m)
!   (let ((trim-func (function (lambda (string)
! 			       (let ((match-data (match-data)))
! 				 (unwind-protect
! 				     (if (string-match "\\s +$" string)
! 					 (substring string
! 						    0 (match-beginning 0))
! 				       string)
! 				   (store-match-data match-data))))))
! 	full-name from)
      (setq full-name (vm-get-header-contents m "Full-Name"))
      (setq from (or (vm-get-header-contents m "From") (vm-grok-From_-author m)))
      (cond ((null from)
***************
*** 573,592 ****
  	   (setq from "???")
  	   (if (null full-name)
  	       (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))))
  	   (setq from
! 		 (concat
! 		  (substring from (match-beginning 0) (1- (match-beginning 1)))
! 		  (substring from (1+ (match-end 1)) (match-end 0))))))
      ;; ewe ewe see pee...
      (if (and vm-gargle-uucp (string-match
  "\\([^!@:.]+\\)\\(\\.[^!@:]+\\)?!\\([^!@: \t\n]+\\)\\(@\\([^!@:. \t\n]+\\)\\(.[^ \t\n]+\\)?\\)?[ \t\n]*$"
--- 581,601 ----
  	   (setq from "???")
  	   (if (null full-name)
  	       (setq full-name "???")))
! 	  ((string-match "^\\s *\\([^<]+\\)<\\(.+\\)>\\s *$" from)
! 	   (if (null full-name)
  	       (setq full-name
! 		     (funcall trim-func
! 			      (substring from
! 					 (match-beginning 1) (match-end 1)))))
! 	   (setq from (substring from (match-beginning 2) (match-end 2))))
! 	  ((string-match "^\\s *\\([^(]+\\)(\\(.+\\))\\s *$" from)
  	   (if (null full-name)
! 	       (setq full-name
! 		     (substring from (match-beginning 2) (match-end 2))))
  	   (setq from
! 		 (funcall trim-func
! 			  (substring from
! 				     (match-beginning 1) (match-end 1))))))
      ;; ewe ewe see pee...
      (if (and vm-gargle-uucp (string-match
  "\\([^!@:.]+\\)\\(\\.[^!@:]+\\)?!\\([^!@: \t\n]+\\)\\(@\\([^!@:. \t\n]+\\)\\(.[^ \t\n]+\\)?\\)?[ \t\n]*$"
--
Kevin Rodgers				kevin@traffic.den.mmc.com
Martin Marietta MS DC5695		(303) 971-2396
P.O. Box 179
Denver CO 80201 USA			GO BUFFS!
Technical Details
Message-ID: <9307161744.AA07271@traffic.den.mmc.com>
Path: arc1-ca.pugleaf.net!gmd.de!xlink.net!howland.reston.ans.net!darwin.sura.net!haven.umd.edu!uunet!wendy-fate.uu.net!bug-vm

Show Full Headers
Complete Article Headers
X-Google-Language: ENGLISH,ASCII-7-bit
X-Google-Thread: f6829,a98dd5eac6a086b,start
X-Google-Attributes: gidf6829,public
X-Google-ArrivalTime: 1993-07-16 10:49:43 PST
x-gateway: rodan.UU.NET from bug-vm to gnu.emacs.vm.bug; Fri, 16 Jul 1993 13:45:25 EDT
Date: Fri, 16 Jul 1993 11:44:50 MDT
From: kevin@traffic.den.mmc.com (Kevin Rodgers)
Message-ID: <9307161744.AA07271@traffic.den.mmc.com>
Subject: vm-summary.el: vm-su-do-author
Newsgroups: gnu.emacs.vm.bug
Path: arc1-ca.pugleaf.net!gmd.de!xlink.net!howland.reston.ans.net!darwin.sura.net!haven.umd.edu!uunet!wendy-fate.uu.net!bug-vm
Sender: bug-vm-request@uunet.uu.net
Lines: 166