Function: org-agenda-get-blocks

org-agenda-get-blocks is a byte-compiled function defined in org-agenda.el.gz.

Signature

(org-agenda-get-blocks)

Documentation

Return the date-range information for agenda display.

Source Code

;; Defined in /usr/src/emacs/lisp/org/org-agenda.el.gz
(defun org-agenda-get-blocks ()
  "Return the date-range information for agenda display."
  (with-no-warnings (defvar date))
  (let* ((props (list 'org-not-done-regexp org-not-done-regexp
		      'org-todo-regexp org-todo-regexp
		      'org-complex-heading-regexp org-complex-heading-regexp
		      'mouse-face 'highlight
		      'help-echo
		      (format "mouse-2 or RET jump to org file %s"
			      (abbreviate-file-name buffer-file-name))))
	 (regexp (if org-agenda-include-inactive-timestamps
                     org-tr-regexp-both org-tr-regexp))
	 (d0 (calendar-absolute-from-gregorian date))
         face marker hdmarker ee txt d1 d2 s1 s2 category level
	 todo-state tags pos head donep inherited-tags effort
	 effort-minutes inactive?)
    (goto-char (point-min))
    (while (re-search-forward regexp nil t)
      (catch :skip
	(org-agenda-skip)
	(setq pos (point))
        (setq inactive? (eq ?\[ (char-after (match-beginning 0))))
	(let ((start-time (match-string 1))
	      (end-time (match-string 2)))
	  (setq s1 (match-string 1)
		s2 (match-string 2)
		d1 (time-to-days
		    (condition-case err
			(org-time-string-to-time s1)
		      (error
		       (error
			"Bad timestamp %S at %d in buffer %S\nError was: %s"
			s1
			pos
			(current-buffer)
			(error-message-string err)))))
		d2 (time-to-days
		    (condition-case err
			(org-time-string-to-time s2)
		      (error
		       (error
			"Bad timestamp %S at %d in buffer %S\nError was: %s"
			s2
			pos
			(current-buffer)
			(error-message-string err))))))
	  (when (and (> (- d0 d1) -1) (> (- d2 d0) -1))
	    ;; Only allow days between the limits, because the normal
	    ;; date stamps will catch the limits.
	    (save-excursion
	      (setq todo-state (org-get-todo-state))
	      (setq donep (member todo-state org-done-keywords))
	      (when (and donep org-agenda-skip-timestamp-if-done)
		(throw :skip t))
              (setq face (if (= d1 d2)
                             'org-agenda-calendar-event
                           'org-agenda-calendar-daterange))
	      (setq marker (org-agenda-new-marker (point))
		    category (org-get-category))
              (setq effort (save-match-data (or (get-text-property (point) 'effort)
                                                (org-entry-get (point) org-effort-property))))
              (setq effort-minutes (when effort (save-match-data (org-duration-to-minutes effort))))
	      (if (not (re-search-backward org-outline-regexp-bol nil t))
		  (throw :skip nil)
		(goto-char (match-beginning 0))
		(setq hdmarker (org-agenda-new-marker (point))
		      inherited-tags
		      (or (eq org-agenda-show-inherited-tags 'always)
			  (and (listp org-agenda-show-inherited-tags)
			       (memq 'agenda org-agenda-show-inherited-tags))
			  (and (eq org-agenda-show-inherited-tags t)
			       (or (eq org-agenda-use-tag-inheritance t)
				   (memq 'agenda org-agenda-use-tag-inheritance))))
		      tags (org-get-tags nil (not inherited-tags)))
		(setq level (make-string (org-reduced-level (org-outline-level)) ? ))
		(looking-at "\\*+[ \t]+\\(.*\\)")
		(setq head (match-string 1))
		(let ((remove-re
		       (if org-agenda-remove-timeranges-from-blocks
			   (concat
			    "<" (regexp-quote s1) ".*?>"
			    "--"
			    "<" (regexp-quote s2) ".*?>")
			 nil)))
		  (setq txt (org-agenda-format-item
                             (concat
                              (when inactive? org-agenda-inactive-leader)
			      (format
			       (nth (if (= d1 d2) 0 1)
				    org-agenda-timerange-leaders)
			       (1+ (- d0 d1)) (1+ (- d2 d1))))
			     (org-add-props head nil
                               'effort effort
                               'effort-minutes effort-minutes)
                             level category tags
			     (cond
                              ((and (= d1 d0) (= d2 d0))
			       (concat "<" start-time ">--<" end-time ">"))
                              ((= d1 d0)
			       (concat "<" start-time ">"))
			      ((= d2 d0)
			       (concat "<" end-time ">")))
			     remove-re))))
	      (org-add-props txt props
                'face face
		'org-marker marker 'org-hd-marker hdmarker
		'type "block" 'date date
		'level level
                'effort effort 'effort-minutes effort-minutes
		'todo-state todo-state
                'urgency (org-get-priority txt)
		'priority (org-get-priority txt))
	      (push txt ee))))
	(goto-char pos)))
    ;; Sort the entries by expiration date.
    (nreverse ee)))