🚀 go-pugleaf

In message <30920022@hpcc01.corp.hp.com> Len Weisberg wrote:
>
>> vm-save-message.  I had assumed that this sequence of events would cause a
>> fully computed X-VM-v5-Data header to be saved, but the one that was saved
>> was mostly empty (none of the date/time fields filled in, for example.)
> 
> By empty, do you mean the fields were nil or they were "" ?

They were nil.

> I have managed to spend a little time with this and looked at the
> regexps in the function 'vm-su-do-date .  The one for ctime(3) looks a
> little suspicious to me since some date formats put the timezone
> before the year.  My fiddling with this didn't seem to help, but it
> still might be in the ballpark.
> 
> Please post here if anyone has any insights about all this.

I don't think that can explain the problem, because it would mean you could
*never* generate a correct summary, when, as I recall, you're getting correct
summaries in your inbox but not in other folders (right?)

But, the date parsers are pretty limited w.r.t. what's being generated out
there.  Last time I checked, Kyle's position was that he didn't want to handle
lots of funky date formats because he'd rather give people incentive to beat
on their vendors and get them to correctly follow the standard.  My position
remains that life is too short for that, and I want VM to display dates
properly.

(if (not (fboundp 'vm-su-do-date)) (load-library "vm-summary"))
(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)
      (vm-set-weekday-of m "")
      (vm-set-monthday-of m "")
      (vm-set-month-of m "")
      (vm-set-month-number-of m "")
      (vm-set-year-of m "")
      (vm-set-hour-of m "")
      (vm-set-zone-of m "")
      nil)
     ((string-match
;; The date format recognized here is the one specified in RFC 822.
;; Some slop is allowed e.g. dashes between the monthday, month and year
;; because such malformed headers have been observed.
;; jwz: added some more slop - dashes between time and zone.
;; Also allow DOTW to be at end, optionally in parens.
;;
;; Handles:
;;     Mon, 3 dec 90 15:25:36 PST
;;     Mon 3 dec 90 15:25:36 PST
;;     03-dec-90 15:25:36 PST
;;     Mon, 3 dec 90 15:25:36-PST
;;     3 Dec 90 15:25 PST (Mon)
"\\(\\([a-z][a-z][a-z]\\),?\\)?[ \t\n]*0?\\([0-9][0-9]?\\)[ \t\n---]*\\([a-z][a-z][a-z]\\)[ \t\n---]*\\([0-9]*[0-9][0-9]\\)[ \t\n]*\\([0-9:]+\\)[- \t\n]*\\([a-z][a-z]?[a-z]?\\|[---+][0-9][0-9][0-9][0-9]\\)[ \t\n]*(?\\([a-z][a-z][a-z]\\)?)?"
       date)
      (if (match-beginning 2)
	  (vm-set-weekday-of m (substring date (match-beginning 2)
					  (match-end 2)))
	  (if (match-beginning 8)
	      (vm-set-weekday-of m (substring date (match-beginning 8)
					      (match-end 8)))
	      (vm-set-weekday-of m "")))
      (vm-set-monthday-of m (substring date (match-beginning 3) (match-end 3)))
      (vm-su-do-month m (substring date (match-beginning 4) (match-end 4)))
      (vm-set-year-of m (substring date (match-beginning 5) (match-end 5)))
      (vm-set-hour-of m (substring date (match-beginning 6) (match-end 6)))
      (vm-set-zone-of m (substring date (match-beginning 7) (match-end 7)))
      t)
     ((string-match
;; UNIX ctime(3) format, with slop allowed in the whitespace, and we allow for
;; the possibility of a timezone at the end.
;; jwz: more slop - allow a comma after the weekday.
;; Handles:
;;     Tue Dec 11 00:13:13 1990
;;     Mon Sep  2 10:42:17 1991
;;     Tue, Dec 11 00:13:13 90 PST
 "\\([a-z][a-z][a-z]\\)[ \t\n,]+\\([a-z][a-z][a-z]\\)[ \t\n]+\\([0-9][0-9]?\\)[ \t\n]*\\([0-9:]+\\)[ \t\n]*[0-9][0-9]\\([0-9][0-9]\\)[ \t\n]*\\([a-z][a-z]?[a-z]?\\|[---+][0-9][0-9][0-9][0-9]\\)?"
       date)
      (vm-set-weekday-of m (substring date (match-beginning 1) (match-end 1)))
      (vm-su-do-month m (substring date (match-beginning 2) (match-end 2)))
      (vm-set-monthday-of m (substring date (match-beginning 3) (match-end 3)))
      (vm-set-hour-of m (substring date (match-beginning 4) (match-end 4)))
      (vm-set-year-of m (substring date (match-beginning 5) (match-end 5)))
      ;; jwz: don't allow nil in the zone slot.
      (vm-set-zone-of m (if (match-beginning 6)
			    (substring date (match-beginning 6)
				       (match-end 6))
			    ""))
      t)
     ((string-match
;; YASTF: Yet Another Sucky Time Format.  Dan Jacobson found this one.
;; Handles:
;;    Tue, Dec 11 12:11:45 CST 1990
;;    Tue Dec 11 12:11 CST 1990
"\\([a-z][a-z][a-z]\\)[ \t\n,]*\\([a-z][a-z][a-z]\\)[ \t\n]*\\([0-9][0-9]?\\)[ \t\n]*\\([0-9:]+\\)[ \t\n]*\\([a-z][a-z][a-z]\\|[-+]?[0-9][0-9][0-9][0-9]\\)[ \t\n]*\\([0-9]?[0-9]?[0-9][0-9]\\)?"
       date)
      (vm-set-weekday-of m (substring date (match-beginning 1) (match-end 1)))
      (vm-su-do-month m (substring date (match-beginning 2) (match-end 2)))
      (vm-set-monthday-of m (substring date (match-beginning 3) (match-end 3)))
      (vm-set-hour-of m (substring date (match-beginning 4) (match-end 4)))
      (vm-set-zone-of m (if (match-beginning 5)
			    (substring date (match-beginning 5)
				       (match-end 5))
			    ""))
      (vm-set-year-of m (if (match-beginning 6)
			    (substring date (match-beginning 6) (match-end 6))
			    ""))
      t)
     ((string-match
;; jwz: I've seen dates of the form "13-AUG-1990 16:11:21.26" from VMS.
	"\\([0-9]+\\)[- \t]*\\([A-Z][A-Z][A-Z]+\\)[- \t]*\\([0-9][0-9][0-9]?[0-9]?\\)[ \t]+\\([0-9:]+\\)\\(\\.[0-9]+\\)?"
	date)
      (vm-set-weekday-of m "")
      (vm-set-monthday-of m (substring date (match-beginning 1) (match-end 1)))
      (vm-su-do-month m (substring date (match-beginning 2) (match-end 2)))
      (vm-set-year-of m (substring date (match-beginning 3) (match-end 3)))
      (vm-set-hour-of m (substring date (match-beginning 4) (match-end 4)))
      (vm-set-zone-of m "")
      t)
     (t
      ;; otherwise, punt.
      (vm-set-weekday-of m "")
      (vm-set-monthday-of m "")
      (vm-set-month-of m "")
      (vm-set-month-number-of m "")
      (vm-set-year-of m "")
      (vm-set-hour-of m "")
      (vm-set-zone-of m "")
      nil))))

 ------------------- And, as an extra added bonus:


;;; 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.

(if (not (fboundp 'vm-su-do-author)) (load-library "vm-summary"))
(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)
	   (setq from "???")
	   (if (null full-name)
	       (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))))
	   (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]*$"
			     from))
	(setq from
	      (concat
	       (substring from (match-beginning 3) (match-end 3)) "@"
	       (if (and (match-beginning 5) (match-beginning 2)
			(not (match-beginning 6)))
		   (concat (substring from (match-beginning 5) (match-end 5))
			   ".")
		 "")
	       (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)))