Function: org-agenda-highlight-todo

org-agenda-highlight-todo is a byte-compiled function defined in org-agenda.el.gz.

Signature

(org-agenda-highlight-todo X)

Source Code

;; Defined in /usr/src/emacs/lisp/org/org-agenda.el.gz
(defun org-agenda-highlight-todo (x)
  (let ((org-done-keywords org-done-keywords-for-agenda)
	(case-fold-search nil)
	re)
    (if (eq x 'line)
	(save-excursion
	  (forward-line 0)
	  (setq re (org-get-at-bol 'org-todo-regexp))
          (goto-char (or (text-property-any (line-beginning-position)
                                            (line-end-position)
                                            'org-heading t)
                         (point)))
	  (when (looking-at (concat "[ \t]*\\.*\\(" re "\\) +"))
	    (add-text-properties (match-beginning 0) (match-end 1)
				 (list 'face (org-get-todo-face 1)))
	    (let ((s (buffer-substring (match-beginning 1) (match-end 1))))
	      (delete-region (match-beginning 1) (1- (match-end 0)))
	      (goto-char (match-beginning 1))
	      (insert (format org-agenda-todo-keyword-format s)))))
      (let ((pl (text-property-any 0 (length x) 'org-heading t x)))
	(setq re (get-text-property 0 'org-todo-regexp x))
	(when (and re
		   ;; Test `pl' because if there's no heading content,
		   ;; there's no point matching to highlight.  Note
		   ;; that if we didn't test `pl' first, and there
		   ;; happened to be no keyword from `org-todo-regexp'
		   ;; on this heading line, then the `equal' comparison
		   ;; afterwards would spuriously succeed in the case
		   ;; where `pl' is nil -- causing an args-out-of-range
		   ;; error when we try to add text properties to text
		   ;; that isn't there.
		   pl
		   (equal (string-match (concat "\\(\\.*\\)" re "\\( +\\)")
					x pl)
			  pl))
	  (add-text-properties
	   (or (match-end 1) (match-end 0)) (match-end 0)
	   (list 'face (org-get-todo-face (match-string 2 x)))
	   x)
	  (when (match-end 1)
	    (setq x
		  (concat
		   (substring x 0 (match-end 1))
                   (unless (string= org-agenda-todo-keyword-format "")
                     (format org-agenda-todo-keyword-format
                             (match-string 2 x)))
                   (unless (string= org-agenda-todo-keyword-format "")
                     ;; Remove `display' property as the icon could leak
                     ;; on the white space.
                     (apply #'propertize " " (org-plist-delete (text-properties-at 0 x) 'display)))
                   (substring x (match-end 3)))))))
      x)))