diff --git a/contrib/lisp/org-e-ascii.el b/contrib/lisp/org-e-ascii.el index 4499de581..7bfc4c2c9 100644 --- a/contrib/lisp/org-e-ascii.el +++ b/contrib/lisp/org-e-ascii.el @@ -1706,7 +1706,7 @@ a communication channel." (defun org-e-ascii-timestamp (timestamp contents info) "Transcode a TIMESTAMP object from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." - (org-e-ascii-plain-text (org-export-translate-timestamp timestamp) info)) + (org-e-ascii-plain-text (org-timestamp-translate timestamp) info)) ;;;; Underline diff --git a/contrib/lisp/org-e-groff.el b/contrib/lisp/org-e-groff.el index e91de3427..c7fbeaca1 100644 --- a/contrib/lisp/org-e-groff.el +++ b/contrib/lisp/org-e-groff.el @@ -1852,7 +1852,7 @@ information." CONTENTS is nil. INFO is a plist holding contextual information." (let ((value (org-e-groff-plain-text - (org-export-translate-timestamp timestamp) info))) + (org-timestamp-translate timestamp) info))) (case (org-element-property :type timestamp) ((active active-range) (format org-e-groff-active-timestamp-format value)) diff --git a/contrib/lisp/org-e-html.el b/contrib/lisp/org-e-html.el index 7a37d2915..ab46e2a0b 100644 --- a/contrib/lisp/org-e-html.el +++ b/contrib/lisp/org-e-html.el @@ -2684,7 +2684,7 @@ information." CONTENTS is nil. INFO is a plist holding contextual information." (let ((value (org-e-html-plain-text - (org-export-translate-timestamp timestamp) info))) + (org-timestamp-translate timestamp) info))) (format "%s" (replace-regexp-in-string "--" "–" value)))) diff --git a/contrib/lisp/org-e-latex.el b/contrib/lisp/org-e-latex.el index 7d165d300..6ac8e86bd 100644 --- a/contrib/lisp/org-e-latex.el +++ b/contrib/lisp/org-e-latex.el @@ -2597,7 +2597,7 @@ information." CONTENTS is nil. INFO is a plist holding contextual information." (let ((value (org-e-latex-plain-text - (org-export-translate-timestamp timestamp) info))) + (org-timestamp-translate timestamp) info))) (case (org-element-property :type timestamp) ((active active-range) (format org-e-latex-active-timestamp-format value)) ((inactive inactive-range) diff --git a/contrib/lisp/org-e-odt.el b/contrib/lisp/org-e-odt.el index ded4b0286..7ba2d9d87 100644 --- a/contrib/lisp/org-e-odt.el +++ b/contrib/lisp/org-e-odt.el @@ -909,10 +909,10 @@ See `org-e-odt--build-date-styles' for implementation details." (let* ((format-timestamp (lambda (timestamp format &optional end utc) (if timestamp - (org-export-format-timestamp timestamp format end utc) + (org-timestamp-format timestamp format end utc) (format-time-string format nil utc)))) (has-time-p (or (not timestamp) - (org-export-timestamp-has-time-p timestamp))) + (org-timestamp-has-time-p timestamp))) (iso-date (let ((format (if has-time-p "%Y-%m-%dT%H:%M:%S" "%Y-%m-%dT%H:%M:%S"))) (funcall format-timestamp timestamp format end)))) @@ -3632,7 +3632,7 @@ channel." (type (org-element-property :type timestamp))) (if (not org-e-odt-use-date-fields) (let ((value (org-e-odt-plain-text - (org-export-translate-timestamp timestamp) info))) + (org-timestamp-translate timestamp) info))) (case (org-element-property :type timestamp) ((active active-range) (format "%s" @@ -3665,8 +3665,8 @@ channel." (otherwise (format "%s" "OrgDiaryTimestamp" - (org-e-odt-plain-text (org-export-translate-timestamp - timestamp) info))))))) + (org-e-odt-plain-text (org-timestamp-translate timestamp) + info))))))) ;;;; Underline diff --git a/contrib/lisp/org-e-texinfo.el b/contrib/lisp/org-e-texinfo.el index 52d7e969e..a14998ce4 100644 --- a/contrib/lisp/org-e-texinfo.el +++ b/contrib/lisp/org-e-texinfo.el @@ -1623,7 +1623,7 @@ information." CONTENTS is nil. INFO is a plist holding contextual information." (let ((value (org-e-texinfo-plain-text - (org-export-translate-timestamp timestamp) info))) + (org-timestamp-translate timestamp) info))) (case (org-element-property :type timestamp) ((active active-range) (format org-e-texinfo-active-timestamp-format value)) diff --git a/contrib/lisp/org-export.el b/contrib/lisp/org-export.el index 5b71ef42d..067abe10d 100644 --- a/contrib/lisp/org-export.el +++ b/contrib/lisp/org-export.el @@ -4433,96 +4433,6 @@ Return a list of src-block elements with a caption." (org-export-collect-elements 'src-block info)) -;;;; For Timestamps -;; -;; `org-export-timestamp-has-time-p' is a predicate to know if hours -;; and minutes are defined in a given timestamp. -;; -;; `org-export-format-timestamp' allows to format a timestamp object -;; with an arbitrary format string. - -(defun org-export-timestamp-has-time-p (timestamp) - "Non-nil when TIMESTAMP has a time specified." - (org-element-property :hour-start timestamp)) - -(defun org-export-format-timestamp (timestamp format &optional end utc) - "Format a TIMESTAMP element into a string. - -FORMAT is a format specifier to be passed to -`format-time-string'. - -When optional argument END is non-nil, use end of date-range or -time-range, if possible. - -When optional argument UTC is non-nil, time will be expressed as -Universal Time." - (format-time-string - format - (apply 'encode-time - (cons 0 - (mapcar - (lambda (prop) (or (org-element-property prop timestamp) 0)) - (if end '(:minute-end :hour-end :day-end :month-end :year-end) - '(:minute-start :hour-start :day-start :month-start - :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 ;; ;; The main function for the smart quotes sub-system is diff --git a/lisp/org.el b/lisp/org.el index 83954e436..03ab52a91 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -21864,6 +21864,94 @@ contains commented lines. Otherwise, comment them." (forward-line)))))))) +;;; Planning + +;; This section contains tools to operate on timestamp objects, as +;; returned by, e.g. `org-element-context'. + +(defun org-timestamp-has-time-p (timestamp) + "Non-nil when TIMESTAMP has a time specified." + (org-element-property :hour-start timestamp)) + +(defun org-timestamp-format (timestamp format &optional end utc) + "Format a TIMESTAMP element into a string. + +FORMAT is a format specifier to be passed to +`format-time-string'. + +When optional argument END is non-nil, use end of date-range or +time-range, if possible. + +When optional argument UTC is non-nil, time will be expressed as +Universal Time." + (format-time-string + format + (apply 'encode-time + (cons 0 + (mapcar + (lambda (prop) (or (org-element-property prop timestamp) 0)) + (if end '(:minute-end :hour-end :day-end :month-end :year-end) + '(:minute-start :hour-start :day-start :month-start + :year-start))))) + utc)) + +(defun org-timestamp-split-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-timestamp-translate (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-timestamp-split-range timestamp))) + "--" + (org-translate-time + (org-element-property :raw-value + (org-timestamp-split-range timestamp t)))) + (org-translate-time + (org-element-property + :raw-value + (if (not boundary) timestamp + (org-timestamp-split-range timestamp (eq boundary 'end))))))) + + + ;;; Other stuff. (defun org-toggle-fixed-width-section (arg) diff --git a/testing/lisp/test-org-export.el b/testing/lisp/test-org-export.el index f4ac5a3bd..1152940db 100644 --- a/testing/lisp/test-org-export.el +++ b/testing/lisp/test-org-export.el @@ -2078,132 +2078,6 @@ Another text. (ref:text) info)))) - -;;; Timestamps - -(ert-deftest test-org-export/timestamp-has-time-p () - "Test `org-export-timestamp-has-time-p' specifications." - ;; With time. - (should - (org-test-with-temp-text "<2012-03-29 Thu 16:40>" - (org-export-timestamp-has-time-p (org-element-context)))) - ;; Without time. - (should-not - (org-test-with-temp-text "<2012-03-29 Thu>" - (org-export-timestamp-has-time-p (org-element-context))))) - -(ert-deftest test-org-export/format-timestamp () - "Test `org-export-format-timestamp' specifications." - ;; Regular test. - (should - (equal - "2012-03-29 16:40" - (org-test-with-temp-text "<2012-03-29 Thu 16:40>" - (org-export-format-timestamp (org-element-context) "%Y-%m-%d %R")))) - ;; Range end. - (should - (equal - "2012-03-29" - (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 diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el index 10fedd701..fed688245 100644 --- a/testing/lisp/test-org.el +++ b/testing/lisp/test-org.el @@ -892,6 +892,132 @@ Text. (overlays-in (point-min) (point-max))))))) + +;;; Planning + +(ert-deftest test-org/timestamp-has-time-p () + "Test `org-timestamp-has-time-p' specifications." + ;; With time. + (should + (org-test-with-temp-text "<2012-03-29 Thu 16:40>" + (org-timestamp-has-time-p (org-element-context)))) + ;; Without time. + (should-not + (org-test-with-temp-text "<2012-03-29 Thu>" + (org-timestamp-has-time-p (org-element-context))))) + +(ert-deftest test-org/timestamp-format () + "Test `org-timestamp-format' specifications." + ;; Regular test. + (should + (equal + "2012-03-29 16:40" + (org-test-with-temp-text "<2012-03-29 Thu 16:40>" + (org-timestamp-format (org-element-context) "%Y-%m-%d %R")))) + ;; Range end. + (should + (equal + "2012-03-29" + (org-test-with-temp-text "[2011-07-14 Thu]--[2012-03-29 Thu]" + (org-timestamp-format (org-element-context) "%Y-%m-%d" t))))) + +(ert-deftest test-org/timestamp-split-range () + "Test `org-timestamp-split-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-timestamp-split-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-timestamp-split-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-timestamp-split-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-timestamp-split-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-timestamp-split-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-timestamp-split-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-timestamp-split-range ts-orig))) + (eq (org-element-property :parent ts-orig) + (org-element-property :parent ts-copy)))))) + +(ert-deftest test-org/timestamp-translate () + "Test `org-timestamp-translate' 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-timestamp-translate (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-timestamp-translate (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-timestamp-translate (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-timestamp-translate (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-timestamp-translate (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-timestamp-translate (org-element-context))))))) + + ;;; Targets and Radio Targets