org-export: Add tools for timestamps objects
authorNicolas Goaziou <n.goaziou@gmail.com>
Fri, 23 Nov 2012 17:41:58 +0000 (18:41 +0100)
committerNicolas Goaziou <n.goaziou@gmail.com>
Fri, 23 Nov 2012 17:41:58 +0000 (18:41 +0100)
* contrib/lisp/org-export.el (org-export-split-timestamp-range,
  org-export-translate-timestamp): New functions.
* testing/lisp/test-org-export.el: Add tests.

contrib/lisp/org-export.el
testing/lisp/test-org-export.el

index 5195bab..841eee0 100644 (file)
@@ -4314,6 +4314,61 @@ Universal Time."
                                    :year-start)))))
    utc))
 
+(defun org-export-split-timestamp-range (timestamp &optional end)
+  "Extract a timestamp object from a date or time range.
+
+TIMESTAMP is a timestamp object. END, when non-nil, means extract
+the end of the range.  Otherwise, extract its start.
+
+Return a new timestamp object sharing the same parent as
+TIMESTAMP."
+  (let ((type (org-element-property :type timestamp)))
+    (if (memq type '(active inactive diary)) timestamp
+      (let ((split-ts (list 'timestamp (copy-sequence (nth 1 timestamp)))))
+       ;; Set new type.
+       (org-element-put-property
+        split-ts :type (if (eq type 'active-range) 'active 'inactive))
+       ;; Copy start properties over end properties if END is
+       ;; non-nil.  Otherwise, copy end properties over `start' ones.
+       (let ((p-alist '((:minute-start . :minute-end)
+                        (:hour-start . :hour-end)
+                        (:day-start . :day-end)
+                        (:month-start . :month-end)
+                        (:year-start . :year-end))))
+         (dolist (p-cell p-alist)
+           (org-element-put-property
+            split-ts
+            (funcall (if end 'car 'cdr) p-cell)
+            (org-element-property
+             (funcall (if end 'cdr 'car) p-cell) split-ts)))
+         ;; Eventually refresh `:raw-value'.
+         (org-element-put-property split-ts :raw-value nil)
+         (org-element-put-property
+          split-ts :raw-value (org-element-interpret-data split-ts)))))))
+
+(defun org-export-translate-timestamp (timestamp &optional boundary)
+  "Apply `org-translate-time' on a TIMESTAMP object.
+When optional argument BOUNDARY is non-nil, it is either the
+symbol `start' or `end'.  In this case, only translate the
+starting or ending part of TIMESTAMP if it is a date or time
+range.  Otherwise, translate both parts."
+  (if (and (not boundary)
+          (memq (org-element-property :type timestamp)
+                '(active-range inactive-range)))
+      (concat
+       (org-translate-time
+       (org-element-property :raw-value
+                             (org-export-split-timestamp-range timestamp)))
+       "--"
+       (org-translate-time
+       (org-element-property :raw-value
+                             (org-export-split-timestamp-range timestamp t))))
+    (org-translate-time
+     (org-element-property
+      :raw-value
+      (if (not boundary) timestamp
+       (org-export-split-timestamp-range timestamp (eq boundary 'end)))))))
+
 
 ;;;; Smart Quotes
 ;;
index 18b0103..dc67059 100644 (file)
@@ -598,7 +598,7 @@ body\n")))
 
 
 \f
-;;; Back-end Definition
+;;; Back-End Tools
 
 (ert-deftest test-org-export/define-backend ()
   "Test back-end definition and accessors."
@@ -694,6 +694,28 @@ body\n")))
      (org-export-define-derived-backend test3 test2)
      (org-export-derived-backend-p 'test3 'test))))
 
+(ert-deftest test-org-export/with-backend ()
+  "Test `org-export-with-backend' definition."
+  ;; Error when calling an undefined back-end
+  (should-error
+   (let (org-export-registered-backends)
+     (org-export-with-backend 'test "Test")))
+  ;; Error when called back-end doesn't have an appropriate
+  ;; transcoder.
+  (should-error
+   (let (org-export-registered-backends)
+     (org-export-define-backend test ((headline . ignore)))
+     (org-export-with-backend 'test "Test")))
+  ;; Otherwise, export using correct transcoder
+  (should
+   (equal "Success"
+         (let (org-export-registered-backends)
+           (org-export-define-backend test
+             ((plain-text . (lambda (text contents info) "Failure"))))
+           (org-export-define-backend test2
+             ((plain-text . (lambda (text contents info) "Success"))))
+           (org-export-with-backend 'test2 "Test")))))
+
 
 \f
 ;;; Export Snippets
@@ -2049,6 +2071,102 @@ Another text. (ref:text)
     (org-test-with-temp-text "[2011-07-14 Thu]--[2012-03-29 Thu]"
       (org-export-format-timestamp (org-element-context) "%Y-%m-%d" t)))))
 
+(ert-deftest test-org-export/split-timestamp-range ()
+  "Test `org-export-split-timestamp-range' specifications."
+  ;; Extract range start (active).
+  (should
+   (equal '(2012 3 29)
+         (org-test-with-temp-text "<2012-03-29 Thu>--<2012-03-30 Fri>"
+           (let ((ts (org-export-split-timestamp-range (org-element-context))))
+             (mapcar (lambda (p) (org-element-property p ts))
+                     '(:year-end :month-end :day-end))))))
+  ;; Extract range start (inactive)
+  (should
+   (equal '(2012 3 29)
+         (org-test-with-temp-text "[2012-03-29 Thu]--[2012-03-30 Fri]"
+           (let ((ts (org-export-split-timestamp-range (org-element-context))))
+             (mapcar (lambda (p) (org-element-property p ts))
+                     '(:year-end :month-end :day-end))))))
+  ;; Extract range end (active).
+  (should
+   (equal '(2012 3 30)
+         (org-test-with-temp-text "<2012-03-29 Thu>--<2012-03-30 Fri>"
+           (let ((ts (org-export-split-timestamp-range
+                      (org-element-context) t)))
+             (mapcar (lambda (p) (org-element-property p ts))
+                     '(:year-end :month-end :day-end))))))
+  ;; Extract range end (inactive)
+  (should
+   (equal '(2012 3 30)
+         (org-test-with-temp-text "[2012-03-29 Thu]--[2012-03-30 Fri]"
+           (let ((ts (org-export-split-timestamp-range
+                      (org-element-context) t)))
+             (mapcar (lambda (p) (org-element-property p ts))
+                     '(:year-end :month-end :day-end))))))
+  ;; Return the timestamp if not a range.
+  (should
+   (org-test-with-temp-text "[2012-03-29 Thu]"
+     (let* ((ts-orig (org-element-context))
+           (ts-copy (org-export-split-timestamp-range ts-orig)))
+       (eq ts-orig ts-copy))))
+  (should
+   (org-test-with-temp-text "<%%(org-float t 4 2)>"
+     (let* ((ts-orig (org-element-context))
+           (ts-copy (org-export-split-timestamp-range ts-orig)))
+       (eq ts-orig ts-copy))))
+  ;; Check that parent is the same when a range was split.
+  (should
+   (org-test-with-temp-text "[2012-03-29 Thu]--[2012-03-30 Fri]"
+     (let* ((ts-orig (org-element-context))
+           (ts-copy (org-export-split-timestamp-range ts-orig)))
+       (eq (org-element-property :parent ts-orig)
+          (org-element-property :parent ts-copy))))))
+
+(ert-deftest test-org-export/translate-timestamp ()
+  "Test `org-export-translate-timestamp' specifications."
+  ;; Translate whole date range.
+  (should
+   (equal "<29>--<30>"
+         (org-test-with-temp-text "<2012-03-29 Thu>--<2012-03-30 Fri>"
+           (let ((org-display-custom-times t)
+                 (org-time-stamp-custom-formats '("<%d>" . "<%d>")))
+             (org-export-translate-timestamp (org-element-context))))))
+  ;; Translate date range start.
+  (should
+   (equal "<29>"
+         (org-test-with-temp-text "<2012-03-29 Thu>--<2012-03-30 Fri>"
+           (let ((org-display-custom-times t)
+                 (org-time-stamp-custom-formats '("<%d>" . "<%d>")))
+             (org-export-translate-timestamp (org-element-context) 'start)))))
+  ;; Translate date range end.
+  (should
+   (equal "<30>"
+         (org-test-with-temp-text "<2012-03-29 Thu>--<2012-03-30 Fri>"
+           (let ((org-display-custom-times t)
+                 (org-time-stamp-custom-formats '("<%d>" . "<%d>")))
+             (org-export-translate-timestamp (org-element-context) 'end)))))
+  ;; Translate time range.
+  (should
+   (equal "<08>--<16>"
+         (org-test-with-temp-text "<2012-03-29 Thu 8:30-16:40>"
+           (let ((org-display-custom-times t)
+                 (org-time-stamp-custom-formats '("<%d>" . "<%H>")))
+             (org-export-translate-timestamp (org-element-context))))))
+  ;; Translate non-range timestamp.
+  (should
+   (equal "<29>"
+         (org-test-with-temp-text "<2012-03-29 Thu>"
+           (let ((org-display-custom-times t)
+                 (org-time-stamp-custom-formats '("<%d>" . "<%d>")))
+             (org-export-translate-timestamp (org-element-context))))))
+  ;; Do not change `diary' timestamps.
+  (should
+   (equal "<%%(org-float t 4 2)>"
+         (org-test-with-temp-text "<%%(org-float t 4 2)>"
+           (let ((org-display-custom-times t)
+                 (org-time-stamp-custom-formats '("<%d>" . "<%d>")))
+             (org-export-translate-timestamp (org-element-context)))))))
+
 
 \f
 ;;; Topology