ndwarshuis
/
emacs-config
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

implemented tail-recursive org-element tree parser

This commit is contained in:
ndwarshuis 2018-12-27 13:53:08 -05:00
parent 723abb1909
commit a8071b395a
1 changed files with 444 additions and 281 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

689
conf.org
View File

@ -185,6 +185,24 @@ filesystem and is a usb drive."
"Prints ARGS of ORIG-FUN. Intended as :around advice." "Prints ARGS of ORIG-FUN. Intended as :around advice."
(print args) (print args)
(apply orig-fun args)) (apply orig-fun args))
(defun nd/plist-put-append (plist prop value &optional front)
"Like `plist-put' but append VALUE to current values in PLIST for PROP.
If FRONT is t, append to the front of current values instead of the back."
(let* ((cur (plist-get plist prop))
(new (if front (append value cur) (append cur value))))
(plist-put plist prop new)))
(defun nd/plist-put-list (plist prop value &optional front)
"Like `plist-put' but append (list VALUE) to current values in PLIST for PROP.
If FRONT is t, do to the front of current values instead of the back."
(let* ((cur (plist-get plist prop))
(new (if front (append (list value) cur) (append cur (list value)))))
(plist-put plist prop new)))
(defun nd/strip-string (str)
"Remove text properties and trim STR and return the result."
(when str (string-trim (substring-no-properties str))))
#+END_SRC #+END_SRC
** interactive ** interactive
#+BEGIN_SRC emacs-lisp #+BEGIN_SRC emacs-lisp
@ -2676,33 +2694,59 @@ were entered on the shell."
"Escape and quote TXT in order to insert into sqlite db via 'insert'. "Escape and quote TXT in order to insert into sqlite db via 'insert'.
This assumes the insertion command will be run on a shell where the This assumes the insertion command will be run on a shell where the
sql command string is in double quotes." sql command string is in double quotes."
(let* ((txt-single (replace-regexp-in-string "'" "''" txt nil t)) (let* ((new-txt (replace-regexp-in-string "'" "''" txt nil t))
(txt-double (replace-regexp-in-string "\"" "\\\"" txt-single nil t))) (new-txt (replace-regexp-in-string "\"" "\\\"" new-txt nil t)))
(concat "'" txt-double "'"))) (concat "'" new-txt "'")))
(defun nd/sql-to-string (entry)
"Convert ENTRY to a string suitable for insertion into SQLite db.
Converts numbers to strings, flanks strings with '\"', and converts
any other symbols to their symbol name."
(cond ((stringp entry) (nd/sql-escape-text entry))
((numberp entry) (number-to-string entry))
(entry (symbol-name entry))
(t "NULL")))
(defun nd/sql-construct-insertion (tbl data)
"Concatenate DATA into escaped comma-separated string for SQL insertion."
(let* ((data-str (mapcar #'nd/sql-to-string data))
(data-str (string-join data-str ",")))
(concat "insert into " tbl " values(" data-str ");")))
(defun nd/sql-insert (db tbl data) (defun nd/sql-insert (db tbl data)
"Insert list DATA into TBL in sqlite database DB. "Insert list DATA into TBL in sqlite database DB."
Note that in list DATA, numbers will be converted to strings, (nd/sql-cmd db (nd/sql-construct-insertion tbl data)))
strings will be flanked with '\"', and any other symbols will be
converted to their symbol name." (defun nd/sql-insert-multi (db tbl-data &optional acc)
(let* ((data-str (mapcar "Insert TBL-DATA into sqlite database DB using transactions.
(lambda (d) TBL-DATA is a plist with each key as the table and the value as a
(cond ((stringp d) (nd/sql-escape-text d)) list of lists holding data for that table."
((numberp d) (number-to-string d)) (if (not tbl-data)
(d (symbol-name d)) (concat acc "commit;")
(t "NULL"))) (let* ((acc (or acc "begin transaction;"))
data)) (tbl-name (car tbl-data))
(data-joined (string-join data-str ","))) (row-data (cdr tbl-data))
(nd/sql-cmd db (concat "insert into " tbl " values(" data-joined ");")))) (rem (cddr tbl-data))
(concat-tbl
(lambda (tbl data &optional acc)
(if data
(let* ((cur (car data))
(rem (cdr data))
(acc-new (nd/sql-construct-insertion tbl cur))
(acc-new (concat acc acc-new)))
(funcall concat-tbl tbl rem acc-new))
acc)))
(new-acc (funcall concat-tbl tbl row-data)))
(nd/sql-insert-multi (db rem new-acc)))))
#+END_SRC #+END_SRC
**** org parsing function **** org parsing function
Basic functions to parse org strings Basic functions to parse org strings
#+BEGIN_SRC emacs-lisp #+BEGIN_SRC emacs-lisp
(defun nd/org-effort-to-int (effort-str &optional to-string ignore-err) (defun nd/org-effort-to-int (effort-str &optional to-string throw-err)
"Convert EFFORT-STR into an integer from HH:MM format. "Convert EFFORT-STR into an integer from HH:MM format.
If it is already an integer, nothing is changed. If TO-STRING is t, If it is already an integer, nothing is changed. If TO-STRING is t,
convert the final number to a string of the number. If IGNORE-ERR is t, convert the final number to a string of the number. If THROW-ERR is t,
do not throw an error if the string is not recognized." throw an error if the string is not recognized."
(when effort-str (when effort-str
(let ((effort-str (string-trim effort-str))) (let ((effort-str (string-trim effort-str)))
(save-match-data (save-match-data
@ -2714,13 +2758,18 @@ do not throw an error if the string is not recognized."
(if to-string (number-to-string sum) sum))) (if to-string (number-to-string sum) sum)))
((string-match-p "^[0-9]+$" effort-str) ((string-match-p "^[0-9]+$" effort-str)
(if to-string effort-str (string-to-number effort-str))) (if to-string effort-str (string-to-number effort-str)))
(t (unless ignore-err (t (when throw-err
(error (concat "Unknown effort format: '" effort-str "'"))))))))) (error (concat "Unknown effort format: '" effort-str "'")))))))))
(defun nd/org-ts-format-to-iso (ts) (defun nd/org-ts-format-to-iso (ts)
"Return org timestamp TS to as string in ISO 8601 format." "Return org timestamp TS to as string in ISO 8601 format.
If TS is nil or TS cannot be understood, nil will be returned."
(when ts
;; org-parse-time-string (used in org-2ft) does not save match data ;; org-parse-time-string (used in org-2ft) does not save match data
(when ts (format-time-string "%Y-%m-%dT%H:%M:00" (save-match-data (org-2ft ts))))) (let ((ft (save-match-data (org-2ft ts))))
;; assume that nobody is going to need jan 1 1970
(when (> ft 0)
(format-time-string "%Y-%m-%dT%H:%M:00" ft)))))
#+END_SRC #+END_SRC
**** org sql schemas **** org sql schemas
#+BEGIN_SRC emacs-lisp #+BEGIN_SRC emacs-lisp
@ -2784,7 +2833,7 @@ PRIMARY KEY (archive_file_path ASC, clock_file_offset ASC));"
archive_file_path TEXT, archive_file_path TEXT,
headline_file_offset INTEGER, headline_file_offset INTEGER,
entry_file_offset INTEGER, entry_file_offset INTEGER,
time_logged DATE NOT NULL, time_logged DATE,
note TEXT, note TEXT,
FOREIGN KEY (archive_file_path, headline_file_offset) FOREIGN KEY (archive_file_path, headline_file_offset)
REFERENCES headlines (archive_file_path, headline_file_offset), REFERENCES headlines (archive_file_path, headline_file_offset),
@ -2899,14 +2948,15 @@ parent until found or return nil if unfruitful."
(let ((parent (org-element-property :parent obj))) (let ((parent (org-element-property :parent obj)))
(nd/org-element-property-inherited prop parent)))))) (nd/org-element-property-inherited prop parent))))))
(defun nd/org-element-sort-headline-contents (headline) (defun nd/org-element-partition-headline (headline)
"For a given org-element HEADLINE, return a sorted plist. "For a given org-element HEADLINE, return a sorted plist.
The plist will be structured as such: The plist will be structured as such:
(:planning '(data) :planning '(data)
:logbook-drawer '(data) :logbook-drawer '(data)
:property-drawer '(data) :property-drawer '(data)
:other-contents '(data)) :headline-contents '(data)
:subheadings (list of subheadings)
The planning entry will have the list of data associated with the The planning entry will have the list of data associated with the
:planning property, and likewise with property-drawer. logbook-drawer :planning property, and likewise with property-drawer. logbook-drawer
@ -2915,14 +2965,13 @@ nil if not set. other-contents includes all other elements including
other drawers, list, paragraph elements, etc. If any of these groups other drawers, list, paragraph elements, etc. If any of these groups
are missing, nil will be returned." are missing, nil will be returned."
(when headline (when headline
;; assume there is only one section under one headline (let ((hl-contents (org-element-contents headline)))
(let* ((section (car (org-element-contents headline))) (if (eq 'headline (org-element-type (car hl-contents)))
(contents (org-element-contents section)) ;; return just a plist of subheadings if there is no section
(plist-put-append (list :subheadings hl-contents)
(lambda (plist property value) (let* ((sec-contents (org-element-contents (car hl-contents)))
(let* ((cur (plist-get plist property)) (subheadings (cdr hl-contents))
(new (append cur value))) (init-plist (list :subheadings subheadings))
(plist-put plist property new))))
(get-pkey (get-pkey
(lambda (obj) (lambda (obj)
(let ((type (org-element-type obj))) (let ((type (org-element-type obj)))
@ -2933,18 +2982,16 @@ are missing, nil will be returned."
(equal (org-element-property :drawer-name obj) (equal (org-element-property :drawer-name obj)
org-log-into-drawer)) org-log-into-drawer))
:logbook-drawer) :logbook-drawer)
(t :other-contents))))) (t :headline-contents)))))
(sort-contents (sort-contents
(lambda (contents &optional acc) (lambda (contents &optional acc)
(if (not contents)
acc
(let* (let*
((cur (car contents)) ((cur (car contents))
(rem (cdr contents)) (rem (cdr contents))
(pkey (funcall get-pkey cur)) (pkey (funcall get-pkey cur))
(new-acc (funcall plist-put-append acc pkey cur))) (new-acc (nd/plist-put-append acc pkey cur)))
(funcall sort-contents rem new-acc)))))) (if rem (funcall sort-contents rem new-acc) new-acc)))))
(funcall sort-contents contents)))) (funcall sort-contents sec-contents init-plist))))))
#+END_SRC #+END_SRC
**** org sql constants and variables **** org sql constants and variables
#+BEGIN_SRC emacs-lisp #+BEGIN_SRC emacs-lisp
@ -2966,9 +3013,13 @@ See `org-use-tag-inheritance'.")
**** org logbook parsing functions **** org logbook parsing functions
The logbook takes some extra work to parse as there is little/no information to distinguish the "type" of any given log entry (outside of clocking). Therefore, need to go down to the string level and match using regular expressions. The logbook takes some extra work to parse as there is little/no information to distinguish the "type" of any given log entry (outside of clocking). Therefore, need to go down to the string level and match using regular expressions.
#+BEGIN_SRC emacs-lisp #+BEGIN_SRC emacs-lisp
(defun nd/org-logbook-match-entry (entry-str) (defun nd/org-logbook-match-header (header-text)
"Test if ENTRY-STR matches `nd/org-log-note-headings-regexp'. "Test if ENTRY-STR matches `nd/org-log-note-headings-regexp'.
If found, returns list where car is the type and cdr is match data." If match successful, returns plist with the following:
:type - the type of the header, which is the car to the corresponding
cell in `nd/org-log-note-headings-regexp'
:match-data - the match data for the search to find the type"
(let* ((scan (let* ((scan
(lambda (str note-regex-alist) (lambda (str note-regex-alist)
(when note-regex-alist (when note-regex-alist
@ -2979,8 +3030,45 @@ If found, returns list where car is the type and cdr is match data."
(if (string-match re str) (if (string-match re str)
type type
(funcall scan str rem)))))) (funcall scan str rem))))))
(type (funcall scan entry-str nd/org-log-note-headings-regexp))) (type (funcall scan header-text nd/org-log-note-headings-regexp)))
(when type (cons type (match-data))))) (when type (list :type type :match-data (match-data)))))
(defun nd/org-logbook-parse-item (item archive-file-path headline-file-offset)
"Parse an org-element ITEM which is assumed to be part of a logbook.
Returns a plist with the following structure:
:item - the original item element
:parent-headline - the headline immediately encapsulating the item
:header-text - the first line of the note which is standardized using
`org-log-note-headings' as a trimmed string with no text properties.
:note-text - the remainder of the note text as a trimmed string with
no text properties (will be nil if item has no line-break element)
:offset - the file offset of the item
:type - the type of the item (may be nil if undetermined)
:match-data - match data associated with finding the type as done
using `nd/org-log-note-headings-regexp' (may be nil if undetermined)
:archive-file-path - the value of ARCHIVE-FILE-PATH
:headline-file-offset - the value of HEADLINE-FILE-OFFSET."
(let* ((parent-hl (nd/org-element-get-parent-headline item))
(item-offset (org-element-property :begin item))
(paragraph (nd/org-element-find-type 'paragraph item))
(contents (org-element-contents paragraph))
;; split entry into right / left components via linebreak
(left (nd/org-element-split-by-type 'line-break contents))
(right (nd/org-element-split-by-type 'line-break contents t))
(header-text (string-trim (substring-no-properties
(org-element-interpret-data left))))
(note-text (string-trim (substring-no-properties
(org-element-interpret-data right))))
(type-plist (nd/org-logbook-match-header header-text))
(parse-plist (list :item item
:parent-headline parent-hl
:header-text header-text
:note-text note-text
:offset item-offset
:archive-file-path archive-file-path
:headline-file-offset headline-file-offset)))
(append parse-plist type-plist)))
;; this function doesn't exist in vanilla org mode >:( ;; this function doesn't exist in vanilla org mode >:(
(defun nd/org-todo-keywords-stripped () (defun nd/org-todo-keywords-stripped ()
@ -3064,50 +3152,269 @@ These are the main functions to populate the db.
(nd/sql-cmd nd/org-sqlite-db-path nd/org-sqlite-state-changes-schema) (nd/sql-cmd nd/org-sqlite-db-path nd/org-sqlite-state-changes-schema)
(nd/sql-cmd nd/org-sqlite-db-path nd/org-sqlite-planning-changes-schema))) (nd/sql-cmd nd/org-sqlite-db-path nd/org-sqlite-planning-changes-schema)))
(defun nd/org-element-header-to-sql (headline archive-file-path) (defun nd/org-element-note-header-to-sql (parsed-item &optional acc)
"Parse org-element HEADLINE and insert data into TBL in sqlite DB. "Add data from PARSED-ITEM to ACC depending on its type."
ARCHIVE-FILE-PATH is the file path to the currently parsed archive file." (let ((type (plist-get parsed-item :type))
(let* ((headline-file-offset (org-element-property :begin headline)) (archive-file-path (plist-get parsed-item :archive-file-path))
(archive-tree-path (nd/org-element-get-parent-tree headline)) (entry-file-offset (plist-get parsed-item :offset))
;; headline table data (header-text (plist-get parsed-item :header-text)))
(source-file-path (nd/org-element-property-inherited :ARCHIVE_FILE headline)) ;; TODO, make these adapt to the value of org-log-note-headings??
(source-tree-path (nd/org-element-property-inherited :ARCHIVE_OLPATH headline)) (cond
(headline-text (org-element-property :raw-value headline)) ((eq type 'state)
(time-created (org-element-property :CREATED headline)) (let* ((state-old (match-string 3 header-text))
(time-created (nd/org-ts-format-to-iso time-created)) (state-new (match-string 1 header-text))
(time-closed (nd/org-element-timestamp-raw :closed headline t)) (state-data (list archive-file-path
(time-scheduled (nd/org-element-timestamp-raw :scheduled headline t)) entry-file-offset
(time-deadline (nd/org-element-timestamp-raw :deadline headline t)) state-old
(keyword (org-element-property :todo-keyword headline)) state-new)))
(effort (org-element-property :EFFORT headline)) (nd/plist-put-list acc 'state_changes state-data)))
(effort (nd/org-effort-to-int effort t)) ((memq type '(reschedule delschedule redeadline deldeadline))
(priority (org-element-property :priority headline)) (let* ((time-old (nd/org-ts-format-to-iso
;; tags table data (match-string 1 header-text)))
(tags (org-element-property :tags headline)) (planning-kw (if (memq type '(reschedule delschedule))
(i-tags (org-element-property :ARCHIVE_ITAGS headline)) :scheduled
(i-tags (when i-tags (split-string i-tags))) :deadline))
(insert-tags (parent-hl (plist-get parsed-item :parent-headline))
(lambda (tags archive-file-path headline-file-offset inherited) (time-new (nd/org-element-timestamp-raw planning-kw parent-hl t))
(while tags (time-new (nd/org-ts-format-to-iso time-new))
(nd/sql-insert nd/org-sqlite-db-path (planning-type (if (eq :scheduled planning-kw) "s" "d"))
"tags" (planning-data (list archive-file-path
entry-file-offset
time-old
time-new
planning-type)))
(nd/plist-put-list acc 'planning_changes planning-data)))
;; no action required for these
((memq type '(done refile note)) acc)
;; header type not determined, therefore do nothing
(t acc))))
(defun nd/org-element-note-get-time-logged (parsed-item)
"Return time-logged of PARSED-ITEM or nil if it cannot be determined."
(set-match-data (plist-get parsed-item :match-data))
(let* ((type (plist-get parsed-item :type))
(time-index
(cond
((memq type '(done note refile)) 1)
((memq type '(reschedule delschedule redeadline deldeadline)) 3)
((eq type 'state) 5)))
(header-text (plist-get parsed-item :header-text)))
(when time-index
(nd/org-ts-format-to-iso (match-string time-index header-text)))))
(defun nd/org-element-note-to-sql (parsed-item &optional acc)
"Add logbook common data from PARSED-ITEM to ACC."
(let* ((archive-file-path (plist-get parsed-item :archive-file-path))
(headline-file-offset (plist-get parsed-item :headline-file-offset))
(entry-file-offset (plist-get parsed-item :offset))
(time-logged (nd/org-element-note-get-time-logged parsed-item))
(note-text (plist-get parsed-item :header-text))
(logbook-data (list archive-file-path
headline-file-offset
entry-file-offset
time-logged
note-text))
(new-acc (nd/plist-put-list acc 'logbook logbook-data)))
(nd/org-element-note-header-to-sql parsed-item new-acc)))
(defun nd/org-element-add-note-to-clock (clock-data note-text)
"Add NOTE-TEXT to sql data CLOCK-DATA."
(append clock-data note-text))
(defun nd/org-logbook-parse-timestamp-range (ts)
"Return start and end of timestamp TS depending on if it is a range.
Return value will be a list of two elements if range and one if not."
(when ts
(let ((time-start (nd/org-ts-format-to-iso (org-timestamp-split-range ts))))
(when time-start
(let* ((type (org-element-property :type ts))
(time-end
(when (eq type 'inactive-range)
(nd/org-ts-format-to-iso (org-timestamp-split-range ts t)))))
(cons time-start time-end))))))
(defun nd/org-element-clock-to-sql (clock archive-file-path
headline-file-offset)
"Parse org-element CLOCK and return a list of extracted data.
ARCHIVE-FILE-PATH and HEADLINE-FILE-OFFSET are the file path and file
offset of the property's parent headline in the org file."
(let* ((clock-file-offset (org-element-property :begin clock))
(ts-obj (org-element-property :value clock))
(ts-range (nd/org-logbook-parse-timestamp-range ts-obj))
(time-start (car ts-range))
(time-end (cdr ts-range)))
(list archive-file-path (list archive-file-path
headline-file-offset headline-file-offset
(car tags) clock-file-offset
inherited)) time-start
(setq tags (cdr tags))))) time-end)))
;; get headline section for processing drawers and contents
(contents-plist (nd/org-element-sort-headline-contents headline))
(property-drawer (plist-get contents-plist :property-drawer))
(node-properties (org-element-contents property-drawer))
(logbook-drawer (plist-get contents-plist :logbook-drawer))
(logbook-contents (org-element-contents logbook-drawer))
(hl-contents (plist-get contents-plist :other-contents)))
;; insert into headlines table (defun nd/org-element-logbook-items-to-sql (items archive-file-path
(nd/sql-insert nd/org-sqlite-db-path headline-file-offset
"headlines" &optional acc
(list archive-file-path last-clock)
"Parse ITEMS from logbook drawer (not clocks) and add to ACC.
ARCHIVE-FILE-PATH and HEADLINE-FILE-OFFSET are the file path and file
offset of the property's parent headline in the org file.
LAST-CLOCK has the same purpose as `nd/org-element-logbook-to-sql'."
(if (not items)
acc
(let* ((cur (car items))
(rem (cdr items))
(parsed-item (nd/org-logbook-parse-item cur
archive-file-path
headline-file-offset))
(type (plist-get parsed-item :type))
(header-text (plist-get parsed-item :header-text))
;; if header type unknown and after a clock assume it
;; is a clock note
(new-acc
(if (and last-clock (not type))
(let ((new-clock (nd/org-element-add-note-to-clock last-clock header-text)))
(nd/plist-put-list acc 'clocking new-clock))
(nd/org-element-note-to-sql parsed-item acc))))
;; don't pass the new clock here as any thing called from inside
;; this function is guaranteed to be at least the second note
;; after a clock entry
(nd/org-element-logbook-items-to-sql rem
archive-file-path
headline-file-offset
new-acc))))
(defun nd/org-element-logbook-to-sql (lb-contents archive-file-path
headline-file-offset
&optional acc
last-clock)
"Loop through logbook entries LB-CONTENTS and insert data into ACC.
ARCHIVE-FILE-PATH and HEADLINE-FILE-OFFSET are the file path and file
offset of the property's parent headline in the org file.
LAST-CLOCK is a temporary value to store the list of data from the
last clocking entry. This is necessary because some clock entries
may have notes attached to them, but since the clock and item elements
are independent from each other, we need to scan the next note to see
if it belongs to a clock."
(if (not lb-contents)
(if last-clock (nd/plist-put-list acc 'clocking last-clock) acc)
(let* ((cur (car lb-contents))
(rem (cdr lb-contents))
(type (org-element-type cur)))
(cond
((eq 'plain-list type)
(let* ((items (org-element-contents cur))
(new-acc
(nd/org-element-logbook-items-to-sql items
archive-file-path
headline-file-offset
acc
last-clock)))
(nd/org-element-logbook-to-sql rem
archive-file-path
headline-file-offset
new-acc)))
((eq 'clock type)
(let ((new-clock (nd/org-element-clock-to-sql cur
archive-file-path
headline-file-offset)))
(nd/org-element-logbook-to-sql rem
archive-file-path
headline-file-offset
acc
new-clock)))
(t (error (concat "Unknown logbook entry type: " (symbol-name type))))))))
(defun nd/org-element-property-to-sql (node-props archive-file-path
headline-file-offset
&optional acc)
"Add data from NODE-PROPS to accumulator sql-data plist ACC.
ARCHIVE-FILE-PATH and HEADLINE-FILE-OFFSET are the file path and file
offset of the property's parent headline in the org file."
(if (not node-props)
acc
(let* ((cur (car node-props))
(rem (cdr node-props))
(key-text (org-element-property :key cur))
(new-acc
(if (member key-text nd/org-sql-ignored-properties)
acc
(let* ((property-file-offset (org-element-property :begin cur))
(val-text (org-element-property :value cur))
(prop-data (list archive-file-path
headline-file-offset
property-file-offset
key-text
val-text
;; TODO add inherited flag
nil)))
(nd/plist-put-list acc 'properties prop-data)))))
(nd/org-element-property-to-sql rem
archive-file-path
headline-file-offset
new-acc))))
(defun nd/org-element-tags-to-sql (headline archive-file-path
headline-file-offset
&optional acc)
"Add tags to sql-data plist ACC from HEADLINE.
ARCHIVE-FILE-PATH and HEADLINE-FILE-OFFSET are the file path and file
offset of the property's parent headline in the org file."
(let* ((insert-tags
(lambda (tags a h i acc)
(if (not tags)
acc
(let* ((cur (car tags))
(rem (cdr tags))
(tags-data (list a h cur i))
(new-acc (nd/plist-put-list acc 'tags tags-data)))
(funcall insert-tags rem a h i new-acc) new-acc))))
;; first insert all headline tags into acc
(tags (org-element-property :tags headline))
(new-acc (funcall insert-tags
tags
archive-file-path
headline-file-offset
0
acc))
;; then retrieve i-tags, optionally going up to parents
(i-tags (org-element-property :ARCHIVE_ITAGS headline))
(i-tags (when i-tags (split-string i-tags)))
(i-tags (if nd/org-sql-use-tag-inheritance
(nd/org-element-get-parent-tags headline i-tags)
i-tags)))
(funcall insert-tags i-tags archive-file-path headline-file-offset
1 new-acc)))
(defun nd/org-element-header-to-sql (headlines archive-file-path
&optional acc)
"Parse list of org-elements HEADLINES and insert data into ACC.
ARCHIVE-FILE-PATH is the file path to the currently parsed archive file."
(if (not headlines)
acc
(let* ((cur (car headlines))
(rem (cdr headlines))
(headline-file-offset (org-element-property :begin cur))
(archive-tree-path (nd/org-element-get-parent-tree cur))
;; insert data for headlines table
(source-file-path (nd/org-element-property-inherited :ARCHIVE_FILE cur))
(source-tree-path (nd/org-element-property-inherited :ARCHIVE_OLPATH cur))
(headline-text (org-element-property :raw-value cur))
(time-created (org-element-property :CREATED cur))
(time-created (nd/org-ts-format-to-iso time-created))
(time-closed (nd/org-element-timestamp-raw :closed cur t))
(time-scheduled (nd/org-element-timestamp-raw :scheduled cur t))
(time-deadline (nd/org-element-timestamp-raw :deadline cur t))
(keyword (nd/strip-string (org-element-property :todo-keyword cur)))
(effort (org-element-property :EFFORT cur))
(effort (nd/org-effort-to-int effort t))
(priority (org-element-property :priority cur))
(hl-part (nd/org-element-partition-headline cur)) ;; data for children
(hl-contents (plist-get hl-part :headline-contents))
;; (hl-contents-text (org-element-interpret-data hl-contents))
;; (hl-contents-text (when hl-contents-text
;; (string-trim
;; (substring-no-properties hl-contents-text))))
(hl-data (list archive-file-path
headline-file-offset headline-file-offset
archive-tree-path archive-tree-path
source-file-path source-file-path
@ -3120,192 +3427,48 @@ ARCHIVE-FILE-PATH is the file path to the currently parsed archive file."
keyword keyword
effort effort
priority priority
;; TODO add contents
nil)) nil))
(new-acc (nd/plist-put-list acc 'headlines hl-data))
;; insert into tags tables ;; insert data for tags table
(funcall insert-tags tags archive-file-path headline-file-offset 0) (new-acc (nd/org-element-tags-to-sql cur
;; retrieve parent tags if we want inheritance archive-file-path
(when nd/org-sql-use-tag-inheritance
(setq i-tags (nd/org-element-get-parent-tags headline i-tags)))
(funcall insert-tags i-tags archive-file-path headline-file-offset 1)
;; insert properties into table
(nd/org-element-property-to-sql node-properties archive-file-path)
;; insert logbook entries into their tables
(nd/org-element-logbook-to-sql logbook-contents archive-file-path)))
(defun nd/org-element-property-to-sql (node-properties archive-file-path)
"Parse node-property element NP and insert data into TBL in sqlite DB.
ARCHIVE-FILE-PATH is the file path to the currently parsed archive file."
(when node-properties
(let* ((cur (car node-properties))
(rem (cdr node-properties))
(key-text (org-element-property :key cur)))
(unless (member key-text nd/org-sql-ignored-properties)
(let* ((parent-headline (nd/org-element-get-parent-headline cur))
(headline-file-offset (org-element-property :begin parent-headline))
(property-file-offset (org-element-property :begin cur))
(val-text (org-element-property :value cur)))
(nd/sql-insert nd/org-sqlite-db-path
"properties"
(list archive-file-path
headline-file-offset headline-file-offset
property-file-offset new-acc))
key-text ;; insert data for property table
val-text (property-drawer (plist-get hl-part :property-drawer))
;; TODO add inherited flag (node-props (org-element-contents property-drawer))
nil)))) (new-acc (nd/org-element-property-to-sql node-props
(nd/org-element-property-to-sql rem archive-file-path)))) archive-file-path
(defun nd/org-element-logbook-to-sql (lb-contents archive-file-path &optional last-clock)
(when lb-contents
(let* ((cur (car lb-contents))
(rem (cdr lb-contents))
(type (org-element-type cur)))
(print type)
(cond
((eq 'plain-list type)
;; call some processing function and pass last-clock
(let ((contents (org-element-contents cur)))
(nd/org-element-logbook-item-to-sql contents archive-file-path))
(nd/org-element-logbook-to-sql rem archive-file-path))
((eq 'clock type)
;; call some processing function
(nd/org-element-clock-to-sql cur archive-file-path)
(nd/org-element-logbook-to-sql rem archive-file-path last-clock))
(t (error (concat "Unknown logbook entry type: " (symbol-name type))))))))
(defun nd/org-element-logbook-item-to-sql (items archive-file-path)
"Parse ITEM if in log drawer and add notes and log entries to db.
ARCHIVE-FILE-PATH is the path to the archive file."
;; assume all items here are from a legit logbook drawer
(when items
(let* ((cur (car items))
(rem (cdr items))
(parent-headline (nd/org-element-get-parent-headline cur))
(headline-file-offset (org-element-property :begin parent-headline))
(entry-file-offset (org-element-property :begin cur))
(paragraph (nd/org-element-find-type 'paragraph cur))
(contents (org-element-contents paragraph))
;; split entry into right / left components via linebreak
(left (nd/org-element-split-by-type 'line-break contents))
(right (nd/org-element-split-by-type 'line-break contents t))
(note (string-trim (substring-no-properties
(org-element-interpret-data right))))
(entry-str (string-trim (substring-no-properties
(org-element-interpret-data left))))
(note-parsed (nd/org-logbook-match-entry entry-str))
(note-type (car note-parsed))
(note-match (cdr note-parsed))
time-index time-logged logbook-data)
;; get time recorded based on note type
(when note-type
(set-match-data note-match)
(setq time-index
(cond
((memq note-type '(done note refile)) 1)
((memq note-type '(reschedule delschedule redeadline deldeadline)) 3)
((eq note-type 'state) 5)
(t (error (concat "Unknown type: " (symbol-name note-type))))))
(setq time-logged (nd/org-ts-format-to-iso
(match-string time-index entry-str))))
;; insert into general logbook table first
(nd/sql-insert nd/org-sqlite-db-path
"logbook"
(list archive-file-path
headline-file-offset headline-file-offset
entry-file-offset new-acc))
time-logged ;; insert data for logbook table
note)) (lb-drawer (plist-get hl-part :logbook-drawer))
(lb-contents (org-element-contents lb-drawer))
;; insert into auxiliary logging tables (new-acc (nd/org-element-logbook-to-sql lb-contents
(when note-type archive-file-path
(cond
((eq note-type 'state)
(let* ((state-old (match-string 3 entry-str))
(state-new (match-string 1 entry-str)))
(nd/sql-insert nd/org-sqlite-db-path
"state_changes"
(list archive-file-path
entry-file-offset
state-old
state-new))))
((memq note-type '(reschedule delschedule redeadline deldeadline))
(let* ((time-old (nd/org-ts-format-to-iso
(match-string 1 entry-str)))
(schedule (memq note-type '(reschedule delschedule)))
(time-new (nd/org-element-timestamp-raw
(if schedule :scheduled :deadline)
parent-headline
t))
(time-new (nd/org-ts-format-to-iso time-new))
(planning-type (if schedule "s" "d")))
(nd/sql-insert nd/org-sqlite-db-path
"planning_changes"
(list archive-file-path
entry-file-offset
time-old
time-new
planning-type))))
;; no action required for these
((memq note-type '(done refile note)) (ignore))
;; this shouldn't happen
(t (error (concat "Unknown entry type: " (symbol-name note-type))))))
(nd/org-element-logbook-item-to-sql rem archive-file-path))))
(defun nd/org-element-clock-to-sql (clock archive-file-path)
"Parse org-element CLOCK and insert data into TBL in sqlite DB.
ARCHIVE-FILE-PATH is the file path to the currently parsed archive file."
(let* ((parent-headline (nd/org-element-get-parent-headline clock))
(headline-file-offset (org-element-property :begin parent-headline))
(clock-file-offset (org-element-property :begin clock))
(timestamp-obj (org-element-property :value clock))
(timestamp-type (org-element-property :type timestamp-obj))
time-start time-end)
;; process timestamp depending on if it is a range or singular
(cond ((eq 'inactive-range timestamp-type)
(setq time-start (org-timestamp-split-range timestamp-obj)
time-end (org-timestamp-split-range timestamp-obj t)))
((eq 'inactive timestamp-type)
(setq time-start timestamp-obj))
;; should never happen
(t (error (concat "unknown timestamp type: "
(symbol-name timestamp-type)))))
(setq time-start (nd/org-ts-format-to-iso
(org-element-property :raw-value time-start))
time-end (nd/org-ts-format-to-iso
(org-element-property :raw-value time-end)))
(nd/sql-insert nd/org-sqlite-db-path
"clocking"
(list archive-file-path
headline-file-offset headline-file-offset
clock-file-offset new-acc))
time-start ;; insert data for subheadings under this one
time-end (subheadings (plist-get hl-part :subheadings))
;; TODO add clocking note (new-acc (nd/org-element-header-to-sql subheadings
nil)))) archive-file-path
new-acc)))
(nd/org-element-header-to-sql rem archive-file-path new-acc))))
(defun nd/org-archive-to-db () (defun nd/org-archive-to-db ()
"Transfer archive files to sqlite database." "Transfer archive files to sqlite database."
(let* ((rxv-path (expand-file-name "test.org_archive" org-directory)) (let* ((rxv-path (expand-file-name "test.org_archive" org-directory))
(tree (with-current-buffer (find-file-noselect rxv-path) (tree (with-current-buffer (find-file-noselect rxv-path)
(org-element-parse-buffer)))) (org-element-parse-buffer)))
(contents (org-element-contents tree))
(headlines (if (eq 'section (org-element-type (car contents)))
(cdr contents)
contents)))
(nd/org-element-header-to-sql headlines rxv-path)))
(org-element-map tree 'headline ;; these are obviously temporary
(lambda (h) (nd/org-element-header-to-sql h rxv-path))))) (setq max-lisp-eval-depth 100000
;; (org-element-map tree 'clock max-specpdl-size 800000)
;; (lambda (c) (nd/org-element-clock-to-sql c rxv-path)))
;; (org-element-map tree 'node-property
;; (lambda (n) (nd/org-element-property-to-sql n rxv-path)))
;; (org-element-map tree 'item
;; (lambda (i) (nd/org-element-logbook-item-to-sql i rxv-path)))))
#+END_SRC #+END_SRC
* tools * tools
** printing ** printing