Function: org-agenda-get-sexps

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

Signature

(org-agenda-get-sexps)

Documentation

Return the sexp information for agenda display.

Source Code

;; Defined in /usr/src/emacs/lisp/org/org-agenda.el.gz
(defun org-agenda-get-sexps ()
  "Return the sexp information for agenda display."
  (require 'diary-lib)
  (with-no-warnings (defvar date) (defvar entry))
  (let* ((props (list 'face 'org-agenda-calendar-sexp
		      'mouse-face 'highlight
		      'help-echo
		      (format "mouse-2 or RET jump to org file %s"
			      (abbreviate-file-name buffer-file-name))))
	 (regexp "^&?%%(")
	 ;; FIXME: Is this `entry' binding intended to be dynamic,
         ;; so as to "hide" any current binding for it?
	 marker category extra level ee txt tags entry
	 result beg b sexp sexp-entry todo-state warntime inherited-tags
         effort effort-minutes)
    (goto-char (point-min))
    (while (re-search-forward regexp nil t)
      (catch :skip
        ;; We do not run `org-agenda-skip' right away because every single sexp
        ;; in the buffer is matched here, unlike day-specific search
        ;; in ordinary timestamps.  Most of the sexps will not match
        ;; the agenda day and it is quicker to run `org-agenda-skip' only for
        ;; matching sexps later on.
	(setq beg (match-beginning 0))
	(goto-char (1- (match-end 0)))
	(setq b (point))
	(forward-sexp 1)
	(setq sexp (buffer-substring b (point)))
	(setq sexp-entry (if (looking-at "[ \t]*\\(\\S-.*\\)")
                             (buffer-substring
                              (match-beginning 1)
                              (save-excursion
                                (goto-char (match-end 1))
                                (skip-chars-backward "[:blank:]")
                                (point)))
			   ""))
	(setq result (org-diary-sexp-entry sexp sexp-entry date))
	(when result
          ;; Only check if entry should be skipped on matching sexps.
          (org-agenda-skip (org-element-at-point))
	  (setq marker (org-agenda-new-marker beg)
		level (make-string (org-reduced-level (org-outline-level)) ? )
		category (org-get-category beg)
                effort (save-match-data (or (get-text-property (point) 'effort)
                                            (org-entry-get (point) org-effort-property)))
		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))
		todo-state (org-get-todo-state)
		warntime (org-entry-get (point) "APPT_WARNTIME" 'selective)
		extra nil)
          (setq effort-minutes (when effort (save-match-data (org-duration-to-minutes effort))))

	  (dolist (r (if (stringp result)
			 (list result)
		       result)) ;; we expect a list here
	    (when (and org-agenda-diary-sexp-prefix
		       (string-match org-agenda-diary-sexp-prefix r))
	      (setq extra (match-string 0 r)
		    r (replace-match "" nil nil r)))
	    (if (string-match "\\S-" r)
		(setq txt r)
	      (setq txt "SEXP entry returned empty string"))
	    (setq txt (org-agenda-format-item extra
                                              (org-add-props txt nil
                                                'effort effort
                                                'effort-minutes effort-minutes)
                                              level category tags 'time))
	    (org-add-props txt props 'org-marker marker
			   'date date 'todo-state todo-state
                           'effort effort 'effort-minutes effort-minutes
			   'level level 'type "sexp" 'warntime warntime)
	    (push txt ee)))))
    (nreverse ee)))