Mercurial > hg > xemacs-beta
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)))))