Mercurial > hg > xemacs-beta

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

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b11
author cvs
date Mon, 13 Aug 2007 09:24:17 +0200
parents 8619ce7e4c50
children cca96a509cfe
comparison
equal deleted inserted replaced
117:578fd4947a72 118:7d55a9ba150c
90 (not (string= s ""))) 90 (not (string= s "")))
91 (setq list (cons s list))) 91 (setq list (cons s list)))
92 (nreverse list)) ; jwz: fixed order 92 (nreverse list)) ; jwz: fixed order
93 (and work-buffer (kill-buffer work-buffer))))))) 93 (and work-buffer (kill-buffer work-buffer)))))))
94 94
95 (defun vm-parse-structured-header (string &optional sepchar keep-quotes)
96 (if (null string)
97 ()
98 (let ((work-buffer nil))
99 (save-excursion
100 (unwind-protect
101 (let ((list nil)
102 (nonspecials "^\"\\( \t\n\r\f")
103 start s char sp+sepchar)
104 (if sepchar
105 (setq nonspecials (concat nonspecials (list sepchar))
106 sp+sepchar (concat "\t\f\n\r " (list sepchar))))
107 (setq work-buffer (generate-new-buffer "*vm-work*"))
108 (buffer-disable-undo work-buffer)
109 (set-buffer work-buffer)
110 (insert string)
111 (goto-char (point-min))
112 (skip-chars-forward "\t\f\n\r ")
113 (setq start (point))
114 (while (not (eobp))
115 (skip-chars-forward nonspecials)
116 (setq char (following-char))
117 (cond ((looking-at "[ \t\n\r\f]")
118 (delete-char 1))
119 ((= char ?\\)
120 (forward-char 1)
121 (if (not (eobp))
122 (forward-char 1)))
123 ((and sepchar (= char sepchar))
124 (setq s (buffer-substring start (point)))
125 (if (or (null (string-match "^[\t\f\n\r ]+$" s))
126 (not (string= s "")))
127 (setq list (cons s list)))
128 (skip-chars-forward sp+sepchar)
129 (setq start (point)))
130 ((looking-at " \t\n\r\f")
131 (skip-chars-forward " \t\n\r\f"))
132 ((= char ?\")
133 (let ((done nil))
134 (if keep-quotes
135 (forward-char 1)
136 (delete-char 1))
137 (while (not done)
138 (if (null (re-search-forward "[\\\"]" nil t))
139 (setq done t)
140 (setq char (char-after (1- (point))))
141 (cond ((char-equal char ?\\)
142 (delete-char -1)
143 (if (eobp)
144 (setq done t)
145 (forward-char 1)))
146 (t (if (not keep-quotes)
147 (delete-char -1))
148 (setq done t)))))))
149 ((= char ?\()
150 (let ((done nil)
151 (pos (point))
152 (parens 1))
153 (forward-char 1)
154 (while (not done)
155 (if (null (re-search-forward "[\\()]" nil t))
156 (setq done t)
157 (setq char (char-after (1- (point))))
158 (cond ((char-equal char ?\\)
159 (if (eobp)
160 (setq done t)
161 (forward-char 1)))
162 ((char-equal char ?\()
163 (setq parens (1+ parens)))
164 (t
165 (setq parens (1- parens)
166 done (zerop parens))))))
167 (delete-region pos (point))))))
168 (setq s (buffer-substring start (point)))
169 (if (and (null (string-match "^[\t\f\n\r ]+$" s))
170 (not (string= s "")))
171 (setq list (cons s list)))
172 (nreverse list))
173 (and work-buffer (kill-buffer work-buffer)))))))
174
95 (defun vm-write-string (where string) 175 (defun vm-write-string (where string)
96 (if (bufferp where) 176 (if (bufferp where)
97 (vm-save-buffer-excursion 177 (vm-save-buffer-excursion
98 (set-buffer where) 178 (set-buffer where)
99 (goto-char (point-max)) 179 (goto-char (point-max))
433 (if (equal (aref vect 5) "") 513 (if (equal (aref vect 5) "")
434 (aset vect 5 (vm-current-time-zone))) 514 (aset vect 5 (vm-current-time-zone)))
435 ;; save this work so we won't have to do it again 515 ;; save this work so we won't have to do it again
436 (setq vm-sortable-date-alist 516 (setq vm-sortable-date-alist
437 (cons (cons string 517 (cons (cons string
438 (timezone-make-date-sortable 518 (condition-case nil
439 (format "%s %s %s %s %s" 519 (timezone-make-date-sortable
440 (aref vect 1) 520 (format "%s %s %s %s %s"
441 (aref vect 2) 521 (aref vect 1)
442 (aref vect 3) 522 (aref vect 2)
443 (aref vect 4) 523 (aref vect 3)
444 (aref vect 5)))) 524 (aref vect 4)
525 (aref vect 5)))
526 (error "1970010100:00:00")))
445 vm-sortable-date-alist)) 527 vm-sortable-date-alist))
446 ;; return result 528 ;; return result
447 (cdr (car vm-sortable-date-alist))))) 529 (cdr (car vm-sortable-date-alist)))))
448 530
449 (defun vm-current-time-zone () 531 (defun vm-current-time-zone ()