branch: externals/ebdb
commit adb60ddd0f4aca355eb88d44dd4dfb7dec8c6d15
Author: Eric Abrahamsen <e...@ericabrahamsen.net>
Commit: Eric Abrahamsen <e...@ericabrahamsen.net>
Refactor formatter classes, add tabular formatters
* ebdb-format.el (ebdb-formatter-freeform, ebdb-formatter-constrained,
ebdb-formatter-tabular): New formatter classes separating out
different behavior.
(ebdb-fmt-field-label): Make the record argument optional.
(ebdb-formatter-csv): CSV formatter.
(ebdb-default-csv-formatter): New option.
* ebdb-com.el (ebdb-formatter-ebdb): The EBDB formatter inherits from
ebdb-formatter-freeform.
* ebdb-org.el (ebdb-org-formatter-tabular): Add Org table formatter.
(ebdb-org-default-tabular-formatter): New option.
* ebdb-latex.el (ebdb-latex-formatter-tabular): Latex table formatter.
(ebdb-latex-default-tabular-formatter): New option.
* ebdb-html.el (ebdb-html-formatter-tabular): HTML table formatter.
(ebdb-html-default-formatter-tabular): New option.
---
ebdb-com.el | 5 +-
ebdb-format.el | 200 +++++++++++++++++++++++++++++++++++++++++++++++++--------
ebdb-html.el | 100 +++++++++++++++++++++++++++++
ebdb-latex.el | 84 ++++++++++++++++++++++++
ebdb-org.el | 57 +++++++++++++++-
5 files changed, 416 insertions(+), 30 deletions(-)
diff --git a/ebdb-com.el b/ebdb-com.el
index 5032302..32e5bad 100644
--- a/ebdb-com.el
+++ b/ebdb-com.el
@@ -396,7 +396,7 @@ position-marker mark)."
;;; *EBDB* formatting
-(defclass ebdb-formatter-ebdb (ebdb-formatter)
+(defclass ebdb-formatter-ebdb (ebdb-formatter-freeform)
;; This post-format-function only comes into play when the user
;; chooses the EBDB format in `ebdb-format-to-tmp-buffer'.
((post-format-function
@@ -538,18 +538,21 @@ choice: that formatter should be selected explicitly."
(cl-defmethod ebdb-fmt-field-label :around ((_fmt ebdb-formatter-ebdb)
_field
_style
+ &optional
(_record ebdb-record))
(propertize (cl-call-next-method) 'face 'ebdb-label))
(cl-defmethod ebdb-fmt-field-label ((_fmt ebdb-formatter-ebdb)
(field ebdb-field-phone)
(_style (eql oneline))
+ &optional
(_record ebdb-record))
(format "phone (%s)" (ebdb-field-label field)))
(cl-defmethod ebdb-fmt-field-label ((_fmt ebdb-formatter-ebdb)
(field ebdb-field-address)
(_style (eql oneline))
+ &optional
(_record ebdb-record))
(format "address (%s)" (ebdb-field-label field)))
diff --git a/ebdb-format.el b/ebdb-format.el
index c05551d..4435512 100644
--- a/ebdb-format.el
+++ b/ebdb-format.el
@@ -74,11 +74,18 @@
:initform `,buffer-file-coding-system
:documentation "The coding system for the formatted
file/buffer/stream.")
- ;; The elements of the next two slots, besides field class symbols,
- ;; can also use some shortcut symbols: mail, phone, address, notes,
- ;; tags, role, mail-primary, mail-defunct, mail-not-defunct,
- ;; role-defunct, and role-not-defunct.
- (include
+ (post-format-function
+ :type (or null function)
+ :initarg :post-format-function
+ :initform nil
+ :documentation "A function to be called after formatting is
+ complete. Probably a major mode."))
+ :abstract t
+ :documentation "Abstract base class for EBDB formatters.
+ Subclass this to produce real formatters.")
+
+(defclass ebdb-formatter-freeform (ebdb-formatter)
+ ((include
:type list
:initarg :include
:initform nil
@@ -97,13 +104,6 @@
:documentation "How field instances should be sorted. Field
classes should be listed in their proper sort order. A \"_\"
placeholder indicates where all other fields should go." )
- (header
- :type list
- :initarg :header
- :initform '((ebdb-record-person ebdb-field-role ebdb-field-image)
- (ebdb-record-organization ebdb-field-domain ebdb-field-image))
- :documentation "A list of field classes which will be output
- in the header of the record, grouped by record class type.")
(combine
:type list
:initarg :combine
@@ -119,15 +119,48 @@
generally indicates that most of the field contents will
hidden unless the user takes some action, such as clicking or
hitting <TAB>. (Currently unimplemented.)")
- (post-format-function
- :type (or null function)
- :initarg :post-format-function
+ (header
+ :type list
+ :initarg :header
+ :initform '((ebdb-record-person ebdb-field-role ebdb-field-image)
+ (ebdb-record-organization ebdb-field-domain ebdb-field-image))
+ :documentation "A list of field classes which will be output
+ in the header of the record, grouped by record class type."))
+ :abstract t
+ :documentation "An abstract formatter for formats that can
+ accept variable numbers and types of fields.")
+
+(defclass ebdb-formatter-constrained (ebdb-formatter)
+ ((fields
+ :type list
+ :initarg :fields
:initform nil
- :documentation "A function to be called after formatting is
- complete. Probably a major mode."))
+ :documentation "A list of the record fields to output.
+ Fields will be output in the order listed.")
+ (field-missing
+ :type (or string symbol function)
+ :initarg :field-missing
+ :initform "none"
+ :documentation "How to handle missing fields. Can be a
+ string, which will be inserted in place of the missing field,
+ a symbol, which will be raised as an error symbol, or a
+ function, which will be called with three arguments: the
+ formatter, the record, and the field spec."))
:abstract t
- :documentation "Abstract base class for EBDB formatters.
- Subclass this to produce real formatters.")
+ :documentation "An abstract formatter for formats that require
+ an exact specification of fields.")
+
+(defclass ebdb-formatter-tabular (ebdb-formatter-constrained)
+ ((record-separator
+ :type (or string character)
+ :initarg :record-separator
+ :initform "")
+ (field-separator
+ :type (or string character)
+ :initarg :field-separator
+ :initform ""))
+ :documentation "A formatter for outputting records in tabular
+ format.")
(cl-defmethod ebdb-string ((fmt ebdb-formatter))
(slot-value fmt 'label))
@@ -171,7 +204,7 @@ recursively composing subfields of fields.")
This method only returns the string value of FIELD itself,
possibly with text properties attached.")
-(cl-defgeneric ebdb-fmt-field-label (fmt field-or-class style record)
+(cl-defgeneric ebdb-fmt-field-label (fmt field-or-class style &optional record)
"Format a field label, using formatter FMT.
FIELD-OR-CLASS is a field class or a field instance, and STYLE is
a symbol indicating a style of some sort, such as 'compact or
@@ -188,24 +221,28 @@ a symbol indicating a style of some sort, such as
'compact or
(cl-defmethod ebdb-fmt-field-label ((_fmt ebdb-formatter)
(cls (subclass ebdb-field))
_style
+ &optional
(_record ebdb-record))
(ebdb-field-readable-name cls))
(cl-defmethod ebdb-fmt-field-label ((_fmt ebdb-formatter)
(field ebdb-field)
_style
+ &optional
(_record ebdb-record))
(ebdb-field-readable-name field))
(cl-defmethod ebdb-fmt-field-label ((_fmt ebdb-formatter)
(field ebdb-field-labeled)
_style
+ &optional
(_record ebdb-record))
(ebdb-field-label field))
(cl-defmethod ebdb-fmt-field-label ((_fmt ebdb-formatter)
(field ebdb-field-labeled)
(_style (eql compact))
+ &optional
(_record ebdb-record))
(ebdb-field-readable-name field))
@@ -238,10 +275,11 @@ a symbol indicating a style of some sort, such as
'compact or
`ebdb-string'."
(ebdb-string field))
-(cl-defmethod ebdb-fmt-collect-fields ((fmt ebdb-formatter)
+(cl-defmethod ebdb-fmt-collect-fields ((fmt ebdb-formatter-freeform)
(record ebdb-record)
&optional field-list)
- "Collect all fields of RECORD, and filter according to FMT."
+ "Collect all fields of RECORD, and filter according to FMT.
+Returns RECORD's field as a simple list."
;; Remove the `name' slot entry from the list.
(let ((fields (append
field-list
@@ -262,14 +300,41 @@ a symbol indicating a style of some sort, such as
'compact or
(null (ebdb-foo-in-list-p f exclude))))
fields))))
-(cl-defmethod ebdb-fmt-collect-fields ((fmt ebdb-formatter)
+(cl-defmethod ebdb-fmt-collect-fields ((fmt ebdb-formatter-constrained)
+ (record ebdb-record))
+ "Collect RECORD's fields according to FMT's `fields' slot.
+Return as a vector of field instances, with nil in place of
+missing fields."
+ (let* ((fmt-fields (slot-value fmt 'fields))
+ (missing (slot-value fmt 'field-missing))
+ (fields (make-vector (length fmt-fields) nil)))
+ (dotimes (i (length fields))
+ (aset fields i (or (ebdb-record-field record (nth i fmt-fields))
+ (cons (nth i fmt-fields) missing))))
+ fields))
+
+(cl-defmethod ebdb-fmt-sort-fields ((_fmt ebdb-formatter-constrained)
+ (_record ebdb-record)
+ &optional fields)
+ "Don't sort by default."
+ fields)
+
+(cl-defmethod ebdb-fmt-process-fields ((_fmt ebdb-formatter-constrained)
+ (_record ebdb-record)
+ &optional fields)
+ "Process fields for the \"constrained\" formatter class.
+At present, just makes sure that multiple field instances are
+combined into a single string."
+ fields)
+
+(cl-defmethod ebdb-fmt-collect-fields ((fmt ebdb-formatter-freeform)
(record ebdb-record-organization)
&optional field-list)
(cl-call-next-method
fmt record
(append field-list (gethash (ebdb-record-uuid record) ebdb-org-hashtable))))
-(cl-defmethod ebdb-fmt-sort-fields ((fmt ebdb-formatter)
+(cl-defmethod ebdb-fmt-sort-fields ((fmt ebdb-formatter-freeform)
(_record ebdb-record)
field-list)
"Sort FIELD-LIST using sort order from FMT.
@@ -290,7 +355,7 @@ slot of FMT."
#'< sorted)))
sorted))
-(cl-defmethod ebdb-fmt-process-fields ((fmt ebdb-formatter)
+(cl-defmethod ebdb-fmt-process-fields ((fmt ebdb-formatter-freeform)
(_record ebdb-record)
field-list)
"Process FIELD-LIST for FMT.
@@ -333,8 +398,89 @@ multiple instances in a single alist."
outlist)))
(nreverse outlist))))
-;; No basic implementation of `ebdb-fmt-compose-fields' is given, as
-;; that is entirely formatter-dependent.
+;; Tabular formatting
+
+(cl-defmethod ebdb-fmt-record ((fmt ebdb-formatter-tabular)
+ (rec ebdb-record))
+ (let ((fields (ebdb-fmt-process-fields
+ fmt rec
+ (ebdb-fmt-sort-fields
+ fmt rec
+ (ebdb-fmt-collect-fields
+ fmt rec))))
+ (rec-sep (slot-value fmt 'record-separator)))
+ (concat
+ (ebdb-fmt-compose-fields fmt rec fields)
+ rec-sep)))
+
+(cl-defmethod ebdb-fmt-header ((fmt ebdb-formatter-tabular)
+ _records)
+ (with-slots (fields field-separator record-separator) fmt
+ (concat
+ "Name"
+ field-separator
+ (mapconcat
+ (lambda (f)
+ (cond
+ ((stringp f) f)
+ ((or (class-p f)
+ (eieio-object-p f))
+ (ebdb-fmt-field-label fmt f 'normal))
+ ((symbolp f)
+ (symbol-name f))))
+ fields
+ field-separator))))
+
+(cl-defmethod ebdb-fmt-compose-fields ((fmt ebdb-formatter-tabular)
+ (rec ebdb-record)
+ &optional field-list _depth)
+
+ (with-slots (field-separator) fmt
+ (concat
+ (ebdb-record-name rec)
+ field-separator
+ (mapconcat
+ (lambda (f)
+ (if (object-p f)
+ (ebdb-fmt-field fmt f 'compact rec)
+ ;; See docs of 'field-missing slot of
+ ;; `ebdb-formatter-constrained' for explanation of the
+ ;; following behavior.
+ (pcase f
+ (`(_ . ,(and (pred stringp) str)) str)
+ (`(,spec . ,(and (pred symbolp) sym))
+ (signal sym (list rec spec)))
+ (`(,spec . (and (pred functionp) fun))
+ (funcall fun fmt rec spec)))))
+ field-list
+ field-separator))))
+
+(defclass ebdb-formatter-csv (ebdb-formatter-tabular)
+ ((record-separator :initform "\n")
+ (field-separator :initform ",")
+ (post-format-function :initform #'csv-mode)))
+
+(cl-defmethod ebdb-fmt-field ((fmt ebdb-formatter-csv)
+ (_field ebdb-field)
+ _style
+ (_rec ebdb-record))
+ "Quote field strings containing the separator."
+ (let ((sep (slot-value fmt 'field-separator))
+ (field (cl-call-next-method)))
+ (if (and (stringp sep)
+ (string-match-p sep field))
+ (format "\"%s\"" field)
+ field)))
+
+(cl-defmethod ebdb-fmt-header ((_fmt ebdb-formatter-csv)
+ _records)
+ (concat (cl-call-next-method) "\n"))
+
+(defcustom ebdb-default-csv-formatter
+ (make-instance 'ebdb-formatter-csv :label "csv"
+ :fields '(mail-primary))
+ "Default CSV formatter."
+ :group 'ebdb)
;;; Basic export routines
diff --git a/ebdb-html.el b/ebdb-html.el
new file mode 100644
index 0000000..440b7c2
--- /dev/null
+++ b/ebdb-html.el
@@ -0,0 +1,100 @@
+;;; ebdb-html.el --- EBDB HTML integration -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2018 Free Software Foundation, Inc.
+
+;; Author: Eric Abrahamsen <e...@ericabrahamsen.net>
+;; Maintainer: Eric Abrahamsen <e...@ericabrahamsen.net>
+
+;; 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 code for "doing HTML things" with EBDB records.
+;; Right now that only means formatters for exporting EBDB records as
+;; HTML.
+
+;;; Code:
+
+(require 'ebdb-format)
+
+(defgroup ebdb-html nil
+ "Customization options for EBDB with HTML."
+ :group 'ebdb)
+
+(defclass ebdb-html-formatter (ebdb-formatter)
+ nil
+ :abstract t
+ :documentation "Formatter responsible for HTML-specific field
+ formatting.")
+
+(cl-defmethod ebdb-fmt-field ((_fmt ebdb-html-formatter)
+ (field ebdb-field-mail)
+ _style
+ (_rec ebdb-record))
+ (with-slots (mail aka) field
+ (format "<a href=\"mailto:%s\";>%s</a>" mail (or aka mail))))
+
+(defclass ebdb-html-formatter-tabular (ebdb-formatter-tabular
+ ebdb-html-formatter)
+ ;; We put the <tr> elements in manually.
+ ((record-separator :initform "")
+ (field-separator :initform "</td><td>")
+ (post-format-function :initform #'html-mode)))
+
+(defcustom ebdb-html-default-formatter-tabular
+ (make-instance 'ebdb-html-formatter-tabular
+ :label "html table"
+ :fields '(mail-primary))
+ "The default HTML table formatter.")
+
+(cl-defmethod ebdb-fmt-header ((fmt ebdb-html-formatter-tabular)
+ _records)
+ (with-slots (fields) fmt
+ (concat
+ "<table>\n<tr><th>Name</th><th>"
+ (mapconcat
+ (lambda (f)
+ (cond
+ ((stringp f) f)
+ ((or (class-p f)
+ (eieio-object-p f))
+ (ebdb-fmt-field-label fmt f 'normal))
+ ((symbolp f)
+ (symbol-name f))))
+ fields
+ "</th><th>")
+ "</th></tr>\n")))
+
+(cl-defmethod ebdb-fmt-footer ((fmt ebdb-html-formatter-tabular)
+ _records)
+ "\n</table>")
+
+(cl-defmethod ebdb-fmt-record ((_fmt ebdb-html-formatter-tabular)
+ (_rec ebdb-record))
+ "Wrap records in <tr> elements.
+This is done in lieu of a `record-separator' slot, since it's
+around each record, not between records."
+ (concat "<tr>"
+ (cl-call-next-method)
+ "</tr>"))
+
+(cl-defmethod ebdb-fmt-compose-fields :around ((_fmt
ebdb-html-formatter-tabular)
+ (_rec ebdb-record)
+ &optional _field-list _depth)
+ (concat "<td>"
+ (cl-call-next-method)
+ "</td>"))
+
+(provide 'ebdb-html)
+;;; ebdb-html.el ends here
diff --git a/ebdb-latex.el b/ebdb-latex.el
new file mode 100644
index 0000000..e4365ca
--- /dev/null
+++ b/ebdb-latex.el
@@ -0,0 +1,84 @@
+;;; ebdb-latex.el --- LaTex formatting routines for EBDB -*- lexical-binding:
t; -*-
+
+;; Copyright (C) 2018 Free Software Foundation, Inc.
+
+;; Author: Eric Abrahamsen <e...@ericabrahamsen.net>
+;; Maintainer: Eric Abrahamsen <e...@ericabrahamsen.net>
+
+;; 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 routines for formatting EBDB records as LaTeX.
+
+;;; Code:
+
+(require 'ebdb-format)
+
+(defgroup ebdb-latex nil
+ "Options for EBDB and LaTeX."
+ :group 'ebdb)
+
+(defclass ebdb-latex-formatter (ebdb-formatter)
+ ((post-format-function :initform #'latex-mode))
+ :abstract t
+ :documentation "")
+
+(cl-defmethod ebdb-fmt-field ((_fmt ebdb-latex-formatter)
+ (field ebdb-field-mail)
+ _style
+ (_rec ebdb-record))
+ (with-slots (mail aka) field
+ (format "\\href{mailto:%s}{%s}"; mail (or aka mail))))
+
+(defclass ebdb-latex-formatter-tabular (ebdb-latex-formatter
+ ebdb-formatter-tabular)
+ ((record-separator :initform " \\\\\n")
+ (field-separator :initform " & ")
+ (table-environment :initform "tabular")
+ (table-spec
+ :type (or string null)
+ :initarg :table-spec
+ :initform nil)))
+
+(cl-defmethod ebdb-fmt-field ((_fmt ebdb-latex-formatter-tabular)
+ (_field ebdb-field)
+ _style
+ (_rec ebdb-record))
+ "Escape column separators in field strings."
+ (replace-regexp-in-string "\\([^\\]\\)&" "\\1\\\\&"
+ (cl-call-next-method)))
+
+(cl-defmethod ebdb-fmt-header ((fmt ebdb-latex-formatter-tabular)
+ _recs)
+ (with-slots (table-environment table-spec) fmt
+ (concat (format "\\begin{%s}" table-environment)
+ (when table-spec
+ (format "%s" table-spec))
+ "\n")))
+
+(cl-defmethod ebdb-fmt-footer ((fmt ebdb-latex-formatter-tabular)
+ _recs)
+ (with-slots (table-environment) fmt
+ (format "\\end{%s}" table-environment)))
+
+(defcustom ebdb-latex-default-tabular-formatter
+ (make-instance 'ebdb-latex-formatter-tabular
+ :label "latex table"
+ :fields '(mail-primary))
+ "Default LaTeX tabular formatter."
+ :type 'ebdb-formatter-tabular)
+
+(provide 'ebdb-latex)
+;;; ebdb-latex.el ends here
diff --git a/ebdb-org.el b/ebdb-org.el
index 71ff087..b7c1b65 100644
--- a/ebdb-org.el
+++ b/ebdb-org.el
@@ -53,9 +53,14 @@
;;; Code:
(require 'ebdb-com)
+(require 'ebdb-format)
(require 'org)
(require 'org-agenda)
+(defgroup ebdb-org nil
+ "Custom group for EBDB Org options."
+ :group 'ebdb)
+
(if (fboundp 'org-link-set-parameters)
(org-link-set-parameters "ebdb"
:follow 'ebdb-org-open
@@ -66,8 +71,8 @@
:store 'ebdb-org-store-link
:export 'ebdb-org-export)
(with-no-warnings ;; I know it's obsolete.
- (org-add-link-type "ebdb" #'ebdb-org-open #'ebdb-org-export)
- (add-hook 'org-store-link-functions 'ebdb-org-store-link)))
+ (org-add-link-type "ebdb" #'ebdb-org-open #'ebdb-org-export)
+ (add-hook 'org-store-link-functions 'ebdb-org-store-link)))
;; TODO: Put a custom keymap on the links (or else expand
;; `ebdb-org-open') so that users can choose what to do with the
@@ -155,5 +160,53 @@ To do this automatically for every search, add this
function to
"Use a separate EBDB buffer for Org-related contacts."
(format "*%s-Org*" ebdb-buffer-name))
+;;; Formatters
+
+(defclass ebdb-org-formatter (ebdb-formatter)
+ ((post-format-function :initform #'org-mode))
+ :abstract t
+ :documentation "Formatter responsible for Org-specific field
+ formatting.")
+
+(cl-defmethod ebdb-fmt-field ((fmt ebdb-org-formatter)
+ (field ebdb-field-mail)
+ _style
+ (rec ebdb-record))
+ (concat "mailto:"; (cl-call-next-method)))
+
+(defun ebdb-org-table-post-format ()
+ "Align the formatted Org table."
+ (org-mode)
+ (goto-char (point-min))
+ (forward-char)
+ (org-table-align))
+
+(defclass ebdb-org-formatter-tabular (ebdb-formatter-tabular
+ ebdb-org-formatter)
+ ((record-separator :initform "\n")
+ (field-separator :initform " | ")
+ (post-format-function :initform #'ebdb-org-table-post-format)))
+
+(cl-defmethod ebdb-fmt-header :around ((fmt ebdb-org-formatter-tabular)
+ _records)
+ (concat "| "
+ (cl-call-next-method)
+ " |\n"
+ "|---|\n"))
+
+(cl-defmethod ebdb-fmt-compose-fields :around ((_fmt
ebdb-org-formatter-tabular)
+ (_rec ebdb-record)
+ &optional _field-list _depth)
+ (concat "| "
+ (cl-call-next-method)
+ " |"))
+
+(defcustom ebdb-org-default-tabular-formatter
+ (make-instance 'ebdb-org-formatter-tabular
+ :label "org table"
+ :fields '(mail-primary))
+ "Default Org table formatter."
+ :type 'ebdb-formatter-tabular)
+
(provide 'ebdb-org)
;;; ebdb-org.el ends here
