[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] master 0504272: Merge branch 'ebdb-bits'
|
From: |
Eric Abrahamsen |
|
Subject: |
[elpa] master 0504272: Merge branch 'ebdb-bits' |
|
Date: |
Tue, 15 Aug 2017 11:38:23 -0400 (EDT) |
branch: master
commit 0504272fe4212cffa28426a82574244ef98e190f
Merge: a60d119 60dd5df
Author: Eric Abrahamsen <address@hidden>
Commit: Eric Abrahamsen <address@hidden>
Merge branch 'ebdb-bits'
Add auxiliary packages for EBDB
---
packages/company-ebdb/company-ebdb.el | 80 +++++++++++
packages/counsel-ebdb/counsel-ebdb.el | 66 +++++++++
packages/ebdb-gnorb/ebdb-gnorb.el | 234 ++++++++++++++++++++++++++++++++
packages/ebdb-i18n-chn/ebdb-i18n-chn.el | 185 +++++++++++++++++++++++++
packages/helm-ebdb/helm-ebdb.el | 83 +++++++++++
5 files changed, 648 insertions(+)
diff --git a/packages/company-ebdb/company-ebdb.el
b/packages/company-ebdb/company-ebdb.el
new file mode 100644
index 0000000..d4f673b
--- /dev/null
+++ b/packages/company-ebdb/company-ebdb.el
@@ -0,0 +1,80 @@
+;;; company-ebdb.el --- company-mode completion backend for EBDB in
message-mode
+
+;; Copyright (C) 2013-2014, 2016 Free Software Foundation, Inc.
+
+;; Author: Jan Tatarik <address@hidden>
+;; Maintainer: Eric Abrahamsen <address@hidden>
+;; Version: 1
+;; Package-Requires: ((company "0.9.4") (ebdb "0.2"))
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Company integration for EBDB. Copied more or less intact from
+;; company-bbdb, originally by Jan Tatarik.
+
+;;; Code:
+
+(require 'company)
+(require 'cl-lib)
+
+(declare-function ebdb-record-mail "ebdb")
+(declare-function ebdb-records "ebdb")
+(declare-function ebdb-dwim-mail "ebdb-com")
+(declare-function ebdb-search "ebdb-com")
+
+(defgroup company-ebdb nil
+ "Completion backend for EBDB."
+ :group 'company)
+
+(defcustom company-ebdb-modes '(message-mode mail-mode notmuch-message-mode)
+ "Major modes in which `company-ebdb' may complete."
+ :type '(repeat (symbol :tag "Major mode"))
+ :package-version '(company . "0.8.8"))
+
+(defun company-ebdb--candidates (arg)
+ (cl-mapcan (lambda (record)
+ (mapcar (lambda (mail) (ebdb-dwim-mail record mail))
+ (ebdb-record-mail record t)))
+ (eval '(ebdb-search (ebdb-records) `((ebdb-field-name ,arg)
+ (ebdb-field-mail ,arg))))))
+
+(defun company-ebdb--post-complete (arg)
+ (when (memq major-mode company-ebdb-modes)
+ (let* ((bits (ebdb-decompose-ebdb-address arg))
+ (recs (ebdb-message-search (car bits) (nth 1 bits))))
+ (when recs
+ (ebdb-display-records recs nil nil nil (ebdb-popup-window))))))
+
+;;;###autoload
+(defun company-ebdb (command &optional arg &rest ignore)
+ "`company-mode' completion backend for EBDB."
+ (interactive (list 'interactive))
+ (cl-case command
+ (interactive (company-begin-backend 'company-ebdb))
+ (prefix (and (memq major-mode company-ebdb-modes)
+ (featurep 'ebdb-com)
+ (looking-back "^\\(To\\|Cc\\|Bcc\\): *.*? *\\([^,;]*\\)"
+ (line-beginning-position))
+ (match-string-no-properties 2)))
+ (candidates (company-ebdb--candidates arg))
+ (post-completion (company-ebdb--post-complete arg))
+ (sorted t)
+ (no-cache t)))
+
+(provide 'company-ebdb)
+;;; company-ebdb.el ends here
diff --git a/packages/counsel-ebdb/counsel-ebdb.el
b/packages/counsel-ebdb/counsel-ebdb.el
new file mode 100644
index 0000000..e4c38be
--- /dev/null
+++ b/packages/counsel-ebdb/counsel-ebdb.el
@@ -0,0 +1,66 @@
+;;; counsel-ebdb.el --- Counsel integration for EBDB -*- lexical-binding: t;
-*-
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; Author: Eric Abrahamsen <address@hidden>
+;; Maintainer: Eric Abrahamsen <address@hidden>
+;; Version: 1
+;; Package-Requires: ((ivy "0.8.0") (ebdb "0.2"))
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Counselivy/ integration for EBDB.
+
+;;; Code:
+
+(require 'ebdb)
+(require 'ivy)
+
+;;;###autoload
+(defun counsel-ebdb ()
+ "Select EBDB contacts using the ivy/counsel interface."
+ (interactive)
+ (ivy-read
+ "Records: "
+ (mapcar
+ ;; This same lambda is used in helm-ebdb, refactor or maybe even
+ ;; make customizable. Presumably we could use the :matcher
+ ;; argument to provide a function that matched the name and mail
+ ;; strings, but then you wouldn't actually see the mail strings in
+ ;; the completion window, would you?
+ (lambda (rec)
+ (let* ((rec-string (ebdb-string rec))
+ (mails (ebdb-record-mail-canon rec))
+ (mail-list (when mails
+ (mapconcat #'identity
+ mails
+ " "))))
+ (cons (if mail-list
+ (concat rec-string
+ " => "
+ mail-list)
+ rec-string)
+ rec)))
+ (ebdb-records))
+ :action
+ '(1
+ ("o" (lambda (r)
+ (ebdb-display-records (list (cdr r)) nil t)) "display")
+ ("m" (lambda (r) (ebdb-mail (cdr r))) "send mail")
+ ("i" (lambda (r) (ebdb-cite-records-mail (cdr r))) "insert"))))
+
+(provide 'counsel-ebdb)
+;;; counsel-ebdb.el ends here
diff --git a/packages/ebdb-gnorb/ebdb-gnorb.el
b/packages/ebdb-gnorb/ebdb-gnorb.el
new file mode 100644
index 0000000..fc4d4e5
--- /dev/null
+++ b/packages/ebdb-gnorb/ebdb-gnorb.el
@@ -0,0 +1,234 @@
+;;; ebdb-gnorb.el --- Utilities for connecting EBDB to Gnorb -*-
lexical-binding: t; -*-
+
+;; Copyright (C) 2016-2017 Free Software Foundation, Inc.
+
+;; Author: Eric Abrahamsen <address@hidden>
+;; Maintainer: Eric Abrahamsen <address@hidden>
+;; Version: 1
+;; Package-Requires: ((gnorb "1.1.0") (ebdb "0.2"))
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Bits and pieces useful for tying EBDB in with Gnorb. Everything in
+;; this file can be moved elsewhere.
+
+;;; Code:
+
+(require 'ebdb-format)
+(require 'ebdb-com)
+(require 'gnorb-org)
+(require 'gnorb-gnus)
+
+(autoload 'org-gnus-follow-link "org-gnus")
+(autoload 'article-lapsed-string "gnus-art")
+
+(defgroup ebdb-gnorb nil
+ "Customizations for Gnorb-specific functionality."
+ :group 'ebdb)
+
+(defcustom gnorb-ebdb-collect-N-messages 5
+ "For records with a `ebdb-gnorb-messages-field',
+collect links to a maximum of this many messages."
+
+ :group 'ebdb-gnorb
+ :type 'integer)
+
+(defcustom gnorb-ebdb-define-recent 'seen
+ "For records with a `gnorb-ebdb-message-tag-field',
+this variable controls how gnorb defines a \"recent\" message.
+Setting it to the symbol 'seen will collect the messages most
+recently opened and viewed. The symbol 'received means gnorb will
+collect the most recent messages by Date header.
+
+In other words, if this variable is set to `received', and a
+record's messages field is already full of recently-received
+messages, opening a five-year-old message (for instance) from
+this record will not push a link to the message into the field."
+
+ :group 'ebdb-gnorb
+ :type '(choice (const :tag "Most recently seen" 'seen)
+ (const :tag "Most recently received" 'received)))
+
+(defcustom gnorb-ebdb-collect-by-thread t
+ "When collecting links to messages, only collect one link per thread.
+
+This option won't work correctly unless `gnus-show-thread' is set
+to t; if it is nil, this option will be ignored.
+
+This also affects how links are followed: when t, following a
+link will display the whole thread."
+
+ :group 'ebdb-gnorb
+ :type 'boolean)
+
+(defcustom gnorb-ebdb-message-format "%:lapsed days: %:subject"
+ "How a single message is formatted in the list of recent messages.
+This format string is used in multi-line record display.
+
+Available information for each message includes the subject, the
+date, and the message's count in the list, as an integer. You can
+access subject and count using the %:subject and %:count escapes.
+The message date can be formatted using any of the escapes
+mentioned in the docstring of `format-time-string', which see, or
+the escape %:lapsed, which inserts the number of days ago the
+message was received."
+
+ :group 'ebdb-gnorb
+ :type 'string)
+
+(defface gnorb-ebdb-link '((t :inherit org-link))
+ "Custom face for displaying message links in the *BBDB* buffer.
+ Defaults to org-link."
+ :group 'ebdb-gnorb)
+
+(cl-defstruct gnorb-ebdb-link
+ subject date group id)
+
+(defclass gnorb-ebdb-field-messages (ebdb-field-user)
+ ((messages
+ :type (list-of gnorb-ebdb-link)
+ :initarg :messages
+ :initform nil)
+ (actions :initform '(("Follow link" . gnorb-ebdb-follow-link))))
+ :human-readable "gnus messages")
+
+(defun gnorb-ebdb-follow-link (_record _field)
+ (when-let ((link (or
+ (get-text-property (point) 'gnorb-link)
+ (get-text-property
+ (ebdb-scan-property 'gnorb-link #'gnorb-ebdb-link-p 1)
+ 'gnorb-link))))
+ (org-gnus-follow-link (gnorb-ebdb-link-group link)
+ (gnorb-ebdb-link-id link))
+ (when (and gnus-show-threads
+ gnorb-ebdb-collect-by-thread)
+ (gnus-summary-refer-thread))))
+
+(cl-defmethod ebdb-string ((field gnorb-ebdb-field-messages))
+ (format "%d messages" (length (slot-value field 'messages))))
+
+(defun ebdb-gnorb-lapsed-days (date)
+ "Return the number of days between now and DATE."
+ ;; Cribbed/simplified from `article-lapsed-string'. Need to handle
+ ;; dates in the future, though that's stupid.
+ (let* ((now (current-time))
+ (delta (time-subtract now date))
+ (real-sec (and delta
+ (+ (* (float (car delta)) 65536)
+ (cadr delta))))
+ (sec (and delta (abs real-sec))))
+ (floor (/ sec 86400))))
+
+(cl-defmethod ebdb-fmt-field ((_fmt ebdb-formatter-ebdb)
+ (field gnorb-ebdb-field-messages)
+ _style
+ (_record ebdb-record))
+ (let* ((msgs (slot-value field 'messages))
+ (outstring
+ (if (= (length msgs) 0)
+ "No message yet"
+ (mapconcat
+ #'identity
+ (let ((count 0) str)
+ (mapcar
+ (lambda (m)
+ (setq str
+ (format-time-string
+ (replace-regexp-in-string
+ "%:subject" (substring
+ (gnorb-ebdb-link-subject m)
+ 0 (min 30
+ (length (gnorb-ebdb-link-subject
m))))
+ (replace-regexp-in-string
+ "%:count" (number-to-string (cl-incf count))
+ gnorb-ebdb-message-format))
+ (gnorb-ebdb-link-date m)))
+ ;; Avoid doing the lapse calculation if not
+ ;; necessary. Of course, this is probably more
+ ;; wasteful than just doing it anyway.
+ (when (string-match-p "%:lapsed" str)
+ (setq str
+ (replace-regexp-in-string
+ "%:lapsed" (number-to-string
+ (ebdb-gnorb-lapsed-days
+ (gnorb-ebdb-link-date m)))
+ str)))
+ (propertize
+ str
+ 'face 'gnorb-ebdb-link
+ 'gnorb-link m))
+ msgs))
+ "\n"))))
+ outstring))
+
+(cl-defmethod ebdb-notice-field ((field gnorb-ebdb-field-messages)
+ (_type (eql sender))
+ (record ebdb-record))
+ "Used in the `bbdb-notice' to possibly save a link
+to a message into the record's `gnorb-ebdb-messages-field'."
+
+ (with-current-buffer gnus-summary-buffer
+ (let* ((links (slot-value field 'messages))
+ (art-no (gnus-summary-article-number))
+ (heads (gnus-summary-article-header art-no))
+ (date (apply 'encode-time
+ (parse-time-string (mail-header-date heads))))
+ (refs (gnus-extract-references (mail-header-references heads)))
+ (subject (gnus-simplify-subject (mail-header-subject heads)))
+ (id (mail-header-id heads))
+ (group (gnorb-get-real-group-name
+ gnus-newsgroup-name
+ art-no))
+ link)
+ (if (not (and date subject id group))
+ (message "Could not save a link to this message")
+ (setq link (make-gnorb-ebdb-link :subject subject :date date
+ :group group :id id))
+ (when (and gnus-show-threads
+ gnorb-ebdb-collect-by-thread)
+ ;; If the new link has a ref to an earlier link, then don't
+ ;; save the new link, but do update the date of the earlier
+ ;; link. Ie, the new link isn't kept, but it "refreshes" the
+ ;; date of the whole thread.
+ (dolist (l links)
+ (when (member (gnorb-ebdb-link-id l)
+ refs)
+ (setf (gnorb-ebdb-link-date l) date)
+ ;; We can discard link.
+ (setq link nil))))
+ (when link
+ (setq links (cons link (delete link links))))
+ (when (eq gnorb-ebdb-define-recent 'received)
+ (setq links (sort links
+ (lambda (a b)
+ (time-less-p
+ (gnorb-ebdb-link-date b)
+ (gnorb-ebdb-link-date a))))))
+ (setq links (cl-subseq links 0 (min (length links)
+ gnorb-ebdb-collect-N-messages)))
+ (ebdb-record-change-field
+ record field
+ (make-instance 'gnorb-ebdb-field-messages
+ :messages links))))))
+
+(eieio-defclass-autoload
+ 'gnorb-ebdb-field-messages
+ 'ebdb-field-user
+ "ebdb-gnorb"
+ "Gnorb field holding links to Gnus messages.")
+
+(provide 'ebdb-gnorb)
+;;; ebdb-gnorb.el ends here
diff --git a/packages/ebdb-i18n-chn/ebdb-i18n-chn.el
b/packages/ebdb-i18n-chn/ebdb-i18n-chn.el
new file mode 100644
index 0000000..1287b82
--- /dev/null
+++ b/packages/ebdb-i18n-chn/ebdb-i18n-chn.el
@@ -0,0 +1,185 @@
+;;; ebdb-chn.el --- China-specific internationalization support for EBDB -*-
lexical-binding: t; -*-
+
+;; Copyright (C) 2016-2017 Free Software Foundation, Inc.
+
+;; Author: Eric Abrahamsen <address@hidden>
+;; Version: 1
+;; Package-Requires: ((pyim "1.6.0") (ebdb "0.2))
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Bits of code for making EBDB nicer to use with China-based
+;; contacts, both for handling Chinese characters, and for formatting
+;; of phones and addresses. Be aware that using this library will
+;; incur a non-neglible slowdown at load time. It shouldn't have any
+;; real impact on search and completion times.
+
+;;; Code:
+
+(require 'pyim)
+(require 'ebdb-i18n)
+
+(cl-defmethod ebdb-string-i18n ((phone ebdb-field-phone)
+ (_cc (eql 86)))
+ (with-slots (area-code number extension) phone
+ (concat
+ "+86 "
+ (if area-code
+ (format "%d-%s" area-code number)
+ number)
+ (if extension
+ (format "X%d" extension)
+ ""))))
+
+(cl-defmethod ebdb-parse-i18n ((class (subclass ebdb-field-phone))
+ (str string)
+ (_cc (eql 86))
+ &optional slots)
+ ;; First remove everything but the numbers.
+ (let ((num-str (string-trim
+ (replace-regexp-in-string "[^0-9Xx]+" "" str)))
+ a-code)
+ ;; In China, basically everything that starts with a 1 is a cell
+ ;; number, unless it starts with a 10, in which case it's the
+ ;; Beijing area code. Sometimes the area codes are written with a
+ ;; leading zero, but they shouldn't be saved that way.
+ (when (string-match "\\`0?\\(10\\|[2-9][0-9]\\{1,2\\}\\)?\\([0-9]+\\)"
num-str)
+ (setq a-code (match-string 1 num-str)
+ slots (plist-put slots :number (match-string 2 num-str)))
+ (when a-code
+ (setq slots (plist-put slots :area-code (string-to-number a-code)))))
+ (when (string-match "X\\([0-9]+\\)\\'" num-str)
+ (setq slots (plist-put slots :extension
+ (string-to-number (match-string 1 num-str)))))
+ (apply #'make-instance class slots)))
+
+(cl-defmethod ebdb-string-i18n ((adr ebdb-field-address)
+ (_cc (eql chn)))
+ (if (eql (aref char-script-table (aref (car streets) 0)) 'han)
+ (with-slots (streets locality region postcode) adr
+ (concat
+ ;; There are four municipalities, we don't need to repeat
+ ;; city-plus-province for them.
+ (unless (string-match-p "北京\\|重庆\\|上海\\|天津" region)
+ region)
+ locality
+ (mapconcat #'identity streets "")
+ ", " postcode))
+ (ebdb-format-address address 2)))
+
+;; This isn't all of them, but it seems like a reasonable subset. See
+;; https://en.wikipedia.org/wiki/Chinese_compound_surname for a fuller
+;; list.
+(defvar ebdb-i18n-chn-compound-surnames
+ '("慕容" "上官" "司马" "欧阳" "司徒" "司空" "西门" "爱新觉罗")
+ "A list of Chinese surnames that are longer than one
+ character.")
+
+(cl-defmethod ebdb-parse-i18n ((class (subclass ebdb-field-name-complex))
+ (string string)
+ (_script (eql han))
+ &optional _slots)
+ (let (surname given-names)
+ (if (string-match (format "\\`\\(%s\\)\\(.*\\)\\'"
+ (regexp-opt ebdb-i18n-chn-compound-surnames))
+ string)
+ (setq surname (match-string 1 string)
+ given-names (match-string 2 string))
+ (setq surname (substring string 0 1)
+ given-names (substring string 1)))
+
+ (make-instance class
+ :surname surname
+ :given-names (list given-names))))
+
+(cl-defmethod ebdb-string-i18n ((field ebdb-field-name-complex)
+ (_script (eql han)))
+ "Properly format names in Chinese characters.
+
+This should only run once, at init time, or any time a record's
+name is changed. The value ends up in the 'name-string slot of
+the record cache."
+ (with-slots (surname given-names) field
+ (concat (when surname surname)
+ (when given-names (car given-names)))))
+
+(cl-defmethod ebdb-china-handle-name ((field ebdb-field-name-complex)
+ (record ebdb-record)
+ add-or-del)
+ "Add or remove a hash for a Chinese-character name.
+
+This function is called by both the `ebdb-init-field-i18n' and
+`ebdb-delete-field-i18n' methods. It checks if the name is in
+Chinese characters, and if it is, converts it into pinyin, and
+either adds or removes a hash entry for the record under that
+name. It also adds the pinyin to the record's name cache, so
+searchs via pinyin will find the record."
+ ;; We use `pyim-hanzi2pinyin-simple' because it's cheaper, and
+ ;; because checking for multiple character pronunciations isn't
+ ;; really helpful in people's names.
+ (let ((fl-py (pyim-hanzi2pinyin-simple (ebdb-name-fl field)))
+ (lf-py (pyim-hanzi2pinyin-simple
+ ;; Don't use `ebdb-name-lf', because there's no sense
+ ;; in having the comma in there.
+ (concat (ebdb-name-last field)
+ " "
+ (ebdb-name-given field t))))
+ (name-string (ebdb-string field))
+ hashfunc listfunc)
+ (if (eql add-or-del 'add)
+ (progn
+ (setq hashfunc #'ebdb-puthash
+ listfunc #'object-add-to-list))
+ (setq hashfunc #'ebdb-remhash
+ listfunc #'object-remove-from-list))
+ (funcall hashfunc fl-py record)
+ (funcall hashfunc lf-py record)
+ (funcall hashfunc name-string record)
+ (funcall listfunc (ebdb-record-cache record) 'alt-names fl-py)
+ (funcall listfunc (ebdb-record-cache record) 'alt-names name-string)
+ (funcall listfunc (ebdb-record-cache record) 'alt-names lf-py)))
+
+(cl-defmethod ebdb-china-handle-name ((field ebdb-field-name-simple)
+ (record ebdb-record)
+ add-or-del)
+ "Add or remove a hash for a Chinese-character name."
+ ;; We use `pyim-hanzi2pinyin-simple' because it's cheaper, and
+ ;; because checking for multiple character pronunciations isn't
+ ;; really helpful in people's names.
+ (let ((name-string (ebdb-string field))
+ hashfunc listfunc)
+ (if (eql add-or-del 'add)
+ (progn
+ (setq hashfunc #'ebdb-puthash
+ listfunc #'object-add-to-list))
+ (setq hashfunc #'ebdb-remhash
+ listfunc #'object-remove-from-list))
+ (funcall hashfunc name-string record)
+ (funcall listfunc (ebdb-record-cache record) 'alt-names name-string)))
+
+(cl-defmethod ebdb-init-field-i18n ((field ebdb-field-name)
+ record
+ (_script (eql han)))
+ (ebdb-china-handle-name field record 'add))
+
+(cl-defmethod ebdb-delete-field-i18n ((field ebdb-field-name)
+ record
+ (_script (eql han))
+ _unload)
+ (ebdb-china-handle-name field record 'del))
+
+(provide 'ebdb-chn)
+;;; ebdb-chn.el ends here
diff --git a/packages/helm-ebdb/helm-ebdb.el b/packages/helm-ebdb/helm-ebdb.el
new file mode 100644
index 0000000..63fda85
--- /dev/null
+++ b/packages/helm-ebdb/helm-ebdb.el
@@ -0,0 +1,83 @@
+;;; helm-ebdb.el --- Helm integration for EBDB -*- lexical-binding: t;
-*-
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; Author: Eric Abrahamsen <address@hidden>
+;; Maintainer: Eric Abrahamsen <address@hidden>
+;; Keywords: mail, convenience
+;; Version: 1
+;; Package-Requires: ((helm "1.0") (ebdb "0.2"))
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Helm integration for EBDB. Provides the command `helm-ebdb'.
+
+;;; Code:
+
+(require 'ebdb)
+(require 'helm)
+
+(declare-function ebdb-display-records "ext:ebdb-com"
+ (records &optional fmt append select pop buf))
+
+(defun helm-ebdb-candidates ()
+ "Return a list of all records in the database."
+ (mapcar (lambda (rec)
+ (let* ((rec-string (ebdb-string rec))
+ (mails (ebdb-record-mail-canon rec))
+ (mail-list (when mails
+ (mapconcat #'identity
+ mails
+ " "))))
+ (cons (if mail-list
+ (concat rec-string
+ " => "
+ mail-list)
+ rec-string)
+ rec)))
+ (ebdb-records)))
+
+(defun helm-ebdb-display-records (candidate)
+ "Display CANDIDATE or marked candidates."
+ (let ((recs (or (helm-marked-candidates) (list candidate))))
+ (ebdb-display-records recs nil nil t nil
+ (format "*%s*" ebdb-buffer-name))))
+
+(defun helm-ebdb-compose-mail (candidate)
+ "Compose mail to CANDIDATE or marked candidates."
+ (let ((recs (or (helm-marked-candidates) (list candidate))))
+ (ebdb-mail recs nil t)))
+
+(defun helm-ebdb-cite-records (candidate)
+ "Insert Name <email> string for CANDIDATE or marked candidate."
+ (let ((recs (or (helm-marked-candidates) (list candidate))))
+ (ebdb-cite-records recs)))
+
+(defvar helm-source-ebdb
+ '((name . "EBDB")
+ (candidates . helm-ebdb-candidates)
+ (action . (("Display" . helm-ebdb-display-records)
+ ("Send mail" . helm-ebdb-compose-mail)
+ ("Insert name and address" . helm-ebdb-cite-records)))))
+
+;;;###autoload
+(defun helm-ebdb ()
+ "Preconfigured `helm' for EBDB."
+ (interactive)
+ (helm-other-buffer 'helm-source-ebdb "*helm ebdb*"))
+
+(provide 'helm-ebdb)
+;;; helm-ebdb.el ends here