- (save-match-data
- (let ((raw-pos 0)
- (vcard-data nil)
- key data)
- (string-match "^[ \t]*begin:[ \t]*vcard[ \t]*[\r\n]+" raw raw-pos)
- (setq raw-pos (match-end 0))
- (while (and (< raw-pos (length raw))
- (string-match
- "^[ \t]*\\([^:]+\\):[ \t]*\\(.*\\)[ \t]*[\n\r]+"
- raw raw-pos))
- (setq key (vcard-matching-substring 1 raw))
- (setq data (vcard-matching-substring 2 raw))
- (setq raw-pos (match-end 0))
- (cond
- ((string= key "end")
- (setq raw-pos (length raw)))
- (t
- (and filter
- (setq data (funcall filter key data)))
- (setq vcard-data
- (vcard-set-alist-slot vcard-data
- (vcard-split-string key ";")
- (vcard-split-string data ";"))))))
- (nreverse vcard-data))))
-
-(defun vcard-ref (key vcard-data)
- "Return the vcard data associated with KEY in VCARD-DATA.
-Key may be a list of nested keys or a single string of colon-separated
-keys."
- (cond ((listp key)
- (vcard-alist-assoc key vcard-data))
- ((and (stringp key)
- (save-match-data
- (string-match ";" key)))
- (vcard-alist-assoc (vcard-split-string key ";") vcard-data))
- ((stringp key)
- (cdr (assoc key vcard-data)))))
+ (let ((vcard nil)
+ (buf (generate-new-buffer " *vcard parser work*")))
+ (unwind-protect
+ (save-excursion
+ (set-buffer buf)
+ ;; Make sure last line is newline-terminated.
+ ;; An extra trailing newline is harmless.
+ (insert raw "\n")
+ (setq vcard (vcard-parse-region (point-min) (point-max) filter)))
+ (kill-buffer buf))
+ vcard))
+
+;;;###autoload
+(defun vcard-parse-region (beg end &optional filter)
+ "Parse the raw vcard data in region, and return an alist representing data.
+This function is just like `vcard-parse-string' except that it operates on
+a region of the current buffer rather than taking a string as an argument.
+
+Note: this function modifies the buffer!"
+ (or filter
+ (setq filter 'vcard-standard-filter))
+ (let ((case-fold-search t)
+ (vcard-data nil)
+ (pos (make-marker))
+ (newpos (make-marker))
+ properties value)
+ (save-restriction
+ (narrow-to-region beg end)
+ (save-match-data
+ ;; Unfold folded lines and delete naked carriage returns
+ (goto-char (point-min))
+ (while (re-search-forward "\r$\\|\n[ \t]" nil t)
+ (goto-char (match-beginning 0))
+ (delete-char 1))
+
+ (goto-char (point-min))
+ (re-search-forward "^begin:[ \t]*vcard[ \t]*\n")
+ (set-marker pos (point))
+ (while (and (not (looking-at "^end[ \t]*:[ \t]*vcard[ \t]*$"))
+ (re-search-forward ":[ \t]*" nil t))
+ (set-marker newpos (match-end 0))
+ (setq properties
+ (vcard-parse-region-properties pos (match-beginning 0)))
+ (set-marker pos (marker-position newpos))
+ (re-search-forward "[ \t]*\n")
+ (set-marker newpos (match-end 0))
+ (setq value
+ (vcard-parse-region-value properties pos (match-beginning 0)))
+ (set-marker pos (marker-position newpos))
+ (goto-char pos)
+ (funcall filter properties value)
+ (setq vcard-data (cons (cons properties value) vcard-data)))))
+ (nreverse vcard-data)))
+
+(defun vcard-parse-region-properties (beg end)
+ (downcase-region beg end)
+ (let* ((proplist (vcard-split-string (buffer-substring beg end) ";"))
+ (props proplist)
+ split)
+ (save-match-data
+ (while props
+ (cond ((string-match "=" (car props))
+ (setq split (vcard-split-string (car props) "=" 2))
+ (setcar props (cons (car split) (car (cdr split)))))
+ ((member (car props) vcard-encoding-tags)
+ (setcar props (cons "encoding" (car props)))))
+ (setq props (cdr props))))
+ proplist))
+
+(defun vcard-parse-region-value (proplist beg end)
+ (let* ((encoding (vcard-get-property proplist "encoding"))
+ (decoder (cdr (assoc encoding vcard-region-decoder-methods)))
+ result pos match-beg match-end)
+ (save-restriction
+ (narrow-to-region beg end)
+ (cond (decoder
+ ;; Each `;'-separated field needs to be decoded and saved
+ ;; separately; if the entire region were decoded at once, we
+ ;; would not be able to distinguish between the original `;'
+ ;; chars and those which were encoded in order to quote them
+ ;; against being treated as field separators.
+ (goto-char beg)
+ (setq pos (set-marker (make-marker) (point)))
+ (setq match-beg (make-marker))
+ (setq match-end (make-marker))
+ (save-match-data
+ (while (< pos (point-max))
+ (cond ((search-forward ";" nil t)
+ (set-marker match-beg (match-beginning 0))
+ (set-marker match-end (match-end 0)))
+ (t
+ (set-marker match-beg (point-max))
+ (set-marker match-end (point-max))))
+ (funcall decoder pos match-beg)
+ (setq result (cons (buffer-substring pos match-beg) result))
+ (set-marker pos (marker-position match-end))))
+ (setq result (nreverse result))
+ (vcard-set-property proplist "encoding" nil))
+ (t
+ (setq result (vcard-split-string (buffer-string) ";")))))
+ (goto-char (point-max))
+ result))