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))))
         ;; Group 1: starting date timestamp without braces
         ;; Group 2: ending date timestamp without braces
	 (regexp (if org-agenda-include-inactive-timestamps
                     org-tr-regexp-both org-tr-regexp))
	 (agenda-today (calendar-absolute-from-gregorian date))
         face marker hdmarker block-list txt start-day end-day
         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 start-day (time-to-days
                           (condition-case err
			       (org-time-string-to-time start-time)
                             (error
                              (error
			       "Bad timestamp %S at %d in buffer %S\nError was: %s"
			       start-time
			       pos
			       (current-buffer)
			       (error-message-string err)))))
		end-day (time-to-days
                         (condition-case err
			     (org-time-string-to-time end-time)
                           (error
                            (error
			     "Bad timestamp %S at %d in buffer %S\nError was: %s"
			     end-time
			     pos
                             (current-buffer)
			     (error-message-string err))))))
	  (when (and (> (- agenda-today start-day) -1)
                     (> (- end-day agenda-today) -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 (= start-day end-day)
                             '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 start-time) ".*?>"
			    "--"
			    "<" (regexp-quote end-time) ".*?>")
			 nil)))
                  ;; `org-agenda-format-item' automatically creates a
                  ;; time range when
                  ;; `org-agenda-default-appointment-duration' is
                  ;; non-nil and only start/end time is given.
                  ;; We do not want it here, when the range spans
                  ;; multiple days.
                  (let ((org-agenda-default-appointment-duration nil))
		    (setq txt (org-agenda-format-item
                               (concat
                                (when inactive? org-agenda-inactive-leader)
                                (format
                                 (nth (if (= start-day end-day) 0 1)
				      org-agenda-timerange-leaders)
                                 (1+ (- agenda-today start-day)) (1+ (- end-day start-day))))
			       (org-add-props head nil
                                 'effort effort
                                 'effort-minutes effort-minutes)
                               level category tags
			       (cond
                                ((and (= start-day agenda-today) (= end-day agenda-today))
                                 (concat "<" start-time ">--<" end-time ">"))
                                ((= start-day agenda-today)
                                 (concat "<" start-time ">"))
                                ((= end-day agenda-today)
                                 (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 block-list))))
	(goto-char pos)))
    ;; Sort the entries by expiration date.
    (nreverse block-list)))