Browse Source

Implement `org-at-planning-p'

* lisp/org.el (org-at-planning-p): New function.
* testing/lisp/test-org.el (test-org/at-planning-p): New test.
Nicolas Goaziou 10 years ago
parent
commit
f0a13a09d8
2 changed files with 166 additions and 123 deletions
  1. 15 1
      lisp/org.el
  2. 151 122
      testing/lisp/test-org.el

+ 15 - 1
lisp/org.el

@@ -13453,6 +13453,20 @@ nil."
 (defvar org-time-was-given) ; dynamically scoped parameter
 (defvar org-time-was-given) ; dynamically scoped parameter
 (defvar org-end-time-was-given) ; dynamically scoped parameter
 (defvar org-end-time-was-given) ; dynamically scoped parameter
 
 
+(defun org-at-planning-p ()
+  "Non-nil when point is on a planning info line."
+  ;; This is as accurate and faster than `org-element-at-point' since
+  ;; planning info location is fixed in the section.
+  (org-with-wide-buffer
+   (beginning-of-line)
+   (and (org-looking-at-p org-planning-line-re)
+	(eq (point)
+	    (ignore-errors
+	      (if (and (featurep 'org-inlinetask) (org-inlinetask-in-task-p))
+		  (org-back-to-heading t)
+		(org-with-limited-levels (org-back-to-heading t)))
+	      (line-beginning-position 2))))))
+
 (defun org-add-planning-info (what &optional time &rest remove)
 (defun org-add-planning-info (what &optional time &rest remove)
   "Insert new timestamp with keyword in the planning line.
   "Insert new timestamp with keyword in the planning line.
 WHAT indicates what kind of time stamp to add.  It is a symbol
 WHAT indicates what kind of time stamp to add.  It is a symbol
@@ -23370,7 +23384,7 @@ strictly within a source block, use appropriate comment syntax."
     (call-interactively 'comment-dwim)))
     (call-interactively 'comment-dwim)))
 
 
 
 
-;;; Planning
+;;; Timestamps API
 
 
 ;; This section contains tools to operate on timestamp objects, as
 ;; This section contains tools to operate on timestamp objects, as
 ;; returned by, e.g. `org-element-context'.
 ;; returned by, e.g. `org-element-context'.

+ 151 - 122
testing/lisp/test-org.el

@@ -2047,7 +2047,6 @@ Text.
       (mapcar (lambda (ov) (cons (overlay-start ov) (overlay-end ov)))
       (mapcar (lambda (ov) (cons (overlay-start ov) (overlay-end ov)))
 	      (overlays-in (point-min) (point-max)))))))
 	      (overlays-in (point-min) (point-max)))))))
 
 
-
 
 
 ;;; Outline structure
 ;;; Outline structure
 
 
@@ -2375,128 +2374,33 @@ Text.
 
 
 ;;; Planning
 ;;; 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."
+(ert-deftest test-org/at-planning-p ()
+  "Test `org-at-planning-p' specifications."
   ;; Regular test.
   ;; Regular test.
   (should
   (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)))))))
-
+   (org-test-with-temp-text "* Headline\n<point>DEADLINE: <2014-03-04 tue.>"
+     (org-at-planning-p)))
+  (should-not
+   (org-test-with-temp-text "DEADLINE: <2014-03-04 tue.>"
+     (org-at-planning-p)))
+  ;; Correctly find planning attached to inlinetasks.
+  (when (featurep 'org-inlinetask)
+    (should
+     (org-test-with-temp-text
+	 "*** Inlinetask\n<point>DEADLINE: <2014-03-04 tue.>\n*** END"
+       (let ((org-inlinetask-min-level 3)) (org-at-planning-p))))
+    (should-not
+     (org-test-with-temp-text
+	 "*** Inlinetask\n<point>DEADLINE: <2014-03-04 tue.>"
+       (let ((org-inlinetask-min-level 3)) (org-at-planning-p))))
+    (should-not
+     (org-test-with-temp-text
+	 "* Headline\n*** Inlinetask\n<point>DEADLINE: <2014-03-04 tue.>"
+       (let ((org-inlinetask-min-level 3)) (org-at-planning-p))))
+    (should-not
+     (org-test-with-temp-text
+	 "* Headline\n*** Inlinetask\n*** END\n<point>DEADLINE: <2014-03-04 tue.>"
+       (let ((org-inlinetask-min-level 3)) (org-at-planning-p))))))
 
 
 
 
 ;;; Property API
 ;;; Property API
@@ -2930,7 +2834,6 @@ Text.
 	 (insert "new")
 	 (insert "new")
 	 (org-element-type (org-element-context))))))
 	 (org-element-type (org-element-context))))))
 
 
-
 
 
 ;;; Sparse trees
 ;;; Sparse trees
 
 
@@ -3076,6 +2979,132 @@ Text.
      (search-forward "H2")
      (search-forward "H2")
      (org-invisible-p2))))
      (org-invisible-p2))))
 
 
+
+;;; Timestamps API
+
+(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)))))))
+
+
 
 
 ;;; Visibility
 ;;; Visibility