summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <n.goaziou@gmail.com>2012-11-23 18:41:58 +0100
committerNicolas Goaziou <n.goaziou@gmail.com>2012-11-23 18:41:58 +0100
commit0a142efddebd24e947c3d8666a73360f0f27249d (patch)
tree28919c076e7d0533faa4745f178b7c90b1e84ade
parentcb32494e246edf27b090ea54326f11f1a6e155f9 (diff)
downloadorg-mode-0a142efddebd24e947c3d8666a73360f0f27249d.tar.gz
org-export: Add tools for timestamps objects
* contrib/lisp/org-export.el (org-export-split-timestamp-range, org-export-translate-timestamp): New functions. * testing/lisp/test-org-export.el: Add tests.
-rw-r--r--contrib/lisp/org-export.el55
-rw-r--r--testing/lisp/test-org-export.el120
2 files changed, 174 insertions, 1 deletions
diff --git a/contrib/lisp/org-export.el b/contrib/lisp/org-export.el
index 5195bab..841eee0 100644
--- a/contrib/lisp/org-export.el
+++ b/contrib/lisp/org-export.el
@@ -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
;;
diff --git a/testing/lisp/test-org-export.el b/testing/lisp/test-org-export.el
index 18b0103..dc67059 100644
--- a/testing/lisp/test-org-export.el
+++ b/testing/lisp/test-org-export.el
@@ -598,7 +598,7 @@ body\n")))
-;;; 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")))))
+
;;; 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)))))))
+
;;; Topology