Browse Source

Rewrite `org-entry-properties'

* lisp/org.el (org-special-properties): Remove "CLOCK" as a special
  keyword.
(org-entry-properties): Rewrite function according to property drawer
syntax.  Change signature.
(org-entry-get): Apply signature change.

"CLOCK" removal is motivated by the fact that it isn't listed as
a special keyword in the manual, it is not used throughout the code
base, and there is no meaningful value for this property.
Nicolas Goaziou 10 years ago
parent
commit
8d8ad98382
1 changed files with 185 additions and 117 deletions
  1. 185 117
      lisp/org.el

+ 185 - 117
lisp/org.el

@@ -15305,15 +15305,12 @@ a *different* entry, you cannot use these techniques."
 		    (setq res (append res (org-scan-tags func matcher todo-only))))))))))
       res)))
 
-;;;; Properties
-
-;;; Setting and retrieving properties
+;;; Properties API
 
 (defconst org-special-properties
-  '("TODO" "TAGS" "ALLTAGS" "DEADLINE" "SCHEDULED" "CLOCK" "CLOSED" "PRIORITY"
+  '("TODO" "TAGS" "ALLTAGS" "DEADLINE" "SCHEDULED" "CLOSED" "PRIORITY"
     "TIMESTAMP" "TIMESTAMP_IA" "BLOCKED" "FILE" "CLOCKSUM" "CLOCKSUM_T")
   "The special properties valid in Org-mode.
-
 These are properties that are not defined in the property drawer,
 but in some other way.")
 
@@ -15446,118 +15443,189 @@ When INCREMENT is non-nil, set the property to the next allowed value."
       (org-clock-update-mode-line))
     (message "%s is now %s" prop val)))
 
-(defun org-entry-properties (&optional pom which specific)
-  "Get all properties of the entry at point-or-marker POM.
-This includes the TODO keyword, the tags, time strings for deadline,
-scheduled, and clocking, and any additional properties defined in the
-entry.  The return value is an alist, keys may occur multiple times
-if the property key was used several times.
-POM may also be nil, in which case the current entry is used.
+(defun org-entry-properties (&optional pom which)
+  "Get all properties of the current entry.
+
+When POM is a buffer position, get all properties from the entry
+there instead.
+
+This includes the TODO keyword, the tags, time strings for
+deadline, scheduled, and clocking, and any additional properties
+defined in the entry.
+
 If WHICH is nil or `all', get all properties.  If WHICH is
-`special' or `standard', only get that subclass.  If WHICH
-is a string only get exactly this property.  SPECIFIC can be a string, the
-specific property we are interested in.  Specifying it can speed
-things up because then unnecessary parsing is avoided."
-  (setq which (or which 'all))
-  (org-with-wide-buffer
-   (org-with-point-at pom
-     (let ((clockstr (substring org-clock-string 0 -1))
-	   (excluded '("TODO" "TAGS" "ALLTAGS" "PRIORITY" "BLOCKED"))
-	   (case-fold-search nil)
-	   beg end range props sum-props key key1 value string clocksum clocksumt)
-       (when (and (derived-mode-p 'org-mode)
-		  (ignore-errors (org-back-to-heading t)))
-	 (setq beg (point))
-	 (setq sum-props (get-text-property (point) 'org-summaries))
-	 (setq clocksum (get-text-property (point) :org-clock-minutes)
-	       clocksumt (get-text-property (point) :org-clock-minutes-today))
-	 (outline-next-heading)
-	 (setq end (point))
-	 (when (memq which '(all special))
-	   ;; Get the special properties, like TODO and tags
-	   (goto-char beg)
-	   (when (and (or (not specific) (string= specific "TODO"))
-		      (looking-at org-todo-line-regexp) (match-end 2))
-	     (push (cons "TODO" (org-match-string-no-properties 2)) props))
-	   (when (and (or (not specific) (string= specific "PRIORITY"))
-		      (looking-at org-priority-regexp))
-	     (push (cons "PRIORITY" (org-match-string-no-properties 2)) props))
-	   (when (or (not specific) (string= specific "FILE"))
-	     (push (cons "FILE" buffer-file-name) props))
-	   (when (and (or (not specific) (string= specific "TAGS"))
-		      (setq value (org-get-tags-string))
-		      (string-match "\\S-" value))
-	     (push (cons "TAGS" value) props))
-	   (when (and (or (not specific) (string= specific "ALLTAGS"))
-		      (setq value (org-get-tags-at)))
-	     (push (cons "ALLTAGS" (concat ":" (mapconcat 'identity value ":")
-					   ":"))
-		   props))
-	   (when (or (not specific) (string= specific "BLOCKED"))
-	     (push (cons "BLOCKED" (if (org-entry-blocked-p) "t" "")) props))
-	   (when (or (not specific)
-		     (member specific
-			     '("SCHEDULED" "DEADLINE" "CLOCK" "CLOSED"
-			       "TIMESTAMP" "TIMESTAMP_IA")))
-	     (catch 'match
-	       (while (and (re-search-forward org-maybe-keyword-time-regexp end t)
-			   (not (text-property-any 0 (length (match-string 0))
-						   'face 'font-lock-comment-face
-						   (match-string 0))))
-		 (setq key (if (match-end 1)
-			       (substring (org-match-string-no-properties 1)
-					  0 -1))
-		       string (if (equal key clockstr)
-				  (org-trim
-				   (buffer-substring-no-properties
-				    (match-beginning 3) (goto-char
-							 (point-at-eol))))
-				(substring (org-match-string-no-properties 3)
-					   1 -1)))
-		 ;; Get the correct property name from the key.  This is
-		 ;; necessary if the user has configured time keywords.
-		 (setq key1 (concat key ":"))
-		 (cond
-		  ((not key)
-		   (setq key
-			 (if (= (char-after (match-beginning 3)) ?\[)
-			     "TIMESTAMP_IA" "TIMESTAMP")))
-		  ((equal key1 org-scheduled-string) (setq key "SCHEDULED"))
-		  ((equal key1 org-deadline-string)  (setq key "DEADLINE"))
-		  ((equal key1 org-closed-string)    (setq key "CLOSED"))
-		  ((equal key1 org-clock-string)     (setq key "CLOCK")))
-		 (if (and specific (equal key specific) (not (equal key "CLOCK")))
-		     (progn
-		       (push (cons key string) props)
-		       ;; no need to search further if match is found
-		       (throw 'match t))
-		   (when (or (equal key "CLOCK") (not (assoc key props)))
-		     (push (cons key string) props)))))))
-
-	 (when (memq which '(all standard))
-	   ;; Get the standard properties, like :PROP: ...
-	   (setq range (org-get-property-block beg))
-	   (when range
-	     (goto-char (car range))
-	     (while (re-search-forward org-property-re
-				       (cdr range) t)
-	       (setq key (org-match-string-no-properties 2)
-		     value (org-trim (or (org-match-string-no-properties 3) "")))
-	       (unless (member key excluded)
-		 (push (cons key (or value "")) props)))))
-	 (if clocksum
-	     (push (cons "CLOCKSUM"
-			 (org-columns-number-to-string (/ (float clocksum) 60.)
-						       'add_times))
-		   props))
-	 (if clocksumt
-	     (push (cons "CLOCKSUM_T"
-			 (org-columns-number-to-string (/ (float clocksumt) 60.)
-						       'add_times))
-		   props))
-	 (unless (assoc "CATEGORY" props)
-	   (push (cons "CATEGORY" (org-get-category)) props))
-	 (append sum-props (nreverse props)))))))
+`special' or `standard', only get that subclass.  If WHICH is
+a string, only get that property.
+
+Return value is an alist.  Keys are properties, as upcased
+strings."
+  (org-with-point-at pom
+    (when (and (derived-mode-p 'org-mode)
+	       (ignore-errors (org-back-to-heading t)))
+      (catch 'exit
+	(let* ((beg (point))
+	       (specific (and (stringp which) (upcase which)))
+	       (which (cond ((not specific) which)
+			    ((member specific org-special-properties) 'special)
+			    (t 'standard)))
+	       props)
+	  ;; Get the special properties, like TODO and TAGS.
+	  (when (memq which '(nil all special))
+	    (when (or (not specific) (string= specific "CLOCKSUM"))
+	      (let ((clocksum (get-text-property (point) :org-clock-minutes)))
+		(when clocksum
+		  (push (cons "CLOCKSUM"
+			      (org-columns-number-to-string
+			       (/ (float clocksum) 60.) 'add_times))
+			props)))
+	      (when specific (throw 'exit props)))
+	    (when (or (not specific) (string= specific "CLOCKSUM_T"))
+	      (let ((clocksumt (get-text-property (point)
+						  :org-clock-minutes-today)))
+		(when clocksumt
+		  (push (cons "CLOCKSUM_T"
+			      (org-columns-number-to-string
+			       (/ (float clocksumt) 60.) 'add_times))
+			props)))
+	      (when specific (throw 'exit props)))
+	    (when (or (not specific) (string= specific "TODO"))
+	      (when (and (looking-at org-todo-line-regexp) (match-end 2))
+		(push (cons "TODO" (org-match-string-no-properties 2)) props))
+	      (when specific (throw 'exit props)))
+	    (when (or (not specific) (string= specific "PRIORITY"))
+	      (when (looking-at org-priority-regexp)
+		(push (cons "PRIORITY" (org-match-string-no-properties 2)) props))
+	      (when specific (throw 'exit props)))
+	    (when (or (not specific) (string= specific "FILE"))
+	      (push (cons "FILE" (buffer-file-name (buffer-base-buffer)))
+		    props)
+	      (when specific (throw 'exit props)))
+	    (when (or (not specific) (string= specific "TAGS"))
+	      (let ((value (org-string-nw-p (org-get-tags-string))))
+		(when value (push (cons "TAGS" value) props)))
+	      (when specific (throw 'exit props)))
+	    (when (or (not specific) (string= specific "ALLTAGS"))
+	      (let ((value (org-get-tags-at)))
+		(when value
+		  (push (cons "ALLTAGS"
+			      (format ":%s:" (mapconcat #'identity value ":")))
+			props)))
+	      (when specific (throw 'exit props)))
+	    (when (or (not specific) (string= specific "BLOCKED"))
+	      (push (cons "BLOCKED" (if (org-entry-blocked-p) "t" "")) props)
+	      (when specific (throw 'exit props)))
+	    (when (or (not specific)
+		      (member specific '("CLOSED" "DEADLINE" "SCHEDULED")))
+	      (forward-line)
+	      (when (org-looking-at-p org-planning-line-re)
+		(end-of-line)
+		(let ((bol (line-beginning-position)))
+		  ;; Backward compatibility: time keywords used to be
+		  ;; configurable (before 8.3).  Make sure we get the
+		  ;; correct keyword.
+		  (dolist (k (if (not specific)
+				 (list org-closed-string
+				       org-deadline-string
+				       org-scheduled-string)
+			       (list (cond ((string= specific "CLOSED")
+					    org-closed-string)
+					   ((string= specific "DEADLINE")
+					    org-deadline-string)
+					   (t org-scheduled-string)))))
+		    (save-excursion
+		      (when (search-backward k bol t)
+			(goto-char (match-end 0))
+			(skip-chars-forward " \t")
+			(and (looking-at org-ts-regexp-both)
+			     (push (cons specific (match-string 0)) props)))))))
+	      (when specific (throw 'exit props)))
+	    (when (or (not specific)
+		      (member specific '("TIMESTAMP" "TIMESTAMP_IA")))
+	      (let ((find-ts
+		     (lambda (end ts)
+		       (let ((regexp (if (or (string= specific "TIMESTAMP")
+					     (assoc "TIMESTAMP_IA" ts))
+					 org-ts-regexp
+				       org-ts-regexp-both)))
+			 (catch 'next
+			   (while (re-search-forward regexp end t)
+			     (backward-char)
+			     (let ((object (org-element-context)))
+			       ;; Accept to match timestamps in node
+			       ;; properties, too.
+			       (when (memq (org-element-type object)
+					   '(node-property timestamp))
+				 (let ((type
+					(org-element-property :type object)))
+				   (cond
+				    ((and (memq type '(active active-range))
+					  (not (equal specific "TIMESTAMP_IA")))
+				     (unless (assoc "TIMESTAMP" ts)
+				       (push (cons "TIMESTAMP"
+						   (org-element-property
+						    :raw-value object))
+					     ts)
+				       (when specific (throw 'exit ts))))
+				    ((and (memq type '(inactive inactive-range))
+					  (not (string= specific "TIMESTAMP")))
+				     (unless (assoc "TIMESTAMP_IA" ts)
+				       (push (cons "TIMESTAMP_IA"
+						   (org-element-property
+						    :raw-value object))
+					     ts)
+				       (when specific (throw 'exit ts))))))
+				 ;; Both timestamp types are found,
+				 ;; move to next part.
+				 (when (= (length ts) 2) (throw 'next ts)))))
+			   ts)))))
+		(goto-char beg)
+		;; First look for timestamps within headline.
+		(let ((ts (funcall find-ts (line-end-position) nil)))
+		  (if (= (length ts) 2) (setq props (nconc ts props))
+		    (forward-line)
+		    ;; Then find timestamps in the section, skipping
+		    ;; planning line.
+		    (when (org-looking-at-p org-planning-line-re)
+		      (forward-line))
+		    (let ((end (save-excursion (outline-next-heading))))
+		      (setq props (nconc (funcall find-ts end ts) props))))))))
+	  ;; Get the standard properties, like :PROP:.
+	  (when (memq which '(nil all standard))
+	    ;; If we are looking after a specific property, delegate
+	    ;; to `org-entry-get', which is faster.  However, make an
+	    ;; exception for "CATEGORY", since it can be also set
+	    ;; through keywords (i.e. #+CATEGORY).
+	    (if (and specific (not (equal specific "CATEGORY")))
+		(let ((value (org-entry-get beg specific nil t)))
+		  (throw 'exit (and value (list (cons specific value)))))
+	      (let ((range (org-get-property-block beg)))
+		(when range
+		  (let ((end (cdr range)) seen-base)
+		    (goto-char (car range))
+		    ;; Unlike to `org--update-property-plist', we
+		    ;; handle the case where base values is found
+		    ;; after its extension.  We also forbid standard
+		    ;; properties to be named as special properties.
+		    (while (re-search-forward org-property-re end t)
+		      (let* ((key (upcase (org-match-string-no-properties 2)))
+			     (extendp (org-string-match-p "\\+\\'" key))
+			     (key-base (if extendp (substring key 0 -1) key))
+			     (value (org-match-string-no-properties 3)))
+			(cond
+			 ((member-ignore-case key-base org-special-properties))
+			 (extendp
+			  (setq props
+				(org--update-property-plist key value props)))
+			 ((member key seen-base))
+			 (t (push key seen-base)
+			    (let ((p (assoc-string key props t)))
+			      (if p (setcdr p (concat value " " (cdr p)))
+				(push (cons key value) props))))))))))))
+	  (unless (assoc "CATEGORY" props)
+	    (push (cons "CATEGORY" (org-get-category)) props)
+	    (when (string= specific "CATEGORY") (throw 'exit props)))
+	  ;; Return value.
+	  (append (get-text-property beg 'org-summaries) props))))))
 
 (defun org-entry-get (pom property &optional inherit literal-nil)
   "Get value of PROPERTY for entry or content at point-or-marker POM.
@@ -15584,7 +15652,7 @@ value higher up the hierarchy."
      ((member-ignore-case property org-special-properties)
       ;; We need a special property.  Use `org-entry-properties' to
       ;; retrieve it, but specify the wanted property.
-      (cdr (assoc-string property (org-entry-properties nil 'special property))))
+      (cdr (assoc-string property (org-entry-properties nil property))))
      (t
       (let ((range (org-get-property-block)))
 	(when range