diff lisp/vm/vm-misc.el @ 118:7d55a9ba150c r20-1b11

Import from CVS: tag r20-1b11
author cvs
date Mon, 13 Aug 2007 09:24:17 +0200
parents 8619ce7e4c50
children cca96a509cfe
line wrap: on
line diff
--- a/lisp/vm/vm-misc.el	Mon Aug 13 09:23:08 2007 +0200
+++ b/lisp/vm/vm-misc.el	Mon Aug 13 09:24:17 2007 +0200
@@ -92,6 +92,86 @@
 	     (nreverse list)) ; jwz: fixed order
 	(and work-buffer (kill-buffer work-buffer)))))))
 
+(defun vm-parse-structured-header (string &optional sepchar keep-quotes)
+  (if (null string)
+      ()
+    (let ((work-buffer nil))
+      (save-excursion
+       (unwind-protect
+	   (let ((list nil)
+		 (nonspecials "^\"\\( \t\n\r\f")
+		 start s char sp+sepchar)
+	     (if sepchar
+		 (setq nonspecials (concat nonspecials (list sepchar))
+		       sp+sepchar (concat "\t\f\n\r " (list sepchar))))
+	     (setq work-buffer (generate-new-buffer "*vm-work*"))
+	     (buffer-disable-undo work-buffer)
+	     (set-buffer work-buffer)
+	     (insert string)
+	     (goto-char (point-min))
+	     (skip-chars-forward "\t\f\n\r ")
+	     (setq start (point))
+	     (while (not (eobp))
+	       (skip-chars-forward nonspecials)
+	       (setq char (following-char))
+	       (cond ((looking-at "[ \t\n\r\f]")
+		      (delete-char 1))
+		     ((= char ?\\)
+		      (forward-char 1)
+		      (if (not (eobp))
+			  (forward-char 1)))
+		     ((and sepchar (= char sepchar))
+		      (setq s (buffer-substring start (point)))
+		      (if (or (null (string-match "^[\t\f\n\r ]+$" s))
+			      (not (string= s "")))
+			  (setq list (cons s list)))
+		      (skip-chars-forward sp+sepchar)
+		      (setq start (point)))
+		     ((looking-at " \t\n\r\f")
+		      (skip-chars-forward " \t\n\r\f"))
+		     ((= char ?\")
+		      (let ((done nil))
+			(if keep-quotes
+			    (forward-char 1)
+			  (delete-char 1))
+			(while (not done)
+			  (if (null (re-search-forward "[\\\"]" nil t))
+			      (setq done t)
+			    (setq char (char-after (1- (point))))
+			    (cond ((char-equal char ?\\)
+				   (delete-char -1)
+				   (if (eobp)
+				       (setq done t)
+				     (forward-char 1)))
+				  (t (if (not keep-quotes)
+					 (delete-char -1))
+				     (setq done t)))))))
+		     ((= char ?\()
+		      (let ((done nil)
+			    (pos (point))
+			    (parens 1))
+			(forward-char 1)
+			(while (not done)
+			  (if (null (re-search-forward "[\\()]" nil t))
+			      (setq done t)
+			    (setq char (char-after (1- (point))))
+			    (cond ((char-equal char ?\\)
+				   (if (eobp)
+				       (setq done t)
+				     (forward-char 1)))
+				  ((char-equal char ?\()
+				   (setq parens (1+ parens)))
+				  (t
+				   (setq parens (1- parens)
+					 done (zerop parens))))))
+			(delete-region pos (point))))))
+	     (setq s (buffer-substring start (point)))
+	     (if (and (null (string-match "^[\t\f\n\r ]+$" s))
+		      (not (string= s "")))
+		 (setq list (cons s list)))
+	     (nreverse list))
+	(and work-buffer (kill-buffer work-buffer)))))))
+
 (defun vm-write-string (where string)
   (if (bufferp where)
       (vm-save-buffer-excursion
@@ -435,13 +515,15 @@
 	;; save this work so we won't have to do it again
 	(setq vm-sortable-date-alist
 	      (cons (cons string
-			  (timezone-make-date-sortable
-			   (format "%s %s %s %s %s"
-				   (aref vect 1)
-				   (aref vect 2)
-				   (aref vect 3)
-				   (aref vect 4)
-				   (aref vect 5))))
+			  (condition-case nil
+			      (timezone-make-date-sortable
+			       (format "%s %s %s %s %s"
+				       (aref vect 1)
+				       (aref vect 2)
+				       (aref vect 3)
+				       (aref vect 4)
+				       (aref vect 5)))
+			    (error "1970010100:00:00")))
 		    vm-sortable-date-alist))
 	;; return result
 	(cdr (car vm-sortable-date-alist)))))