emacs-orgmode
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[O] property drawer search -- org-element-headline-parser


From: Keith David Bershatsky
Subject: [O] property drawer search -- org-element-headline-parser
Date: Mon, 23 Dec 2013 18:46:57 -0800
User-agent: / () / () APEL/10.8 Emacs/24.3.50 (x86_64-apple-darwin10.8.0) MULE/6.0 (HANACHIRUSATO)

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 via email to

[Prev in Thread] Current Thread [Next in Thread]