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

fixed note parsing errors and made functions more robusts/clear

This commit is contained in:
ndwarshuis 2018-12-28 17:40:05 -05:00
parent 2ac5059597
commit 0306b93a5e
1 changed files with 440 additions and 363 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

793
conf.org
View File

@ -2709,23 +2709,31 @@ any other symbols to their symbol name."
(defun nd/sql-construct-insert (tbl-name tbl-data) (defun nd/sql-construct-insert (tbl-name tbl-data)
"Concatenate DATA into escaped comma-separated string for SQL insertion." "Concatenate DATA into escaped comma-separated string for SQL insertion."
(let* ((data-str (mapcar #'nd/sql-to-string tbl-data)) ;; column names are the properties in the plist
(data-str (string-join data-str ","))) (let* ((col-names (-slice tbl-data 0 nil 2))
(concat "insert into " (symbol-name tbl-name) " values(" data-str ");"))) (col-names (mapcar (lambda (s) (substring (symbol-name s) 1)) col-names))
(col-names (string-join col-names ","))
;; column values are the values of each property
(col-values (-slice tbl-data 1 nil 2))
(col-values (mapcar #'nd/sql-to-string col-values))
(col-values (string-join col-values ",")))
(concat "insert into " (symbol-name tbl-name)
" (" col-names ") values (" col-values ");")))
(defun nd/sql-construct-insert-transaction (all-data &optional acc) (defun nd/sql-construct-insert-transaction (all-data)
"Construct transaction string to insert ALL-DATA into SQL. "Construct transaction string to insert ALL-DATA into SQL.
Does not actually execute the string." Does not actually execute the string."
(if (not all-data) (let* ((scan-tbl
(concat acc "commit;") (lambda (tbl)
(let* ((tbl-name (car all-data)) (let ((name (car tbl))
(tbl-data (nth 1 all-data)) (data (cdr tbl)))
(rem (cddr all-data)) (string-join (mapcar
(tbl-data-str (mapcar (lambda (d) (nd/sql-construct-insert tbl-name d)) tbl-data)) (lambda (d)
(tbl-data-str (string-join tbl-data-str)) (nd/sql-construct-insert name d))
(new-acc (or acc "begin transaction;")) data)))))
(new-acc (concat new-acc tbl-data-str))) (ins (mapcar (lambda (tbl) (funcall scan-tbl tbl)) all-data))
(nd/sql-construct-insert-transaction rem new-acc)))) (ins (string-join ins)))
(concat "begin transaction;" ins "commit;")))
(defun nd/sql-insert (db tbl-name tbl-data) (defun nd/sql-insert (db tbl-name tbl-data)
"Insert list TBL-DATA into TBL-NAME in sqlite database DB." "Insert list TBL-DATA into TBL-NAME in sqlite database DB."
@ -2734,6 +2742,26 @@ Does not actually execute the string."
(defun nd/sql-insert-multi (db all-data) (defun nd/sql-insert-multi (db all-data)
"Insert ALL-DATA into sqlite DB." "Insert ALL-DATA into sqlite DB."
(nd/sql-cmd db (nd/sql-construct-insert-transaction all-data))) (nd/sql-cmd db (nd/sql-construct-insert-transaction all-data)))
(defun nd/alist-put (alist prop value &optional front)
"For given ALIST, append VALUE to the current values in prop.
Current values (that is the cdr of each key) is assumed to be a list.
If PROP does not exist, create it. Return the new alist. If FRONT is
t, add to the front of current values list instead of the back."
(let* ((cur-cell (assoc prop alist))
(cur-values (cdr cur-cell)))
(cond
(cur-values
(let ((new-cdr (if front
`(,value ,@cur-values)
`(,@cur-values ,value))))
(setcdr cur-cell new-cdr) alist))
(cur-cell
(setcdr cur-cell `(,value)) alist)
(alist
(append alist `((,prop ,value))))
(t
`((,prop ,value))))))
#+END_SRC #+END_SRC
**** org parsing function **** org parsing function
Basic functions to parse org strings Basic functions to parse org strings
@ -2803,12 +2831,13 @@ PRIMARY KEY (archive_file_path, headline_file_offset, tag, inherited));"
"CREATE TABLE properties ( "CREATE TABLE properties (
archive_file_path TEXT, archive_file_path TEXT,
headline_file_offset INTEGER, headline_file_offset INTEGER,
property_file_offset INTEGER PRIMARY KEY, property_file_offset INTEGER,
key_text TEXT NOT NULL, key_text TEXT NOT NULL,
val_text TEXT NOT NULL, val_text TEXT NOT NULL,
inherited BOOLEAN, inherited BOOLEAN,
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),
PRIMARY KEY (archive_file_path ASC, property_file_offset ASC));"
"Schema to build the properties table in the org archive db.") "Schema to build the properties table in the org archive db.")
(defconst nd/org-sqlite-clocking-schema (defconst nd/org-sqlite-clocking-schema
@ -2816,7 +2845,7 @@ REFERENCES headlines (archive_file_path, headline_file_offset));"
archive_file_path TEXT, archive_file_path TEXT,
headline_file_offset INTEGER, headline_file_offset INTEGER,
clock_file_offset INTEGER, clock_file_offset INTEGER,
time_start DATE NOT NULL, time_start DATE,
time_end DATE, time_end DATE,
clock_note TEXT, clock_note TEXT,
FOREIGN KEY (archive_file_path, headline_file_offset) FOREIGN KEY (archive_file_path, headline_file_offset)
@ -2830,6 +2859,7 @@ archive_file_path TEXT,
headline_file_offset INTEGER, headline_file_offset INTEGER,
entry_file_offset INTEGER, entry_file_offset INTEGER,
time_logged DATE, time_logged DATE,
header TEXT,
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),
@ -2871,14 +2901,16 @@ If ISO is t, return the timestamp in ISO 8601 format."
(let ((raw-ts (org-element-property :raw-value ts))) (let ((raw-ts (org-element-property :raw-value ts)))
(if iso (nd/org-ts-format-to-iso raw-ts) raw-ts)))))) (if iso (nd/org-ts-format-to-iso raw-ts) raw-ts))))))
(defun nd/org-element-find-type (type obj) ;; TODO this is entirely redundant and can be replaced with assoc
"Find and return the first instance of TYPE in OBJ. ;; (defun nd/org-element-find-type (type obj)
TYPE is an org element type symbol and OBJ is a list of elements/objects." ;; "Find and return the first instance of TYPE in OBJ.
(let ((obj-cur (car obj)) ;; TYPE is an org element type symbol and OBJ is a list of elements/objects."
(obj-rem (cdr obj))) ;; (when obj
(if (eq type (org-element-type obj-cur)) ;; (let ((obj-cur (car obj))
obj-cur ;; (obj-rem (cdr obj)))
(nd/org-element-find-type type obj-rem)))) ;; (if (eq type (org-element-type obj-cur))
;; obj-cur
;; (nd/org-element-find-type type obj-rem)))))
(defun nd/org-element-get-parent-type (type obj) (defun nd/org-element-get-parent-type (type obj)
"Return parent element of type TYPE for OBJ or nil if not found." "Return parent element of type TYPE for OBJ or nil if not found."
@ -2944,50 +2976,6 @@ 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-partition-headline (headline)
"For a given org-element HEADLINE, return a sorted plist.
The plist will be structured as such:
:planning '(data)
:logbook-drawer '(data)
:property-drawer '(data)
:headline-contents '(data)
:subheadings (list of subheadings)
The planning entry will have the list of data associated with the
:planning property, and likewise with property-drawer. logbook-drawer
will be a drawer that is explicitly named `org-log-into-drawer' or
nil if not set. other-contents includes all other elements including
other drawers, list, paragraph elements, etc. If any of these groups
are missing, nil will be returned."
(when headline
(let ((hl-contents (org-element-contents headline)))
(if (eq 'headline (org-element-type (car hl-contents)))
;; return just a plist of subheadings if there is no section
(list :subheadings hl-contents)
(let* ((sec-contents (org-element-contents (car hl-contents)))
(subheadings (cdr hl-contents))
(init-plist (list :subheadings subheadings))
(get-pkey
(lambda (obj)
(let ((type (org-element-type obj)))
(cond
((eq 'planning type) :planning)
((eq 'property-drawer type) :property-drawer)
((and (eq 'drawer type)
(equal (org-element-property :drawer-name obj)
org-log-into-drawer))
:logbook-drawer)
(t :headline-contents)))))
(sort-contents
(lambda (contents &optional acc)
(let*
((cur (car contents))
(rem (cdr contents))
(pkey (funcall get-pkey cur))
(new-acc (nd/plist-put-append acc pkey cur)))
(if rem (funcall sort-contents rem new-acc) new-acc)))))
(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
@ -3010,12 +2998,9 @@ See `org-use-tag-inheritance'.")
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-header (header-text) (defun nd/org-logbook-match-header (header-text)
"Test if ENTRY-STR matches `nd/org-log-note-headings-regexp'. "Attempts to match HEADER-TEXT with `nd/org-log-note-headings-regexp'.
If match successful, returns plist with the following: If match successful, returns list whose car is the match type
and cdr is the match data."
: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
@ -3027,44 +3012,7 @@ If match successful, returns plist with the following:
type type
(funcall scan str rem)))))) (funcall scan str rem))))))
(type (funcall scan header-text nd/org-log-note-headings-regexp))) (type (funcall scan header-text nd/org-log-note-headings-regexp)))
(when type (list :type type :match-data (match-data))))) (when type (cons type (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 ()
@ -3133,6 +3081,102 @@ of the escapes."
"Like `org-log-note-headings' but has regexp's instead of "Like `org-log-note-headings' but has regexp's instead of
escape sequences.") escape sequences.")
#+END_SRC #+END_SRC
**** org sql partioning functions
#+BEGIN_SRC emacs-lisp
(defun nd/org-sql-partion-headling-section (contents &optional acc)
"Partition list of org-elements CONTENTS into accumulator ACC.
When finished return ACC. ACC will hold an alist structured as described
in `nd/org-element-partition-headline', except this function does not
deal with the subheadings or headline-properties."
(if (not contents)
acc
(let* ((cur (car contents))
(rem (cdr contents))
(type (org-element-type cur))
(acc*
(cond
((eq type 'planning)
(nd/alist-put acc :planning cur))
((eq type 'property-drawer)
;; TODO maybe filter for non-node-props here???
(let ((node-props (org-element-contents cur)))
(nd/alist-put acc :node-props node-props)))
((eq type 'drawer)
(let ((name (org-element-property :drawer-name cur)))
(if (equal name org-log-into-drawer)
(let ((lb-contents (org-element-contents cur)))
(nd/alist-put acc :logbook lb-contents))
(nd/alist-put acc :hl-contents cur))))
(t (nd/alist-put acc :hi-contents cur)))))
(nd/org-sql-partion-headling-section rem acc*))))
(defun nd/org-sql-partition-headline (headline fp)
"For org-element HEADLINE and file path FP, return an alist.
The alist will be structured as such:
:filepath - path to the file in which the headline resides
:headline - original headline element
:section - the section contents of the headline if found
:subheadlines - list of subheadlines if any
The planning entry will have the list of data associated with the
:planning property, and likewise with property-drawer. logbook-drawer
will be a drawer that is explicitly named `org-log-into-drawer' or
nil if not set. other-contents includes all other elements including
other drawers, list, paragraph elements, etc. If any of these groups
are missing, nil will be returned."
(unless headline (error "No headline given"))
(unless fp (error "No file path given"))
(let* ((hl-contents (org-element-contents headline))
(section (assoc 'section hl-contents))
(section (org-element-contents section))
(subheadlines (if section (cdr hl-contents) hl-contents)))
`((:headline . ,headline)
(:filepath . ,fp)
(:section . ,section)
(:subheadlines . ,subheadlines))))
;; (when section
;; (let ((sec-contents (org-element-contents section)))
;; (nd/org-sql-partion-headling-section sec-contents hl-part)))))
(defun nd/org-sql-partition-item (item hl-part)
"Parse an org-element ITEM which is assumed to be part of a logbook.
Returns a alist with the following structure:
:hl-part - the partitioned headline HL-PART surrounding the item,
which is an object as described in `nd/org-sql-partition-headline'
:item - the original item element
:header-text - the first line of the note which is standardized using
`org-log-note-headings'
: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)
:type - the type of the item's header text (may be nil if unknown)
:match-data - match data associated with finding the type as done
using `nd/org-log-note-headings-regexp' (may be nil if undetermined).
Anatomy of a logbook item (non-clocking):
- header-text with linebreak //
note-text ... more text
- another header-text linebreak
The header text is solely used for determining :type and :match-data."
(let* ((paragraph (assoc '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))))
(header-match (nd/org-logbook-match-header header-text)))
`((:item . ,item)
(:hl-part . ,hl-part)
(:header-text . ,header-text)
(:note-text . ,note-text)
(:type . ,(car header-match))
(:match-data . ,(cdr header-match)))))
#+END_SRC
**** org sql db function **** org sql db function
These are the main functions to populate the db. These are the main functions to populate the db.
#+BEGIN_SRC emacs-lisp #+BEGIN_SRC emacs-lisp
@ -3148,319 +3192,352 @@ 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-note-header-to-sql (parsed-item &optional acc) (defun nd/org-sql-extract-lb-header (item-part &optional acc)
"Add data from PARSED-ITEM to ACC depending on its type." "Add specific data from logbook entry ITEM-PART to accumulator ACC.
(let ((type (plist-get parsed-item :type)) ITEM-PART is a partitions logbook item as described in
(archive-file-path (plist-get parsed-item :archive-file-path)) `nd/org-sql-partition-item'. Note headings are parsed according to
(entry-file-offset (plist-get parsed-item :offset)) how they match those generated by `org-log-note-headings', and
(header-text (plist-get parsed-item :header-text))) nothing is added if a match is not found."
(let* ((hl-part (alist-get :hl-part item-part))
(hl (alist-get :headline hl-part))
(fp (alist-get :filepath hl-part))
(item (alist-get :item item-part))
(item-offset (org-element-property :begin item))
(type (alist-get :type item-part))
(md (alist-get :match-data item-part))
(header-text (alist-get :header-text item-part)))
;; TODO, make these adapt to the value of org-log-note-headings?? ;; TODO, make these adapt to the value of org-log-note-headings??
(set-match-data md)
(cond (cond
((eq type 'state) ((eq type 'state)
(let* ((state-old (match-string 3 header-text)) (let* ((state-old (match-string 3 header-text))
(state-new (match-string 1 header-text)) (state-new (match-string 1 header-text))
(state-data (list archive-file-path (state-data (list :archive_file_path fp
entry-file-offset :entry_file_offset item-offset
state-old :state_old state-old
state-new))) :state_new state-new)))
(nd/plist-put-list acc 'state_changes state-data))) (nd/alist-put acc 'state_changes state-data)))
((memq type '(reschedule delschedule redeadline deldeadline)) ((memq type '(reschedule delschedule redeadline deldeadline))
(let* ((time-old (nd/org-ts-format-to-iso (let* ((time-old (nd/org-ts-format-to-iso
(match-string 1 header-text))) (match-string 1 header-text)))
(planning-kw (if (memq type '(reschedule delschedule)) (planning-kw (if (memq type '(reschedule delschedule))
:scheduled :scheduled
:deadline)) :deadline))
(parent-hl (plist-get parsed-item :parent-headline)) (time-new (nd/org-element-timestamp-raw planning-kw hl t))
(time-new (nd/org-element-timestamp-raw planning-kw parent-hl t))
(time-new (nd/org-ts-format-to-iso time-new))
(planning-type (if (eq :scheduled planning-kw) "s" "d")) (planning-type (if (eq :scheduled planning-kw) "s" "d"))
(planning-data (list archive-file-path (planning-data (list :archive_file_path fp
entry-file-offset :entry_file_offset item-offset
time-old :time_old time-old
time-new :time_new time-new
planning-type))) :planning_type planning-type)))
(nd/plist-put-list acc 'planning_changes planning-data))) (nd/alist-put acc 'planning_changes planning-data)))
;; no action required for these ;; no action required for these
((memq type '(done refile note)) acc) ((memq type '(done refile note)) acc)
;; header type not determined, therefore do nothing ;; header type not determined, therefore do nothing
(t acc)))) (t acc))))
(defun nd/org-element-note-get-time-logged (parsed-item) ;; TODO this gets called for clock notes?
"Return time-logged of PARSED-ITEM or nil if it cannot be determined." (defun nd/org-element-note-get-time-logged (item-part)
(set-match-data (plist-get parsed-item :match-data)) "Return time-logged of ITEM-PART or nil if it cannot be determined.
(let* ((type (plist-get parsed-item :type)) ITEM-PART is a partitioned logbook item as described in
`nd/org-sql-partition-item'."
(let* ((type (alist-get :type item-part))
(time-index (time-index
(cond (cond
((memq type '(done note refile)) 1) ((memq type '(done note refile)) 1)
((memq type '(reschedule delschedule redeadline deldeadline)) 3) ((memq type '(reschedule delschedule redeadline deldeadline)) 3)
((eq type 'state) 5))) ((eq type 'state) 5)))
(header-text (plist-get parsed-item :header-text))) (header-text (alist-get :header-text item-part)))
(when time-index (when time-index
(set-match-data (alist-get :match-data item-part))
(nd/org-ts-format-to-iso (match-string time-index header-text))))) (nd/org-ts-format-to-iso (match-string time-index header-text)))))
(defun nd/org-element-note-to-sql (parsed-item &optional acc) (defun nd/org-sql-extract-lb-entry (item-part &optional acc)
"Add logbook common data from PARSED-ITEM to ACC." "Add data from logbook entry ITEM-PART to accumulator ACC.
ITEM-PART is a partitioned logbook item as described in
`nd/org-sql-partition-item'."
(let* ((hl-part (alist-get :hl-part item-part))
(fp (alist-get :filepath hl-part))
(hl (alist-get :headline hl-part))
(item (alist-get :item item-part))
(hl-offset (org-element-property :begin hl))
(item-offset (org-element-property :begin item))
(time-logged (nd/org-element-note-get-time-logged item-part))
(hdr-text (alist-get :header-text item-part))
(note-text (alist-get :note-text item-part))
(logbook-data (list :archive_file_path fp
:headline_file_offset hl-offset
:entry_file_offset item-offset
:time_logged time-logged
:header hdr-text
:note note-text))
(acc* (nd/alist-put acc 'logbook logbook-data)))
(nd/org-sql-extract-lb-header item-part acc*)))
(let* ((archive-file-path (plist-get parsed-item :archive-file-path)) (defun nd/org-sql-add-note-to-clock (clock-data item-part &optional acc)
(headline-file-offset (plist-get parsed-item :headline-file-offset)) "Add ITEM-PART to CLOCK-DATA and add to accumulator ACC.
(entry-file-offset (plist-get parsed-item :offset)) ITEM-PART is a partitions logbook item as described in
(time-logged (nd/org-element-note-get-time-logged parsed-item)) `nd/org-sql-partition-item'."
(note-text (plist-get parsed-item :header-text)) (let* ((header-text (alist-get :header-text item-part))
(logbook-data (list archive-file-path (clock-data* `(,@clock-data :clock_note ,header-text)))
headline-file-offset (nd/alist-put acc 'clocking clock-data*)))
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) (defun nd/org-logbook-parse-timestamp-range (ts)
"Return start and end of timestamp TS depending on if it is a range. "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." Return value will be a list of two elements if range and one if not."
(when ts (when ts
(let ((time-start (nd/org-ts-format-to-iso (org-timestamp-split-range ts)))) (let ((convert
(when time-start (lambda (ts &optional end)
(let* ((type (org-element-property :type ts)) (nd/org-ts-format-to-iso
(time-end (org-element-property
(when (eq type 'inactive-range) :raw-value
(nd/org-ts-format-to-iso (org-timestamp-split-range ts t))))) (org-timestamp-split-range ts end))))))
(cons time-start time-end)))))) (if (eq (org-element-property :type ts) 'inactive-range)
(let ((start (funcall convert ts))
(end (funcall convert ts t)))
(cons start end))
`(,(funcall convert ts))))))
(defun nd/org-element-clock-to-sql (clock archive-file-path (defun nd/org-sql-extract-lb-clock (clock hl-part &optional acc item)
headline-file-offset) "Add data from logbook CLOCK to accumulator ACC.
"Parse org-element CLOCK and return a list of extracted data. HL-PART is an object as returned by `nd/org-sql-partition-headline'
ARCHIVE-FILE-PATH and HEADLINE-FILE-OFFSET are the file path and file and represents the headline surrounding the clock.
offset of the property's parent headline in the org file." If ITEM is provided, check that this is a valid note that can be
(let* ((clock-file-offset (org-element-property :begin clock)) added to the clock, else add it as a normal logbook entry."
(let* ((hl (alist-get :headline hl-part))
(fp (alist-get :filepath hl-part))
(hl-offset (org-element-property :begin hl))
(cl-offset (org-element-property :begin clock))
(ts-obj (org-element-property :value clock)) (ts-obj (org-element-property :value clock))
(ts-range (nd/org-logbook-parse-timestamp-range ts-obj)) (ts-range (nd/org-logbook-parse-timestamp-range ts-obj))
(time-start (car ts-range)) (start (car ts-range))
(time-end (cdr ts-range))) (end (cdr ts-range))
(list archive-file-path (clock-data (list :archive_file_path fp
headline-file-offset :headline_file_offset hl-offset
clock-file-offset :clock_file_offset cl-offset
time-start :time_start start
time-end))) :time_end end)))
(if (not item)
(nd/alist-put acc 'clocking clock-data)
(let* ((item-part (nd/org-sql-partition-item item hl-part))
(item-type (alist-get :type item-part)))
(if item-type
(let ((acc* (nd/alist-put acc 'clocking clock-data)))
(nd/org-sql-extract-lb-entry item-part acc*))
(nd/org-sql-add-note-to-clock clock-data item-part acc))))))
(defun nd/org-element-logbook-items-to-sql (items archive-file-path (defun nd/org-sql-extract-lb-items (items hl-part &optional acc)
headline-file-offset "Add data from logbook ITEMS to accumulator ACC.
&optional acc HL-PART is an object as returned by `nd/org-sql-partition-headline'
last-clock) and represents the headline surrounding the items."
"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) (if (not items)
acc acc
(let* ((cur (car items)) (let* ((cur (car items))
(rem (cdr items)) (rem (cdr items))
(parsed-item (nd/org-logbook-parse-item cur (item-part (nd/org-sql-partition-item cur hl-part))
archive-file-path (acc* (nd/org-sql-extract-lb-entry item-part acc)))
headline-file-offset)) (nd/org-sql-extract-lb-items rem hl-part acc*))))
(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 (defun nd/org-sql-extract-lb-one (entry hl-part &optional acc)
headline-file-offset "Add data from logbook ENTRY to accumulator ACC.
&optional acc HL-PART is an object as returned by `nd/org-sql-partition-headline'
last-clock) and represents the headline surrounding the entry."
"Loop through logbook entries LB-CONTENTS and insert data into ACC. (let ((type (org-element-type entry)))
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 (cond
((eq 'plain-list type) ((eq type 'clock)
(let* ((items (org-element-contents cur)) (nd/org-sql-extract-lb-clock entry hl-part acc))
(new-acc ((eq type 'plain-list)
(nd/org-element-logbook-items-to-sql items (let ((items (org-element-contents entry)))
archive-file-path (nd/org-sql-extract-lb-items items hl-part acc)))
headline-file-offset ;; TODO add an "UNKNOWN" logbook parser
acc (t 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 ;; TODO this triggers a sql syntax error when the note is not a clock note
headline-file-offset (defun nd/org-sql-extract-lb-two (entry1 entry2 hl-part &optional acc)
&optional acc) "Add data from logbook ENTRY1 and ENTRY2 to accumulator ACC.
"Add data from NODE-PROPS to accumulator sql-data plist ACC. HL-PART is an object as returned by `nd/org-sql-partition-headline'
ARCHIVE-FILE-PATH and HEADLINE-FILE-OFFSET are the file path and file and represents the headline surrounding the entries. This assumes the
offset of the property's parent headline in the org file." entries are org-element types clock and plain-list respectively, and
will check if the first item in ENTRY2 is part of the clock."
(let* ((items (org-element-contents entry2))
(first-item (car items))
(rem-items (cdr items))
(acc* (nd/org-sql-extract-lb-clock entry1 hl-part acc first-item)))
(nd/org-sql-extract-lb-items rem-items hl-part acc*)))
(defun nd/org-sql-find-logbook (contents)
"Find the logbook drawer given CONTENTS from section of org headline.
Returns a list of the contents in the logbook. Note this assumes
the `org-log-into-drawer' is set and that there is one drawer per
headline matching this value. Additional logbook drawers will be
ignored."
(org-element-contents
(rassoc-if
(lambda (e)
(equal org-log-into-drawer (plist-get (car e) :drawer-name)))
contents)))
(defun nd/org-sql-extract-lb (hl-part &optional acc)
"Add logbook data from HL-PART and add to accumulator ACC.
HL-PART is an object as returned by `nd/org-sql-partition-headline'."
(let* ((sec (alist-get :section hl-part))
(lb-contents (nd/org-sql-find-logbook sec))
(scan
(lambda (contents &optional acc)
(if (not contents)
acc
;; Need two of the next entries here because clocks may
;; have notes associated with them, but the only
;; distinguishing characteristic they have is that they
;; don't match anything in org-log-note-headings. If we
;; end up processing two entries at once, skip over two
;; instead of one on the next iteration.
(let* ((cur1 (car contents))
(cur2 (cadr contents))
(type1 (org-element-type cur1))
(type2 (org-element-type cur2))
(try-clock-note (and (eq 'clock type1)
(eq type2 'plain-list)))
(acc*
(if try-clock-note
(nd/org-sql-extract-lb-two cur1 cur2 hl-part acc)
(nd/org-sql-extract-lb-one cur1 hl-part acc)))
(rem (if try-clock-note (cddr contents) (cdr contents))))
(funcall scan rem acc*))))))
(funcall scan lb-contents acc)))
(defun nd/org-sql-extract-properties (hl-part &optional acc)
"Add properties data from HL-PART and add to accumulator ACC.
HL-PART is an object as returned by `nd/org-sql-partition-headline'."
(let* ((hl (alist-get :headline hl-part))
(sec (alist-get :section hl-part))
(prop-drawer (assoc 'property-drawer sec))
(node-props (org-element-contents prop-drawer))
(scan
(lambda (node-props hl-part &optional acc)
(if (not node-props) (if (not node-props)
acc acc
(let* ((cur (car node-props)) (let* ((cur (car node-props))
(rem (cdr node-props)) (rem (cdr node-props))
(key-text (org-element-property :key cur)) (hl (alist-get :headline hl-part))
(new-acc (fp (alist-get :filepath hl-part))
(if (member key-text nd/org-sql-ignored-properties) (offset (org-element-property :begin hl))
acc (np-offset (org-element-property :begin cur))
(let* ((property-file-offset (org-element-property :begin cur)) (key (org-element-property :key cur))
(val-text (org-element-property :value cur)) (val (org-element-property :value cur))
(prop-data (list archive-file-path (prop-data (list :archive_file_path fp
headline-file-offset :headline_file_offset offset
property-file-offset :property_file_offset np-offset
key-text :key_text key
val-text :val_text val
;; TODO add inherited flag ;; TODO add inherited flag
nil))) :inherited nil))
(nd/plist-put-list acc 'properties prop-data))))) (acc*
(nd/org-element-property-to-sql rem (if (member key nd/org-sql-ignored-properties)
archive-file-path acc
headline-file-offset (nd/alist-put acc 'properties prop-data))))
new-acc)))) (funcall scan rem hl-part acc*))))))
(nd/org-sql-extract-property node-props hl-part acc)))
(defun nd/org-element-tags-to-sql (headline archive-file-path (defun nd/org-sql-extract-tags (hl-part &optional acc)
headline-file-offset "Add tags data from HL-PART and add to accumulator ACC.
&optional acc) HL-PART is an object as returned by `nd/org-sql-partition-headline'."
"Add tags to sql-data plist ACC from HEADLINE. (let* ((hl (alist-get :headline hl-part))
ARCHIVE-FILE-PATH and HEADLINE-FILE-OFFSET are the file path and file (tags (org-element-property :tags hl))
offset of the property's parent headline in the org file." (tags (mapcar #'nd/strip-string tags))
(let* ((insert-tags ;; then retrieve i-tags, optionally going up to parents
(lambda (tags a h i acc) (i-tags (org-element-property :ARCHIVE_ITAGS hl))
(i-tags (when i-tags (split-string i-tags)))
(i-tags (if nd/org-sql-use-tag-inheritance
(nd/org-element-get-parent-tags hl i-tags)
i-tags))
(scan
(lambda (tags hl-part &optional acc inherited)
(if (not tags) (if (not tags)
acc acc
(let* ((cur (car tags)) (let* ((cur (car tags))
(rem (cdr tags)) (rem (cdr tags))
(tags-data (list a h cur i)) (hl (alist-get :headline hl-part))
(new-acc (nd/plist-put-list acc 'tags tags-data))) (fp (alist-get :filepath hl-part))
(funcall insert-tags rem a h i new-acc) new-acc)))) (offset (org-element-property :begin hl))
;; first insert all headline tags into acc (i (if inherited 1 0))
(tags (mapcar #'nd/strip-string (org-element-property :tags headline))) (tags-data (list :archive_file_path fp
(new-acc (funcall insert-tags :headline_file_offset offset
tags :tag cur
archive-file-path :inherited i))
headline-file-offset (acc* (nd/alist-put acc 'tags tags-data)))
0 (funcall scan rem hl-part acc* inherited)))))
acc)) (acc* (funcall scan tags hl-part acc)))
;; then retrieve i-tags, optionally going up to parents (funcall scan i-tags hl-part acc* t)))
(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 (defun nd/org-sql-extract-headline (hl-part &optional acc)
&optional acc) "Add general data from headline HL-PART to accumulator ACC.
"Parse list of org-elements HEADLINES and insert data into ACC. HL-PART is an object as returned by `nd/org-sql-partition-headline'."
ARCHIVE-FILE-PATH is the file path to the currently parsed archive file." (let* ((fp (alist-get :filepath hl-part))
(if (not headlines) (hl (alist-get :headline hl-part))
acc (offset (org-element-property :begin hl))
(let* ((cur (car headlines)) (rxv-tp (nd/org-element-get-parent-tree hl))
(rem (cdr headlines)) (src-fp (nd/org-element-property-inherited :ARCHIVE_FILE hl))
(headline-file-offset (org-element-property :begin cur)) (src-tp (nd/org-element-property-inherited :ARCHIVE_OLPATH hl))
(archive-tree-path (nd/org-element-get-parent-tree cur)) (hl-txt (org-element-property :raw-value hl))
;; insert data for headlines table (t-created (org-element-property :CREATED hl))
(source-file-path (nd/org-element-property-inherited :ARCHIVE_FILE cur)) (t-created (nd/org-ts-format-to-iso t-created))
(source-tree-path (nd/org-element-property-inherited :ARCHIVE_OLPATH cur)) (t-closed (nd/org-element-timestamp-raw :closed hl t))
(headline-text (org-element-property :raw-value cur)) (t-scheduled (nd/org-element-timestamp-raw :scheduled hl t))
(time-created (org-element-property :CREATED cur)) (t-deadline (nd/org-element-timestamp-raw :deadline hl t))
(time-created (nd/org-ts-format-to-iso time-created)) (kw (nd/strip-string (org-element-property :todo-keyword hl)))
(time-closed (nd/org-element-timestamp-raw :closed cur t)) (effort (org-element-property :EFFORT hl))
(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)) (effort (nd/org-effort-to-int effort t))
(priority (org-element-property :priority cur)) (priority (org-element-property :priority hl))
(hl-part (nd/org-element-partition-headline cur)) ;; data for children ;; TODO, add contents somehow
(hl-contents (plist-get hl-part :headline-contents)) ;; (hl-contents (plist-get hl-part :hl-contents))
;; (hl-contents-text (org-element-interpret-data hl-contents)) ;; (hl-contents-text (org-element-interpret-data hl-contents))
;; (hl-contents-text (when hl-contents-text ;; (hl-contents-text (when hl-contents-text
;; (string-trim ;; (string-trim
;; (substring-no-properties hl-contents-text)))) ;; (substring-no-properties hl-contents-text))))
(hl-data (list archive-file-path (hl-data (list :archive_file_path fp
headline-file-offset :headline_file_offset offset
archive-tree-path :archive_tree_path rxv-tp
source-file-path :source_file_path src-fp
source-tree-path :source_tree_path src-tp
headline-text :headline_text hl-txt
time-created :time_created t-created
time-closed :time_closed t-closed
time-scheduled :time_scheduled t-scheduled
time-deadline :time_deadlined t-deadline
keyword :keyword kw
effort :effort effort
priority :priority priority
nil)) :content nil)))
(new-acc (nd/plist-put-list acc 'headlines hl-data)) (nd/alist-put acc 'headlines hl-data)))
;; insert data for tags table
(new-acc (nd/org-element-tags-to-sql cur (defun nd/org-sql-extract-headlines-all (headlines fp &optional acc)
archive-file-path "Extract data from HEADLINES and add to accumulator ACC.
headline-file-offset FP is the file path containing the headlines."
new-acc)) (if (not headlines)
;; insert data for property table acc
(property-drawer (plist-get hl-part :property-drawer)) (let* ((cur (car headlines))
(node-props (org-element-contents property-drawer)) (rem (cdr headlines))
(new-acc (nd/org-element-property-to-sql node-props (hl-part (nd/org-sql-partition-headline cur fp))
archive-file-path (hl-sub (alist-get :subheadlines hl-part))
headline-file-offset (acc* (nd/org-sql-extract-headline hl-part acc))
new-acc)) ;; (acc* (nd/org-sql-extract-tags hl-part acc*))
;; insert data for logbook table ;; (acc* (nd/org-sql-extract-properties hl-part acc*))
(lb-drawer (plist-get hl-part :logbook-drawer)) (acc* (nd/org-sql-extract-lb hl-part acc*))
(lb-contents (org-element-contents lb-drawer)) (acc* (nd/org-sql-extract-headlines-all hl-sub fp acc*)))
(new-acc (nd/org-element-logbook-to-sql lb-contents (nd/org-sql-extract-headlines-all rem fp acc*))))
archive-file-path
headline-file-offset
new-acc))
;; insert data for subheadings under this one
(subheadings (plist-get hl-part :subheadings))
(new-acc (nd/org-element-header-to-sql subheadings
archive-file-path
new-acc)))
(nd/org-element-header-to-sql rem archive-file-path new-acc))))
(defun nd/org-sql-extract () (defun nd/org-sql-extract ()
"Return a plist of data to be inserted into sql database." "Return a plist of data to be inserted into sql database."
(let* ((rxv-path (expand-file-name "test.org_archive" org-directory)) (let* ((rxv-path (expand-file-name "test.org_archive" org-directory))
;; TODO files need to be already open???
(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)) (contents (org-element-contents tree))
(headlines (if (eq 'section (org-element-type (car contents))) (headlines (if (eq 'section (org-element-type (car contents)))
(cdr contents) (cdr contents)
contents))) contents)))
(nd/org-element-header-to-sql headlines rxv-path))) (nd/org-sql-extract-headlines-all headlines rxv-path)))
(defun nd/org-archive-to-db () (defun nd/org-archive-to-db ()
"Transfer archive files to sqlite database." "Transfer archive files to sqlite database."