[elpa] externals/ebdb eec63c8 07/13: Provide basic HTML5 freeform formatter

[Eric Abrahamsen]

branch: externals/ebdb
commit eec63c8b39fb0d7d57391fcc1d82c3dd1d3c001c
Author: Eric Abrahamsen <address@hidden>
Commit: Eric Abrahamsen <address@hidden>

    Provide basic HTML5 freeform formatter
    
    * ebdb-html.el (ebdb-html-formatter-html5): New class, uses definition
      lists for field instances.
      (ebdb-html-default-formatter-html5): New option.
---
 ebdb-html.el | 68 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 65 insertions(+), 3 deletions(-)

diff --git a/ebdb-html.el b/ebdb-html.el
index 440b7c2..6a85ef1 100644
--- a/ebdb-html.el
+++ b/ebdb-html.el
@@ -33,11 +33,68 @@
   :group 'ebdb)
 
 (defclass ebdb-html-formatter (ebdb-formatter)
-  nil
+  ((post-format-function :initform #'html-mode))
   :abstract t
   :documentation "Formatter responsible for HTML-specific field
   formatting.")
 
+(defclass ebdb-html-formatter-html5 (ebdb-html-formatter
+                                    ebdb-formatter-freeform)
+  ((header :initform '((ebdb-record-person ebdb-field-notes))))
+  :documentation "HTML formatter for \"block-style\" HTML
+  formatting.")
+
+(cl-defmethod ebdb-fmt-record :around ((_fmt ebdb-html-formatter-html5)
+                                      (rec ebdb-record))
+  (concat
+   "<article class=\"ebdb-record\">\n"
+   (cl-call-next-method)
+   "\n</article>\n"))
+
+(cl-defmethod ebdb-fmt-record-header ((fmt ebdb-html-formatter-html5)
+                                     (rec ebdb-record)
+                                     header-fields)
+  (concat
+   "<header>\n"
+   (format "<h1>%s</h1>\n" (ebdb-record-name rec))
+   (mapconcat
+    (pcase-lambda ((map style inst class))
+      (format "<p>%s</p>" (mapconcat (lambda (f) (ebdb-fmt-field fmt f style 
rec)) inst ", ")))
+    header-fields
+    "\n")
+   "</header>\n"))
+
+(cl-defmethod ebdb-fmt-compose-fields ((fmt ebdb-html-formatter-html5)
+                                      (rec ebdb-record)
+                                      &optional field-list _depth)
+  (when field-list
+    (let ((field-pairs
+          (mapcar
+           (pcase-lambda ((map style inst class))
+             ;; Field labels,
+             (cons (ebdb-fmt-field-label
+                    fmt
+                    (if (= 1 (length inst))
+                        (car inst)
+                      class)
+                    style
+                    rec)
+                   ;; and fields.
+                   (mapconcat
+                    #'identity
+                    (mapcar (lambda (f)
+                              (ebdb-fmt-field fmt f style rec))
+                            inst)
+                    ", ")))
+           field-list)))
+      (concat
+       "<dl>\n"
+       (mapconcat
+       (pcase-lambda (`(,label . ,field))
+         (format "<dt>%s</dt><dd>%s</dd>" label field))
+       field-pairs "\n")
+       "</dl>\n"))))
+
 (cl-defmethod ebdb-fmt-field ((_fmt ebdb-html-formatter)
                              (field ebdb-field-mail)
                              _style
@@ -49,8 +106,7 @@
                                       ebdb-html-formatter)
   ;; We put the <tr> elements in manually.
   ((record-separator :initform "")
-   (field-separator :initform "</td><td>")
-   (post-format-function :initform #'html-mode)))
+   (field-separator :initform "</td><td>")))
 
 (defcustom ebdb-html-default-formatter-tabular
   (make-instance 'ebdb-html-formatter-tabular
@@ -58,6 +114,12 @@
                 :fields '(mail-primary))
   "The default HTML table formatter.")
 
+(defcustom ebdb-html-default-formatter-html5
+  (make-instance 'ebdb-html-formatter-html5
+                :label "html5 block"
+                :include '(mail-primary ebdb-field-phone ebdb-field-address 
ebdb-field-notes))
+  "The default HTML5 block formatter.")
+
 (cl-defmethod ebdb-fmt-header ((fmt ebdb-html-formatter-tabular)
                               _records)
   (with-slots (fields) fmt