Article View: gnu.emacs.vm.bug
Article #8644vm-summary.el: vm-su-do-author
From: Kevin Rodgers
Date: Fri, 16 Jul 1993 17:44
Date: Fri, 16 Jul 1993 17:44
166 lines
7268 bytes
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-vmShow 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