[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] master a800c5d: [vcard] Version 0 of vcard package
|
From: |
Eric Abrahamsen |
|
Subject: |
[elpa] master a800c5d: [vcard] Version 0 of vcard package |
|
Date: |
Tue, 4 Feb 2020 16:44:18 -0500 (EST) |
branch: master
commit a800c5dba79e4b9099bb7b70725f0f382ba7c3f6
Author: Eric Abrahamsen <address@hidden>
Commit: Eric Abrahamsen <address@hidden>
[vcard] Version 0 of vcard package
---
packages/vcard/vcard-iso8601.el | 383 +++++++++++++++++++++++++++++++++++++++
packages/vcard/vcard-mode.el | 61 +++++++
packages/vcard/vcard-parse.el | 389 ++++++++++++++++++++++++++++++++++++++++
packages/vcard/vcard.el | 41 +++++
4 files changed, 874 insertions(+)
diff --git a/packages/vcard/vcard-iso8601.el b/packages/vcard/vcard-iso8601.el
new file mode 100644
index 0000000..812ee45
--- /dev/null
+++ b/packages/vcard/vcard-iso8601.el
@@ -0,0 +1,383 @@
+;;; vcard-iso8601.el --- compatibility library for older Emacs -*-
lexical-binding:t -*-
+
+;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
+
+;; Keywords: dates
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This is a copy of the iso8601.el library that exists in Emacs 27
+;; and later. It is loaded conditionally in earlier Emacs that lack
+;; that library.
+
+;; ISO8601 times basically look like 1985-04-01T15:23:49... Or so
+;; you'd think. This is what everybody means when they say "ISO8601",
+;; but it's in reality a quite large collection of syntaxes, including
+;; week numbers, ordinal dates, durations and intervals. This package
+;; has functions for parsing them all.
+;;
+;; The interface functions are `iso8601-parse', `iso8601-parse-date',
+;; `iso8601-parse-time', `iso8601-parse-zone',
+;; `iso8601-parse-duration' and `iso8601-parse-interval'. They all
+;; return decoded time objects, except the last one, which returns a
+;; list of three of them.
+;;
+;; (iso8601-parse-interval "P1Y2M10DT2H30M/2008W32T153000-01")
+;; '((0 0 13 24 5 2007 nil nil -3600)
+;; (0 30 15 3 8 2008 nil nil -3600)
+;; (0 30 2 10 2 1 nil nil nil))
+;;
+;;
+;; The standard can be found at:
+;;
+;;
http://www.loc.gov/standards/datetime/iso-tc154-wg5_n0038_iso_wd_8601-1_2016-02-16.pdf
+;;
+;; The Wikipedia page on the standard is also informative:
+;;
+;; https://en.wikipedia.org/wiki/ISO_8601
+;;
+;; RFC3339 defines the subset that everybody thinks of as "ISO8601".
+
+;;; Code:
+
+(require 'time-date)
+(require 'cl-lib)
+
+(defun iso8601--concat-regexps (regexps)
+ (mapconcat (lambda (regexp)
+ (concat "\\(?:"
+ (replace-regexp-in-string "(" "(?:" regexp)
+ "\\)"))
+ regexps "\\|"))
+
+(defconst iso8601--year-match
+ "\\([+-]?[0-9][0-9][0-9][0-9]\\)")
+(defconst iso8601--full-date-match
+ "\\([+-]?[0-9][0-9][0-9][0-9]\\)-?\\([0-9][0-9]\\)-?\\([0-9][0-9]\\)")
+(defconst iso8601--without-day-match
+ "\\([+-]?[0-9][0-9][0-9][0-9]\\)-\\([0-9][0-9]\\)")
+(defconst iso8601--outdated-date-match
+ "--\\([0-9][0-9]\\)-?\\([0-9][0-9]\\)")
+(defconst iso8601--outdated-reduced-precision-date-match
+ "---?\\([0-9][0-9]\\)")
+(defconst iso8601--week-date-match
+ "\\([+-]?[0-9][0-9][0-9][0-9]\\)-?W\\([0-9][0-9]\\)-?\\([0-9]\\)?")
+(defconst iso8601--ordinal-date-match
+ "\\([+-]?[0-9][0-9][0-9][0-9]\\)-?\\([0-9][0-9][0-9]\\)")
+(defconst iso8601--date-match
+ (iso8601--concat-regexps
+ (list iso8601--year-match
+ iso8601--full-date-match
+ iso8601--without-day-match
+ iso8601--outdated-date-match
+ iso8601--outdated-reduced-precision-date-match
+ iso8601--week-date-match
+ iso8601--ordinal-date-match)))
+
+(defconst iso8601--time-match
+ "\\([0-9][0-9]\\):?\\([0-9][0-9]\\)?:?\\([0-9][0-9]\\)?[.,]?\\([0-9]*\\)")
+
+(defconst iso8601--zone-match
+ "\\(Z\\|\\([+-]\\)\\([0-9][0-9]\\):?\\([0-9][0-9]\\)?\\)")
+
+(defconst iso8601--full-time-match
+ (concat "\\(" (replace-regexp-in-string "(" "(?:" iso8601--time-match) "\\)"
+ "\\(" iso8601--zone-match "\\)?"))
+
+(defconst iso8601--combined-match
+ (concat "\\(" iso8601--date-match "\\)"
+ "\\(?:T\\("
+ (replace-regexp-in-string "(" "(?:" iso8601--time-match)
+ "\\)"
+ "\\(" iso8601--zone-match "\\)?\\)?"))
+
+(defconst iso8601--duration-full-match
+
"P\\([0-9]+Y\\)?\\([0-9]+M\\)?\\([0-9]+D\\)?\\(T\\([0-9]+H\\)?\\([0-9]+M\\)?\\([0-9]+S\\)?\\)?")
+(defconst iso8601--duration-week-match
+ "P\\([0-9]+\\)W")
+(defconst iso8601--duration-combined-match
+ (concat "P" iso8601--combined-match))
+(defconst iso8601--duration-match
+ (iso8601--concat-regexps
+ (list iso8601--duration-full-match
+ iso8601--duration-week-match
+ iso8601--duration-combined-match)))
+
+(defun iso8601-parse (string &optional form)
+ "Parse an ISO 8601 date/time string and return a `decode-time' structure.
+
+The ISO 8601 date/time strings look like \"2008-03-02T13:47:30\",
+but shorter, incomplete strings like \"2008-03-02\" are valid, as
+well as variants like \"2008W32\" (week number) and
+\"2008-234\" (ordinal day number).
+
+See `decode-time' for the meaning of FORM."
+ (if (not (iso8601-valid-p string))
+ (signal 'wrong-type-argument string)
+ (let* ((date-string (match-string 1 string))
+ (time-string (match-string 2 string))
+ (zone-string (match-string 3 string))
+ (date (iso8601-parse-date date-string)))
+ ;; The time portion is optional.
+ (when time-string
+ (let ((time (iso8601-parse-time time-string form)))
+ (setf (decoded-time-hour date) (decoded-time-hour time))
+ (setf (decoded-time-minute date) (decoded-time-minute time))
+ (setf (decoded-time-second date) (decoded-time-second time))))
+ ;; The time zone is optional.
+ (when zone-string
+ (setf (decoded-time-zone date)
+ ;; The time zone in decoded times are in seconds.
+ (* (iso8601-parse-zone zone-string) 60))
+ (setf (decoded-time-dst date) nil))
+ date)))
+
+(defun iso8601-parse-date (string)
+ "Parse STRING (in ISO 8601 format) and return a `decode-time' value."
+ (cond
+ ;; Just a year: [+-]YYYY.
+ ((iso8601--match iso8601--year-match string)
+ (iso8601--decoded-time
+ :year (string-to-number string)))
+ ;; Calendar dates: YYYY-MM-DD and variants.
+ ((iso8601--match iso8601--full-date-match string)
+ (iso8601--decoded-time
+ :year (string-to-number (match-string 1 string))
+ :month (match-string 2 string)
+ :day (match-string 3 string)))
+ ;; Calendar date without day: YYYY-MM.
+ ((iso8601--match iso8601--without-day-match string)
+ (iso8601--decoded-time
+ :year (string-to-number string)
+ :month (match-string 2 string)))
+ ;; Outdated date without year: --MM-DD
+ ((iso8601--match iso8601--outdated-date-match string)
+ (iso8601--decoded-time
+ :month (match-string 1 string)
+ :day (match-string 2 string)))
+ ;; Week dates: YYYY-Www-D
+ ((iso8601--match iso8601--week-date-match string)
+ (let* ((year (string-to-number string))
+ (week (string-to-number (match-string 2 string)))
+ (day-of-week (and (match-string 3 string)
+ (string-to-number (match-string 3 string))))
+ (jan-start (decoded-time-weekday
+ (decode-time
+ (iso8601--encode-time
+ (iso8601--decoded-time :year year
+ :month 1
+ :day 4)))))
+ (correction (+ (if (zerop jan-start) 7 jan-start)
+ 3))
+ (ordinal (+ (* week 7) (or day-of-week 0) (- correction))))
+ (cond
+ ;; Monday 29 December 2008 is written "2009-W01-1".
+ ((< ordinal 1)
+ (setq year (1- year)
+ ordinal (+ ordinal (if (date-leap-year-p year)
+ 366 365))))
+ ;; Sunday 3 January 2010 is written "2009-W53-7".
+ ((> ordinal (if (date-leap-year-p year)
+ 366 365))
+ (setq ordinal (- ordinal (if (date-leap-year-p year)
+ 366 365))
+ year (1+ year))))
+ (let ((month-day (date-ordinal-to-time year ordinal)))
+ (iso8601--decoded-time :year year
+ :month (decoded-time-month month-day)
+ :day (decoded-time-day month-day)))))
+ ;; Ordinal dates: YYYY-DDD
+ ((iso8601--match iso8601--ordinal-date-match string)
+ (let* ((year (string-to-number (match-string 1 string)))
+ (ordinal (string-to-number (match-string 2 string)))
+ (month-day (date-ordinal-to-time year ordinal)))
+ (iso8601--decoded-time :year year
+ :month (decoded-time-month month-day)
+ :day (decoded-time-day month-day))))
+ ;; Obsolete format with implied year: --MM
+ ((iso8601--match "--\\([0-9][0-9]\\)" string)
+ (iso8601--decoded-time :month (string-to-number (match-string 1 string))))
+ ;; Obsolete format with implied year and month: ---DD
+ ((iso8601--match "---\\([0-9][0-9]\\)" string)
+ (iso8601--decoded-time :day (string-to-number (match-string 1 string))))
+ (t
+ (signal 'wrong-type-argument string))))
+
+(defun iso8601-parse-time (string &optional form)
+ "Parse STRING, which should be an ISO 8601 time string.
+The return value will be a `decode-time' structure with just the
+hour/minute/seconds/zone fields filled in.
+
+See `decode-time' for the meaning of FORM."
+ (if (not (iso8601--match iso8601--full-time-match string))
+ (signal 'wrong-type-argument string)
+ (let ((time (match-string 1 string))
+ (zone (match-string 2 string)))
+ (if (not (iso8601--match iso8601--time-match time))
+ (signal 'wrong-type-argument string)
+ (let ((hour (string-to-number (match-string 1 time)))
+ (minute (and (match-string 2 time)
+ (string-to-number (match-string 2 time))))
+ (second (and (match-string 3 time)
+ (string-to-number (match-string 3 time))))
+ (fraction (and (not (zerop (length (match-string 4 time))))
+ (string-to-number (match-string 4 time)))))
+ (when (and fraction
+ (eq form t))
+ (cond
+ ;; Sub-second time.
+ (second
+ (let ((digits (1+ (truncate (log fraction 10)))))
+ (setq second (cons (+ (* second (expt 10 digits))
+ fraction)
+ (expt 10 digits)))))
+ ;; Fractional minute.
+ (minute
+ (setq second (iso8601--decimalize fraction 60)))
+ (hour
+ ;; Fractional hour.
+ (setq minute (iso8601--decimalize fraction 60)))))
+ (iso8601--decoded-time :hour hour
+ :minute (or minute 0)
+ :second (or second 0)
+ :zone (and zone
+ (* 60 (iso8601-parse-zone
+ zone)))))))))
+
+(defun iso8601--decimalize (fraction base)
+ (round (* base (/ (float fraction)
+ (expt 10 (1+ (truncate (log fraction 10))))))))
+
+(defun iso8601-parse-zone (string)
+ "Parse STRING, which should be an ISO 8601 time zone.
+Return the number of minutes."
+ (if (not (iso8601--match iso8601--zone-match string))
+ (signal 'wrong-type-argument string)
+ (if (match-string 2 string)
+ ;; HH:MM-ish.
+ (let ((hour (string-to-number (match-string 3 string)))
+ (minute (and (match-string 4 string)
+ (string-to-number (match-string 4 string)))))
+ (* (if (equal (match-string 2 string) "-")
+ -1
+ 1)
+ (+ (* hour 60)
+ (or minute 0))))
+ ;; "Z".
+ 0)))
+
+(defun iso8601-valid-p (string)
+ "Say whether STRING is a valid ISO 8601 representation."
+ (iso8601--match iso8601--combined-match string))
+
+(defun iso8601-parse-duration (string)
+ "Parse ISO 8601 durations on the form P3Y6M4DT12H30M5S."
+ (cond
+ ((and (iso8601--match iso8601--duration-full-match string)
+ ;; Just a "P" isn't valid; there has to be at least one
+ ;; element, like P1M.
+ (> (length (match-string 0 string)) 2))
+ (iso8601--decoded-time :year (or (match-string 1 string) 0)
+ :month (or (match-string 2 string) 0)
+ :day (or (match-string 3 string) 0)
+ :hour (or (match-string 5 string) 0)
+ :minute (or (match-string 6 string) 0)
+ :second (or (match-string 7 string) 0)))
+ ;; PnW: Weeks.
+ ((iso8601--match iso8601--duration-week-match string)
+ (let ((weeks (string-to-number (match-string 1 string))))
+ ;; Does this make sense? Hm...
+ (iso8601--decoded-time :day (* weeks 7))))
+ ;; P<date>T<time>
+ ((iso8601--match iso8601--duration-combined-match string)
+ (iso8601-parse (substring string 1)))
+ (t
+ (signal 'wrong-type-argument string))))
+
+(defun iso8601-parse-interval (string)
+ "Parse ISO 8601 intervals."
+ (let ((bits (split-string string "/"))
+ start end duration)
+ (if (not (= (length bits) 2))
+ (signal 'wrong-type-argument string)
+ ;; The intervals may be an explicit start/end times, or either a
+ ;; start or an end, and an accompanying duration.
+ (cond
+ ((and (string-match "\\`P" (car bits))
+ (iso8601-valid-p (cadr bits)))
+ (setq duration (iso8601-parse-duration (car bits))
+ end (iso8601-parse (cadr bits))))
+ ((and (string-match "\\`P" (cadr bits))
+ (iso8601-valid-p (car bits)))
+ (setq duration (iso8601-parse-duration (cadr bits))
+ start (iso8601-parse (car bits))))
+ ((and (iso8601-valid-p (car bits))
+ (iso8601-valid-p (cadr bits)))
+ (setq start (iso8601-parse (car bits))
+ end (iso8601-parse (cadr bits))))
+ (t
+ (signal 'wrong-type-argument string))))
+ (unless end
+ (setq end (decoded-time-add start duration)))
+ (unless start
+ (setq start (decoded-time-add end
+ ;; We negate the duration so that
+ ;; we get a subtraction.
+ (mapcar (lambda (elem)
+ (if (numberp elem)
+ (- elem)
+ elem))
+ duration))))
+ (list start end
+ (or duration
+ ;; FIXME: Support subseconds.
+ ;; FIXME: It makes no sense to decode a time difference
+ ;; according to (decoded-time-zone end), or according to
+ ;; any other time zone for that matter.
+ (decode-time (time-subtract (iso8601--encode-time end)
+ (iso8601--encode-time start))
+ (or (decoded-time-zone end) 0) 'integer)))))
+
+(defun iso8601--match (regexp string)
+ (string-match (concat "\\`" regexp "\\'") string))
+
+(defun iso8601--value (elem &optional default)
+ (if (stringp elem)
+ (string-to-number elem)
+ (or elem default)))
+
+(cl-defun iso8601--decoded-time (&key second minute hour
+ day month year
+ dst zone)
+ (list (iso8601--value second)
+ (iso8601--value minute)
+ (iso8601--value hour)
+ (iso8601--value day)
+ (iso8601--value month)
+ (iso8601--value year)
+ nil
+ (if (or dst zone) dst -1)
+ zone))
+
+(defun iso8601--encode-time (time)
+ "Like `encode-time', but fill in nil values in TIME."
+ (encode-time (decoded-time-set-defaults (copy-sequence time))))
+
+(provide 'vcard-iso8601)
+
+;;; vcard-iso8601.el ends here
diff --git a/packages/vcard/vcard-mode.el b/packages/vcard/vcard-mode.el
new file mode 100644
index 0000000..ad6e124
--- /dev/null
+++ b/packages/vcard/vcard-mode.el
@@ -0,0 +1,61 @@
+;;; vcard-mode.el --- Major mode for viewing vCard files -*- lexical-binding:
t; -*-
+
+;; Copyright (C) 2019 Free Software Foundation, Inc.
+
+;; Author: Eric Abrahamsen <address@hidden>
+;; Maintainer: Eric Abrahamsen <address@hidden>
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file contains `vcard-mode', for viewing vcard files.
+
+;;; Code:
+
+(require 'vcard)
+
+(defface vcard-property-face
+ '((t :inherit font-lock-function-name-face))
+ "Face for highlighting property names."
+ :group 'vcard)
+
+(defface vcard-parameter-key-face
+ '((t :inherit font-lock-comment-face))
+ "Face for highlighting parameter keys."
+ :group 'vcard)
+
+(defface vcard-parameter-value-face
+ '((t :inherit font-lock-type-face))
+ "Face for highlighting parameter values."
+ :group 'vcard)
+
+(defvar vcard-font-lock-keywords
+ '("BEGIN:VCARD" "END:VCARD"
+ ("^[^ \t;:]+" . 'vcard-property-face)
+ (";\\([^=\n]+\\)=" (1 'vcard-parameter-key-face))
+ ("=\\([^;:\n]+\\)[;:]" (1 'vcard-parameter-value-face))))
+
+;;;###autoload
+(define-derived-mode vcard-mode text-mode "vCard"
+ "Major mode for viewing vCard files."
+ (turn-off-auto-fill)
+ (set (make-local-variable 'paragraph-start) "BEGIN:VCARD")
+ (setq font-lock-defaults '(vcard-font-lock-keywords)))
+
+;;;###autoload
+(add-to-list 'auto-mode-alist '("\\.[Vv][Cc][Ff]\\'" . vcard-mode))
+
+(provide 'vcard-mode)
+;;; vcard-mode.el ends here
diff --git a/packages/vcard/vcard-parse.el b/packages/vcard/vcard-parse.el
new file mode 100644
index 0000000..e9f7f30
--- /dev/null
+++ b/packages/vcard/vcard-parse.el
@@ -0,0 +1,389 @@
+;;; vcard-parse.el --- Library for parsing vCards -*- lexical-binding: t;
-*-
+
+;; Copyright (C) 2019 Free Software Foundation, Inc.
+
+;; Author: Eric Abrahamsen <address@hidden>
+;; Maintainer: Eric Abrahamsen <address@hidden>
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This package provides a consumer-agnostic parser for vCard files,
+;; aka Virtual Contact Files. Its entry points parse a file or buffer
+;; containing one or more contacts in vCard format, and return the
+;; data as a structure meant for use by other programs. It can parse
+;; versions 2.1, 3.0, and 4.0 of the vCard standard, RFC 6350 (see
+;; https://tools.ietf.org/html/rfc6350).
+
+;; Parsed vCards are returned as lists containing contact properties.
+;; Each property is a list containing the property name, downcased and
+;; interned as a symbol, the property value, cast to the most
+;; appropriate type, and a further alist of property parameters,
+;; values also cast to type where applicable. For example, this email
+;; property:
+
+;; EMAIL;TYPE=work:address@hidden
+
+;; Will be parsed into:
+
+;; (email "address@hidden" ((type . "work")))
+
+;; A contact is a structure containing a list of properties. As much
+;; as possible, the internal implementation of the structure should be
+;; ignored, and the properties of a single contact accessed only
+;; through the provided getters. The getters are:
+
+;; `vcard-contact-properties': Return a list of all properties.
+
+;; `vcard-contact-property-types': Return a list of all the different
+;; property types this contact has, as symbols.
+
+;; `vcard-contact-property-type': Return all properties of the given
+;; type, for this contact. The return value, if non-nil, is either a
+;; single property, or a list of (possibly just one) properties,
+;; depending on the cardinality of the property type (see the RFC).
+
+;; `vcard-contact-property-groups': Return a list of all the property
+;; groups for the given contact. A single property's group is found
+;; under the 'group key in its parameter list.
+
+;; `vcard-contact-property-group': Return all the properties of the
+;; given group, for this contact, or nil.
+
+;; For reference, these are the property types specified for vCard
+;; version 4.0:
+
+;; "SOURCE" "KIND" "FN" "N" "NICKNAME" "PHOTO" "BDAY" "ANNIVERSARY"
+;; "GENDER" "ADR" "TEL" "EMAIL" "IMPP" "LANG" "TZ" "GEO" "TITLE"
+;; "ROLE" "LOGO" "ORG" "MEMBER" "RELATED" "CATEGORIES" "NOTE" "PRODID"
+;; "REV" "SOUND" "UID" "CLIENTPIDMAP" "URL" "KEY" "FBURL" "CALADRURI"
+;; "CALURI" "XML" iana-token x-name
+
+;; Value types:
+
+;; Booleans, integers, and floats are all cast as expected. If
+;; `vcard-parse-datetime-values' is non-nil, the code will do the best
+;; it can to turn a datetime value into a list of integers a-la
+;; `parse-time-string'. This is done either with the built-in
+;; `iso8601' library that exists in newer Emacs, or with a local copy
+;; that ships with this package, if the built-in version isn't found.
+
+;; While different vCard versions provide slightly different options,
+;; the parsing process attempts to normalize property values as much
+;; as possible. Version 4.0 might have more properties available (the
+;; KIND property, for instance), but for the most part the parsed data
+;; will look the same.
+
+;; TODO:
+
+;; - Go the other direction: produce vCard files from structures.
+
+;;; Code:
+
+(require 'vcard)
+(require 'cl-lib)
+
+(defgroup vcard-parse nil
+ "Customization options for vcard parsing."
+ :group 'vcard)
+
+(defcustom vcard-parse-select-fields nil
+ "A list of field types to select.
+If this variable is non-nil, only the fields listed will be
+parsed, all others will be discarded. Note that the 'version and
+'fn properties are always returned.
+
+Most useful when let-bound around one of the parsing functions."
+ :type '(repeat symbol))
+
+(defcustom vcard-parse-omit-fields nil
+ "A list of field types to omit.
+If this variable is non-nil, the fields listed will be discarded.
+
+Most useful when let-bound around one of the parsing functions."
+ :type '(repeat symbol))
+
+(defcustom vcard-parse-datetime-values t
+ "When non-nil, attempt to parse date/time property values.
+If successful, the property value will be (usually) converted to
+a list of integers, though if the \"type\" parameter of the
+property is \"text\", the value will be returned as a string. It
+is also possible that parsing may fail, in which case the
+original string value will also be returned."
+ :type 'boolean)
+
+(defcustom vcard-parse-card-consumer-function nil
+ "Custom function for consuming a single contact card.
+It is called with a list of properties, as produced by the
+built-in code, or by the return value of
+`vcard-parse-property-consumer-function'."
+ :type 'function)
+
+(defcustom vcard-parse-property-consumer-function nil
+ "Custom function for consuming a single property.
+The function is called with four arguments: the property type as
+a symbol, the property value (all un-escaping, decoding,
+splitting, etc already complete), the property parameters as an
+alist with symbol keys, and the vcard version as a float."
+ :type 'function)
+
+(defvar vcard-parse-overriding-version nil
+ "vCard version, as a float, used when no VERSION property is present.
+vCard versions are sometimes specified outside of the cards
+themselves -- as part of the file media type, for instance. In
+these cases, this variable can be let-bound around the parsing
+process to specify the version.
+
+If a card contains its own VERSION property, that property value
+cannot be overridden.")
+
+(defvar vcard-compound-properties '(n adr gender org)
+ "A list of vcard properties with multi-part values.
+Properties are symbols. Values have several parts, separated by
+semicolons.")
+
+(defvar vcard-datetime-properties '(bday anniversary rev)
+ "A list of vcard properties representing date or time values.
+The parsing process will make some attempt at converting these
+values into lisp timestamps.")
+
+;; Maybe load our local version of iso8601.
+(eval-when-compile
+ (unless (fboundp 'iso8601-parse)
+ (require 'vcard-iso8601)))
+
+;;;###autoload
+(defun vcard-parse-file (file)
+ "Parse FILE containing vCard data into an alist."
+ (interactive "f")
+ (with-temp-buffer
+ (insert-file-contents file)
+ (vcard-parse-buffer)))
+
+;;;###autoload
+(defun vcard-parse-buffer ()
+ "Parse current buffer, containing vCard data.
+Returns a list of contact objects."
+ (interactive)
+ (let ((card-consumer (when (functionp vcard-parse-card-consumer-function)
+ vcard-parse-card-consumer-function))
+ (prop-consumer (if (functionp vcard-parse-property-consumer-function)
+ vcard-parse-property-consumer-function
+ #'list))
+ (warning-series t)
+ card out)
+ ;; vCard 4.0 files *must* be utf-8 encoded + CRLF. But we're only
+ ;; parsing this file, we're not responsible for how it's saved to
+ ;; disk. Don't enable this for now.
+
+ ;; (when (and (null (eq buffer-file-coding-system 'utf-8-unix))
+ ;; (or (eql
+ ;; vard-parse-overriding-version 4.0)
+ ;; (save-excursion
+ ;; (re-search-forward "VERSION:4\\.0" (point-max)
t))))
+ ;; (set-buffer-file-coding-system 'utf-8-unix))
+ (goto-char (point-min))
+ ;; Unfolding consists of removing any instances of
+ ;; newline-plus-space-or-horizontal-tab. Technically there should
+ ;; always be a non-space character following the space, but we
+ ;; don't really care.
+
+ ;; From the RFC:
+
+ ;; Note: It is possible for very simple implementations to
+ ;; generate improperly folded lines in the middle of a UTF-8
+ ;; multi-octet sequence. For this reason, implementations SHOULD
+ ;; unfold lines in such a way as to properly restore the original
+ ;; sequence.
+
+ ;; How would we do that? We could operate on
+ ;; `find-file-literally', but then what?
+
+ ;; CR = \015
+ ;; LF = \012
+ ;; SPC = \040
+ ;; TAB = \011
+ (while (re-search-forward "\n[ \t]" (point-max) t)
+ (replace-match ""))
+
+ (goto-char (point-min))
+
+ ;; This routine assumes no blank lines in the whole file, which is
+ ;; the way it's supposed to be, but we could be a little kinder
+ ;; with a `skip-syntax-forward' check.
+
+ (while (re-search-forward "^BEGIN:VCARD\n" (line-end-position 2) t)
+ (when (setq card (ignore-errors
+ ;; `vcard-parse-card' moves point past the
+ ;; card.
+ (vcard-parse-card prop-consumer card-consumer)))
+ (push card out)))
+
+ (nreverse out)))
+
+(defun vcard-parse-card (&optional prop-consumer card-consumer)
+ "Collect properties from a single vCard and return them as an alist.
+Point is at bol on the first property. Collect properties until
+the \"END:VCARD\" tag is reached, then move past that tag.
+
+PROP-CONSUMER, if given, should be a function accepting three
+arguments -- a property symbol, property value list, and property
+parameter list -- and returning a property object. CARD-CONSUMER
+should be a function accepting one argument -- a list of
+properties -- and returning a card/contact object."
+ (let ((prop-consumer (or prop-consumer #'list))
+ (version
+ ;; First line should be the VERSION property.
+ (or (when (re-search-forward
+ "VERSION:\\([[:digit:].]+\\)\n"
+ (line-end-position 2) t)
+ (string-to-number (match-string 1)))
+ vcard-parse-overriding-version
+ (error "Can't determine vCard version")))
+ card)
+ (push (list 'version version) card)
+ (while (and (null (looking-at-p "^END:VCARD$"))
+ (re-search-forward
+ "^\\(?:\\(?1:[-[:alnum:]]+\\)\\.\\)?\\(?2:[-[:alnum:]]+\\)"
+ (line-end-position) t))
+ (let ((prop (intern (downcase (match-string 2))))
+ anchor sep params value)
+ (when (or (eql prop 'fn)
+ (and (or (null vcard-parse-omit-fields)
+ (null (memql prop vcard-parse-omit-fields)))
+ (or (null vcard-parse-select-fields)
+ (memql prop vcard-parse-select-fields))))
+ ;; Pick up the group.
+ (when-let ((group (match-string-no-properties 1)))
+ (push (cons 'group group) params))
+ ;; Pick up parameters.
+ (while (re-search-forward ";\\([^=]+\\)=\\([^;:]+\\)"
+ (line-end-position) t)
+ (push (cons (intern (match-string-no-properties 1))
+ (downcase (match-string-no-properties 2)))
+ params))
+ (skip-chars-forward ":")
+ ;; Break value on unescaped commas or semicolons, as
+ ;; appropriate. Properties may either be compound
+ ;; (eg. addresses), with parts separated by semicolons, or
+ ;; multi-value (eg. categories), with instances separated by
+ ;; commas, but *not both*.
+ (setq sep (if (memq prop vcard-compound-properties) ";" ",")
+ anchor (point))
+ (while (re-search-forward sep (line-end-position) t)
+ ;; 92 = backslash. Having ?\ in the buffer confuses
+ ;; paredit.
+ (unless (eql (char-before (1- (point))) 92)
+ (push (buffer-substring-no-properties anchor (1- (point))) value)
+ (setq anchor (point))))
+ (push (buffer-substring-no-properties
+ anchor (line-end-position))
+ value)
+ ;; Unescape all remaining colons, semicolons, commas,
+ ;; backslashes and newlines.
+ (setq value
+ (mapcar (lambda (v)
+ (replace-regexp-in-string
+ "\\\\\\([\n:;\\,]\\)" "\\1" v))
+ value))
+ ;; Possibly do some parsing of the value(s).
+ (let ((case-fold-search t))
+ (setq value
+ (mapcar
+ (lambda (v)
+ (cond
+ ((string-match-p "false" v)
+ nil)
+ ((string-match-p "true" v)
+ t)
+ ;; What the hell is this, anyway?
+ ((and (eql prop 'x-ablabel)
+ (string-match "_$!<\\([^>]+\\)>!$_" v))
+ (match-string 1 v))
+ ((memql prop vcard-datetime-properties)
+ (if vcard-parse-datetime-values
+ (let ((val-type (cdr-safe (assoc 'value params))))
+ (cond
+ ((and (stringp val-type)
+ (string-equal val-type "text"))
+ v)
+ ((and (stringp val-type)
+ (string-equal val-type "timestamp"))
+ (parse-time-string v))
+ (t
+ (condition-case nil
+ (iso8601-parse v)
+ (error
+ (lwarn
+ '(vcard) :error
+ "Unable to parse date value: \"%s\"" v))))))
+ v))
+ ((string-match-p "\\`[[:digit:].]+\\'" v)
+ (string-to-number v))
+ (t v)))
+ value)))
+ ;; Do we want to normalize this? This way consumers have to
+ ;; explicitly check if it's a string or a list.
+ (setq value
+ (if (= 1 (length value))
+ (car value)
+ (nreverse value)))
+ (push (funcall prop-consumer prop value params)
+ card))
+ (forward-line)))
+ (if card-consumer
+ (funcall card-consumer (nreverse card))
+ (nreverse card))))
+
+(cl-defmethod vcard-contact-properties ((contact list))
+ "Return a list of all properties in CONTACT."
+ contact)
+
+(cl-defmethod vcard-contact-property-types ((contact list))
+ "Return a list of all property types in CONTACT.
+Each type is a symbol representing a downcased property name."
+ (let (types)
+ (dolist (p (vcard-contact-properties contact) types)
+ (cl-pushnew (car p) types))))
+
+(cl-defmethod vcard-contact-property-type ((contact list)
+ (type symbol))
+ "Return all properties of TYPE from CONTACT.
+TYPE is a symbol, e.g. 'email."
+ (let (props)
+ (dolist (p (vcard-contact-properties contact) props)
+ (when (eql type (car p))
+ (push p props)))))
+
+(cl-defmethod vcard-contact-property-groups ((contact list))
+ "Return a list of all properties groups in CONTACT.
+Each group is a string."
+ (let (groups)
+ (dolist (p (vcard-contact-properties contact) (nreverse groups))
+ (when-let ((g (cdr-safe (assoc 'group (nth 2 p)))))
+ (cl-pushnew g groups :test #'equal)))))
+
+(cl-defmethod vcard-contact-property-group ((contact list)
+ (group string))
+ "Return all properties belonging to GROUP in CONTACT.
+GROUP is a string."
+ (let (props)
+ (dolist (p (vcard-contact-properties contact) props)
+ (when (string-equal (cdr (assq 'group (nth 2 p)))
+ group)
+ (push p props)))))
+
+(provide 'vcard-parse)
+;;; vcard-parse.el ends here
diff --git a/packages/vcard/vcard.el b/packages/vcard/vcard.el
new file mode 100644
index 0000000..2574cd9
--- /dev/null
+++ b/packages/vcard/vcard.el
@@ -0,0 +1,41 @@
+;;; vcard.el --- Utilities for working with vCard files -*- lexical-binding:
t; -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Version: 0
+;; Package-Requires: ((emacs "25.1"))
+
+;; Author: Eric Abrahamsen <address@hidden>
+;; Maintainer: Eric Abrahamsen <address@hidden>
+;; Keywords: mail, comm
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This package provides libraries for working with vCard data: files
+;; representing contact information. At present there are two parts
+;; to it: a major mode for looking at *.vcf files, and a library for
+;; parsing those files into elisp data structures. The third part,
+;; eventually, will be a library for writing elisp data structures to
+;; *.vcf files.
+
+;;; Code:
+
+(defgroup vcard nil
+ "Customization options for the vcard library."
+ :group 'mail)
+
+(provide 'vcard)
+;;; vcard.el ends here
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [elpa] master a800c5d: [vcard] Version 0 of vcard package,
Eric Abrahamsen <=