org-element: COMMENT and QUOTE keywords, ARCHIVE tags are case sensitive

* contrib/lisp/org-element.el (org-element-headline-parser): COMMENT and QUOTE keywords, ARCHIVE tags are case sensitive. * testing/contrib/lisp/test-org-element.el: New file.
2025-01-17 18:44:14 +00:00 · 2012-02-23 16:28:13 +01:00 · 2012-02-23 16:28:13 +01:00 · 8714fba308
commit 8714fba308
parent 675713c539
2 changed files with 120 additions and 7 deletions
--- a/contrib/lisp/org-element.el
+++ b/contrib/lisp/org-element.el
@ -322,15 +322,20 @@ Assume point is at beginning of the headline."
    (let* ((components (org-heading-components))
 	   (level (nth 1 components))
 	   (todo (nth 2 components))
-	   (todo-type (and todo
-			   (if (member todo org-done-keywords) 'done 'todo)))
+	   (todo-type
+	    (and todo (if (member todo org-done-keywords) 'done 'todo)))
 	   (tags (nth 5 components))
 	   (raw-value (nth 4 components))
-	   (quotedp (string-match (format "^%s +" org-quote-string) raw-value))
-	   (commentedp (string-match
-			(format "^%s +" org-comment-string) raw-value))
-	   (archivedp (and tags
-			   (string-match (format ":%s:" org-archive-tag) tags)))
+	   (quotedp
+	    (let ((case-fold-search nil))
+	      (string-match (format "^%s +" org-quote-string) raw-value)))
+	   (commentedp
+	    (let ((case-fold-search nil))
+	      (string-match (format "^%s +" org-comment-string) raw-value)))
+	   (archivedp
+	    (and tags
+		 (let ((case-fold-search nil))
+		   (string-match (format ":%s:" org-archive-tag) tags))))
 	   (footnote-section-p (and org-footnote-section
 				    (string= org-footnote-section raw-value)))
 	   (standard-props (let (plist)
--- a/testing/contrib/lisp/test-org-element.el
+++ b/testing/contrib/lisp/test-org-element.el
@ -0,0 +1,108 @@
+;;; test-org-element.el --- Tests for org-element.el
+
+;; Copyright (C) 2012  Nicolas Goaziou
+
+;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(let ((load-path (cons (expand-file-name
+			".." (file-name-directory
+			      (or load-file-name buffer-file-name)))
+		       load-path)))
+  (require 'org-test)
+  (require 'org-test-ob-consts)
+  (require 'org-element))
+
+
+
+;;; Tests:
+
+
+;;;; Headlines
+
+(ert-deftest test-org-element/headline-quote-keyword ()
+  "Test QUOTE keyword recognition."
+  ;; Reference test.
+  (org-test-with-temp-text "* Headline"
+    (let ((org-quote-string "QUOTE"))
+      (should-not (org-element-property :quotedp (org-element-at-point)))))
+  ;; Standard position.
+  (org-test-with-temp-text "* QUOTE Headline"
+    (let ((org-quote-string "QUOTE"))
+      (let ((headline (org-element-at-point)))
+	(should (org-element-property :quotedp headline))
+	;; Test removal from raw value.
+	(should (equal (org-element-property :raw-value headline) "Headline"))))
+    ;; Case sensitivity.
+    (let ((org-quote-string "Quote"))
+      (should-not (org-element-property :quotedp (org-element-at-point)))))
+  ;; With another keyword.
+  (org-test-with-temp-text "* TODO QUOTE Headline"
+    (let ((org-quote-string "QUOTE")
+	  (org-todo-keywords '((sequence "TODO" "DONE"))))
+      (should (org-element-property :quotedp (org-element-at-point))))))
+
+(ert-deftest test-org-element/headline-comment-keyword ()
+  "Test COMMENT keyword recognition."
+  ;; Reference test.
+  (org-test-with-temp-text "* Headline"
+    (let ((org-comment-string "COMMENT"))
+      (should-not (org-element-property :commentedp (org-element-at-point)))))
+  ;; Standard position.
+  (org-test-with-temp-text "* COMMENT Headline"
+    (let ((org-comment-string "COMMENT"))
+      (let ((headline (org-element-at-point)))
+	(should (org-element-property :commentedp headline))
+	;; Test removal from raw value.
+	(should (equal (org-element-property :raw-value headline) "Headline"))))
+    ;; Case sensitivity.
+    (let ((org-comment-string "Comment"))
+      (should-not (org-element-property :commentedp (org-element-at-point)))))
+  ;; With another keyword.
+  (org-test-with-temp-text "* TODO COMMENT Headline"
+    (let ((org-comment-string "COMMENT")
+	  (org-todo-keywords '((sequence "TODO" "DONE"))))
+      (should (org-element-property :commentedp (org-element-at-point))))))
+
+(ert-deftest test-org-element/headline-archive-tag ()
+  "Test ARCHIVE tag recognition."
+  ;; Reference test.
+  (org-test-with-temp-text "* Headline"
+    (let ((org-archive-tag "ARCHIVE"))
+      (should-not (org-element-property :archivedp (org-element-at-point)))))
+  ;; Single tag.
+  (org-test-with-temp-text "* Headline :ARCHIVE:"
+    (let ((org-archive-tag "ARCHIVE"))
+      (let ((headline (org-element-at-point)))
+	(should (org-element-property :archivedp headline))
+	;; Test tag removal.
+	(should-not (org-element-property :tags headline))))
+    (let ((org-archive-tag "Archive"))
+      (should-not (org-element-property :archivedp (org-element-at-point)))))
+  ;; Multiple tags.
+  (org-test-with-temp-text "* Headline :test:ARCHIVE:"
+    (let ((org-archive-tag "ARCHIVE"))
+      (let ((headline (org-element-at-point)))
+	(should (org-element-property :archivedp headline))
+	;; Test tag removal.
+	(should (equal (org-element-property :tags headline) ":test:"))))))
+
+
+(provide 'test-org-element)
+;;; test-org-element.el ends here