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 'face nil
		      '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 org-tr-regexp)
	 (d0 (calendar-absolute-from-gregorian date))
	 marker hdmarker ee txt d1 d2 s1 s2 category
	 level todo-state tags pos head donep inherited-tags
         effort effort-minutes)
    (goto-char (point-min))
    (while (re-search-forward regexp nil t)
      (catch :skip
	(org-agenda-skip)
	(setq pos (point))
	(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 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
			     (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
			     (save-match-data
			       (let ((hhmm1 (and (string-match org-ts-regexp1 s1)
						 (match-string 6 s1)))
				     (hhmm2 (and (string-match org-ts-regexp1 s2)
						 (match-string 6 s2))))
				 (cond ((string= hhmm1 hhmm2)
					(concat "<" start-time ">--<" end-time ">"))
				       ((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
		'org-marker marker 'org-hd-marker hdmarker
		'type "block" 'date date
		'level level
                'effort effort 'effort-minutes effort-minutes
		'todo-state todo-state
		'priority (org-get-priority txt))
	      (push txt ee))))
	(goto-char pos)))
    ;; Sort the entries by expiration date.
    (nreverse ee)))