emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
From: Keith David Bershatsky <esq@lawlist.com>
To: emacs-orgmode@gnu.org
Subject: property drawer search -- org-element-headline-parser
Date: Mon, 23 Dec 2013 18:46:57 -0800	[thread overview]
Message-ID: <m2lhzbt17i.wl%esq@lawlist.com> (raw)

The property drawer search (which was working with Org version 7.9.3f) is no longer working with Org version 8.2.3a.  The following 'example' function works correctly when using the prior version of org-element-headline-parser.  Emacs Trunk (built today) comes with Org version 8.2.3a.

(require 'org)

(require 'org-element)

(defun example ()
  "For this example to work, it will need to create a file -- 'org-agenda-files'
You may adjust the location of the file.  The file will not be deleted automatically."
(interactive)
   (let ((sample-todo (concat
        "** Active [#A] smith @ drawer-one (fishing) | drawer-two (tennis). :lawlist:\n"
        "   DEADLINE: <2013-12-21 Sat 17:00>  SCHEDULED: <2013-12-21 Sat>\n"
        "   :PROPERTIES:\n"
        "   :DRAWER-ONE:  fishing\n"
        "   :DRAWER-TWO:  tennis\n"
        "   :END:\n\n"
        "** Next-Action [#B] doe @ drawer-one (football) | drawer-two (bowling). :fred:\n"
        "   DEADLINE: <2013-12-22 Sun 08:30>  SCHEDULED: <2013-12-22 Sun>\n"
        "   :PROPERTIES:\n"
        "   :DRAWER-ONE:  football\n"
        "   :DRAWER-TWO:  bowling\n"
        "   :END:\n\n"
        "** Reference [#C] john @ drawer-one (fishing) | drawer-two (sky-diving). :george:\n"
        "   DEADLINE: <2013-12-23 Mon 10:15>  SCHEDULED: <2013-12-23 Mon>\n"
        "   :PROPERTIES:\n"
        "   :DRAWER-ONE:  fishing\n"
        "   :DRAWER-TWO:  sky-diving\n"
        "   :END:\n\n"
        "** Someday [#D] jane @ drawer-one (basket-ball) | drawer-two (bowling). :sam:\n"
        "   DEADLINE: <2013-12-24 Tues 12:00>  SCHEDULED: <2013-12-24 Tues>\n"
        "   :PROPERTIES:\n"
        "   :DRAWER-ONE:  basket-ball\n"
        "   :DRAWER-TWO:  bowling\n"
        "   :END:")))
      (if (get-buffer "foo.org")
        (progn
          (switch-to-buffer "foo.org")
          (erase-buffer)
          (delete-other-windows))
        (switch-to-buffer (get-buffer-create "foo.org")))
      (org-mode)
      (insert sample-todo)
      (goto-char (point-min))
      (or (y-or-n-p (format "For this example work, you must save this buffer as a file.  Proceed with example?"))
          (error "Canceled."))
      (write-file "~/Desktop/foo.org" t)
      (let* (
          (display-buffer-alist nil) ;; lawlist custom setting
          (filename (buffer-file-name))
          (org-agenda-files (list filename))
          (org-agenda-only-exact-dates t)
          (org-agenda-show-all-dates nil)
          (org-deadline-warning-days 0)
          (org-agenda-time-grid nil)
          (org-agenda-span 'month)
          (org-agenda-entry-types '(:deadline))
          (month "12")
          (year "2013")
          (org-agenda-start-day (concat year "-" month "-" "01"))
          (drawer-content (read-string "basket-ball | bowling | fishing | football | sky-diving | tennis:  " nil))
          (org-agenda-skip-function (lambda ()
            (org-back-to-heading t)
            (let* (
                (element (org-element-at-point))
                (drawer-one (org-element-property :drawer-one element))
                (drawer-two (org-element-property :drawer-two element)))
              (cond
                ((not (or
                      (equal drawer-one drawer-content)
                      (equal drawer-two drawer-content)))
                  (message "drawer-one:  %s" drawer-one)
                  (message "drawer-two:  %s" drawer-two)
                  (org-end-of-subtree t))
                (t nil) )) )))
      (org-agenda-list)) ))

(defalias 'org-element-headline-parser 'lawlist-org-element-headline-parser)
(defun lawlist-org-element-headline-parser (limit &optional raw-secondary-p)
  "Parse an headline.

Return a list whose CAR is `headline' and CDR is a plist
containing `:raw-value', `:title', `:begin', `:end',
`:pre-blank', `:hiddenp', `:contents-begin' and `:contents-end',
`:level', `:priority', `:tags', `:todo-keyword',`:todo-type',
`:scheduled', `:deadline', `:timestamp', `:clock', `:category',
`:quotedp', `:archivedp', `:commentedp' and `:footnote-section-p'
keywords.

The plist also contains any property set in the property drawer,
with its name in lowercase, the underscores replaced with hyphens
and colons at the beginning (i.e. `:custom-id').

When RAW-SECONDARY-P is non-nil, headline's title will not be
parsed as a secondary string, but as a plain string instead.

Assume point is at beginning of the headline."
  (save-excursion
    (let* ((components (org-heading-components))
	   (level (nth 1 components))
	   (todo (nth 2 components))
	   (todo-type
	    (and todo (if (member todo org-done-keywords) 'done 'todo)))
	   (tags (let ((raw-tags (nth 5 components)))
		   (and raw-tags (org-split-string raw-tags ":"))))
	   (raw-value (or (nth 4 components) ""))
	   (quotedp
	    (let ((case-fold-search nil))
	      (string-match (format "^%s\\( \\|$\\)" org-quote-string)
			    raw-value)))
	   (commentedp
	    (let ((case-fold-search nil))
	      (string-match (format "^%s\\( \\|$\\)" org-comment-string)
			    raw-value)))
	   (archivedp (member org-archive-tag tags))
	   (footnote-section-p (and org-footnote-section
				    (string= org-footnote-section raw-value)))
	   ;; Normalize property names: ":SOME_PROP:" becomes
	   ;; ":some-prop".
	   (standard-props (let (plist)
			     (mapc
			      (lambda (p)
				(let ((p-name (downcase (car p))))
				  (while (string-match "_" p-name)
				    (setq p-name
					  (replace-match "-" nil nil p-name)))
				  (setq p-name (intern (concat ":" p-name)))
				  (setq plist
					(plist-put plist p-name (cdr p)))))
			      (org-entry-properties nil 'standard))
			     plist))
	   (time-props (org-entry-properties nil 'special "CLOCK"))
	   (scheduled (cdr (assoc "SCHEDULED" time-props)))
	   (deadline (cdr (assoc "DEADLINE" time-props)))
	   (clock (cdr (assoc "CLOCK" time-props)))
	   (timestamp (cdr (assoc "TIMESTAMP" time-props)))
	   (begin (point))
	   (end (save-excursion (goto-char (org-end-of-subtree t t))))
	   (pos-after-head (progn (forward-line) (point)))
	   (contents-begin (save-excursion
			     (skip-chars-forward " \r\t\n" end)
			     (and (/= (point) end) (line-beginning-position))))
	   (hidden (org-invisible-p2))
	   (contents-end (and contents-begin
			      (progn (goto-char end)
				     (skip-chars-backward " \r\t\n")
				     (forward-line)
				     (point)))))
      ;; Clean RAW-VALUE from any quote or comment string.
      (when (or quotedp commentedp)
	(let ((case-fold-search nil))
	  (setq raw-value
		(replace-regexp-in-string
		 (concat
		  (regexp-opt (list org-quote-string org-comment-string))
		  "\\(?: \\|$\\)")
		 ""
		 raw-value))))
      ;; Clean TAGS from archive tag, if any.
      (when archivedp (setq tags (delete org-archive-tag tags)))
      (let ((headline
	     (list 'headline
		   (nconc
		    (list :raw-value raw-value
			  :begin begin
			  :end end
			  :pre-blank
			  (if (not contents-begin) 0
			    (count-lines pos-after-head contents-begin))
			  :hiddenp hidden
			  :contents-begin contents-begin
			  :contents-end contents-end
			  :level level
			  :priority (nth 3 components)
			  :tags tags
			  :todo-keyword todo
			  :todo-type todo-type
			  :scheduled scheduled
			  :deadline deadline
			  :timestamp timestamp
			  :clock clock
			  :post-blank (count-lines
				       (if (not contents-end) pos-after-head
					 (goto-char contents-end)
					 (forward-line)
					 (point))
				       end)
			  :footnote-section-p footnote-section-p
			  :archivedp archivedp
			  :commentedp commentedp
			  :quotedp quotedp)
		    standard-props))))
	(org-element-put-property
	 headline :title
	 (if raw-secondary-p raw-value
	   (org-element-parse-secondary-string
	    raw-value (org-element-restriction 'headline) headline)))))))


Thanks,

Keith

             reply	other threads:[~2013-12-24  2:47 UTC|newest]

Thread overview: 3+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2013-12-24  2:46 Keith David Bershatsky [this message]
2013-12-24  6:17 ` Fwd: property drawer search -- org-element-headline-parser Keith David Bershatsky
2013-12-26 17:36   ` Nicolas Goaziou

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.orgmode.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=m2lhzbt17i.wl%esq@lawlist.com \
    --to=esq@lawlist.com \
    --cc=emacs-orgmode@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).