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

added pragma interface, stripped tags text props, made slqi buffer connection

This commit is contained in:
ndwarshuis 2019-01-02 02:20:14 -05:00
parent e0a3f89e63
commit 1e0048a16a
1 changed files with 139 additions and 173 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

312
conf.org
View File

@ -776,6 +776,7 @@ Org has several extensions in the form of loadable modules. =org-protocol= is us
(require 'org-agenda)
(require 'org-protocol)
(require 'org-habit)
(require 'dash)
#+END_SRC
*** directory
I keep all my org files in one place.
@ -2683,6 +2684,17 @@ Org mode is great and all, but in many cases, text files just won't cut it. Hard
These are =org-mode=-agnostic functions that pertain to sql. They are basically just simple interfaces for shell commands.
#+BEGIN_SRC emacs-lisp
(require 'sql)
;;(require 'dash)
(defmacro nd/org-sql-> (&rest body)
(let ((result (pop body)))
(dolist (form body result)
(setq result (append (list (car form) result) (cdr form))))))
(defmacro nd/org-sql->> (&rest body)
(let ((result (pop body)))
(dolist (form body result)
(setq result (append form (list result))))))
;; this needs a better home :/
(defun nd/alist-put (alist prop value &optional front)
@ -2711,21 +2723,6 @@ t, add to the front of current values list instead of the back."
"Return all the values in PLIST."
(-slice plist 1 nil 2))
;; (defun nd/sql-construct-insert-transaction (all-data)
;; "Construct transaction string to insert ALL-DATA into SQL.
;; Does not actually execute the string."
;; (let* ((scan-tbl
;; (lambda (tbl)
;; (let ((name (car tbl))
;; (data (cdr tbl)))
;; (string-join (mapcar
;; (lambda (d)
;; (nd/sql-construct-insert name d))
;; data)))))
;; (ins (mapcar (lambda (tbl) (funcall scan-tbl tbl)) all-data))
;; (ins (string-join ins)))
;; (format "begin transaction; %s commit;" ins)))
;; SQL string parsing functions
(defun nd/sql-to-plist (out &rest cols)
"Parse SQL output string OUT to an plist representing the data.
@ -2741,9 +2738,15 @@ COLS are the column names as symbols used to obtain OUT."
"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
sql command string is in double quotes."
(let* ((new-txt (replace-regexp-in-string "'" "''" txt nil t))
(new-txt (replace-regexp-in-string "\"" "\\\"" new-txt nil t)))
(concat "'" new-txt "'")))
(nd/org-sql->>
txt
(replace-regexp-in-string "'" "''")
(replace-regexp-in-string "\n" "'||char(10)||'")
(format "'%s'")))
;; (let* ((new-txt (replace-regexp-in-string "'" "''" txt))
;; (new-txt (replace-regexp-in-string "\n" "'||char(10)||'" new-txt)))
;; ;; (new-txt (replace-regexp-in-string "\"" "\\\"" new-txt nil t)))
;; (concat "'" new-txt "'")))
(defun nd/sql-to-string (entry)
"Convert ENTRY to a string suitable for insertion into SQLite db.
@ -2815,20 +2818,79 @@ from a plist like '(:prop1 value1 :prop2 value2)."
(defun nd/org-sql-fmt-deletes (tbl)
(nd/org-sql-fmt-multi tbl #'nd/org-sql-fmt-delete))
(defun nd/org-sql-fmt-pragma (plist)
"Creates a SQL statement for setting pragmas in PLIST.
PLIST contains the pragmas as the properties and their intended
values as the property values."
(let ((pragmas (nd/org-sql->>
plist
(plist-get-keys)
(mapcar #'nd/sql-kw-to-colname))))
(nd/org-sql->>
plist
(nd/sql-plist-get-vals)
(mapcar* (lambda (p v) (format "PRAGMA %s=%s;" p v)) pragmas)
(string-join))))
;; SQL command abstractions
(defun nd/sql-cmd (db cmd &optional show-err foreign-keys)
"Execute string CMD on database DB executing `sql-sqlite-program'.
Returns the output of CMD. SQL should not contain any quotes as if it
were entered on the shell."
(when cmd
(let* ((err (if show-err "" " 2> /dev/null"))
(pragma (if foreign-keys
"PRAGMA foreign_keys = ON;"
"PRAGMA foreign_keys = OFF;"))
;; TODO, there has to be a better way to fix this foreign key bs
(cmd (format "%s %s \"%s%s\"%s" sql-sqlite-program db pragma cmd err)))
(shell-command-to-string cmd))))
(defconst nd/org-sql-default-pragma
'(:foreign_keys on :defer_foreign_keys on)
"Default pragmas used when calling `nd/sql-cmd'")
(defconst nd/org-sql-buffer "*SQL: Org*"
"Name of the SQLi buffer connected to the database.")
(defconst nd/org-sql-debug-buffer "*SQL: Org-Debug*"
"Name of the SQLi buffer connected to the database.")
(defun nd/org-sql-open-connection ()
"Open a new SQL connection to `nd/org-sqlite-db-path'.
This also sets the pragma according to `nd/org-sql-default-pragma'."
(nd/with-advice
((#'sql-get-login :override #'ignore)
(#'pop-to-buffer :override #'ignore))
(let ((sql-database nd/org-sqlite-db-path))
(sql-sqlite nd/org-sql-buffer)
(nd/org-sql-set-pragma))))
(defun nd/org-sql-pragma-merge-default (&optional pragma)
"Override values in `nd/org-sql-default-pragma' with PRAGMA.
PRAGMA is a plist as described in `nd/org-sql-fmt-pragma'. Return a
new plist with values from PRAGMA either added (if they don't already
exist) to or instead of (if they already exist) those in
`nd/org-sql-default-pragma'."
(if (not pragma)
nd/org-sql-default-pragma
(let ((all-props
(nd/org-sql->>
nd/org-sql-default-pragma
(plist-get-keys)
(append (plist-get-keys pragma))
(delete-dups)))
(getv
(lambda (p)
(or (plist-get pragma p)
(plist-get nd/org-sql-default-pragma p)))))
(mapcan (lambda (p) `(,p ,(funcall getv p))) all-props))))
(defun nd/org-sql-set-pragma (&optional pragma)
(nd/org-sql->>
pragma
(nd/org-sql-pragma-merge-default)
(nd/org-sql-fmt-pragma)
(nd/sql-cmd)))
(defun nd/sql-cmd (cmd)
"Execute SQL string CMD in SQLi buffer given by `nd/org-sql-buffer'.
If buffer process not running, it is started automatically."
(when cmd
;; (when (not (sql-find-sqli-buffer 'sqlite))
;; (nd/org-sql-open-connection))
(nd/with-advice
;; this function will throw a "regex too long error"
((#'looking-at :override #'ignore))
(sql-redirect nd/org-sql-buffer cmd nd/org-sql-debug-buffer))))
(defun nd/sql-select (db tbl-name cols &optional conds)
"Select columns from TBL-NAME in DB where COLS is the list of columns.
@ -2913,119 +2975,18 @@ If TS is nil or TS cannot be understood, nil will be returned."
(format-time-string "%Y-%m-%dT%H:%M:00" ft)))))
#+END_SRC
**** org sql schemas
so the emacs sql frontend apparently complains about newlines :(
#+BEGIN_SRC emacs-lisp
(defconst nd/org-sql-schemas
'("CREATE TABLE files (
file_path TEXT PRIMARY KEY ASC,
md5 TEXT NOT NULL,
size INTEGER NOT NULL,
time_modified DATE,
time_created DATE,
time_accessed DATE);"
"CREATE TABLE headlines (
file_path TEXT,
headline_offset INTEGER,
tree_path TEXT,
headline_text TEXT NOT NULL,
time_created DATE,
time_closed DATE,
time_scheduled DATE,
time_deadlined DATE,
keyword TEXT,
effort INTEGER,
priority INTEGER,
content TEXT,
PRIMARY KEY (file_path ASC, headline_offset ASC),
FOREIGN KEY (file_path) REFERENCES files (file_path)
ON UPDATE CASCADE
ON DELETE CASCADE);"
"CREATE TABLE tags (
file_path TEXT,
headline_offset INTEGER,
tag TEXT,
inherited BOOLEAN,
FOREIGN KEY (file_path, headline_offset)
REFERENCES headlines (file_path, headline_offset)
ON UPDATE CASCADE
ON DELETE CASCADE,
PRIMARY KEY (file_path, headline_offset, tag, inherited));"
"CREATE TABLE properties (
file_path TEXT,
headline_offset INTEGER,
property_offset INTEGER,
key_text TEXT NOT NULL,
val_text TEXT NOT NULL,
inherited BOOLEAN,
FOREIGN KEY (file_path, headline_offset)
REFERENCES headlines (file_path, headline_offset)
ON UPDATE CASCADE
ON DELETE CASCADE,
PRIMARY KEY (file_path ASC, property_offset ASC));"
"CREATE TABLE clocking (
file_path TEXT,
headline_offset INTEGER,
clock_offset INTEGER,
time_start DATE,
time_end DATE,
clock_note TEXT,
FOREIGN KEY (file_path, headline_offset)
REFERENCES headlines (file_path, headline_offset)
ON UPDATE CASCADE
ON DELETE CASCADE,
PRIMARY KEY (file_path ASC, clock_offset ASC));"
"CREATE TABLE logbook (
file_path TEXT,
headline_offset INTEGER,
entry_offset INTEGER,
time_logged DATE,
header TEXT,
note TEXT,
FOREIGN KEY (file_path, headline_offset)
REFERENCES headlines (file_path, headline_offset)
ON UPDATE CASCADE
ON DELETE CASCADE,
PRIMARY KEY (file_path ASC, entry_offset ASC));"
"CREATE TABLE state_changes (
file_path TEXT,
entry_offset INTEGER,
state_old TEXT NOT NULL,
state_new TEXT NOT NULL,
FOREIGN KEY (file_path, entry_offset)
REFERENCES logbook (file_path, entry_offset)
ON UPDATE CASCADE
ON DELETE CASCADE,
PRIMARY KEY (file_path ASC, entry_offset ASC));"
"CREATE TABLE planning_changes (
file_path TEXT,
entry_offset INTEGER,
time_old DATE NOT NULL,
time_new DATE,
planning_type TEXT CHECK (planning_type = \\\"d\\\" or (planning_type = \\\"s\\\")),
FOREIGN KEY (file_path, entry_offset)
REFERENCES logbook (file_path, entry_offset)
ON UPDATE CASCADE
ON DELETE CASCADE,
PRIMARY KEY (file_path ASC, entry_offset ASC));"
"CREATE TABLE links (
file_path TEXT,
headline_offset INTEGER,
link_offset INTEGER,
link_path TEXT,
link_text TEXT,
link_type TEXT,
FOREIGN KEY (file_path, headline_offset)
REFERENCES headlines (file_path, headline_offset)
ON UPDATE CASCADE
ON DELETE CASCADE,
PRIMARY KEY (file_path ASC, link_offset ASC));")
'("CREATE TABLE files (file_path TEXT PRIMARY KEY ASC,md5 TEXT NOT NULL,size INTEGER NOT NULL,time_modified DATE,time_created DATE,time_accessed DATE);"
"CREATE TABLE headlines (file_path TEXT,headline_offset INTEGER,tree_path TEXT,headline_text TEXT NOT NULL,time_created DATE,time_closed DATE,time_scheduled DATE,time_deadlined DATE,keyword TEXT,effort INTEGER,priority INTEGER,content TEXT,PRIMARY KEY (file_path ASC, headline_offset ASC),FOREIGN KEY (file_path) REFERENCES files (file_path) ON UPDATE CASCADE ON DELETE CASCADE);"
"CREATE TABLE tags (file_path TEXT,headline_offset INTEGER,tag TEXT,inherited BOOLEAN,FOREIGN KEY (file_path, headline_offset) REFERENCES headlines (file_path, headline_offset) ON UPDATE CASCADE ON DELETE CASCADE,PRIMARY KEY (file_path, headline_offset, tag, inherited));"
"CREATE TABLE properties (file_path TEXT,headline_offset INTEGER,property_offset INTEGER,key_text TEXT NOT NULL,val_text TEXT NOT NULL,inherited BOOLEAN,FOREIGN KEY (file_path, headline_offset) REFERENCES headlines (file_path, headline_offset) ON UPDATE CASCADE ON DELETE CASCADE,PRIMARY KEY (file_path ASC, property_offset ASC));"
"CREATE TABLE clocking (file_path TEXT,headline_offset INTEGER,clock_offset INTEGER,time_start DATE,time_end DATE,clock_note TEXT,FOREIGN KEY (file_path, headline_offset) REFERENCES headlines (file_path, headline_offset)ON UPDATE CASCADE ON DELETE CASCADE,PRIMARY KEY (file_path ASC, clock_offset ASC));"
"CREATE TABLE logbook (file_path TEXT,headline_offset INTEGER,entry_offset INTEGER,time_logged DATE,header TEXT,note TEXT,FOREIGN KEY (file_path, headline_offset)REFERENCES headlines (file_path, headline_offset) ON UPDATE CASCADE ON DELETE CASCADE,PRIMARY KEY (file_path ASC, entry_offset ASC));"
"CREATE TABLE state_changes (file_path TEXT,entry_offset INTEGER,state_old TEXT NOT NULL,state_new TEXT NOT NULL,FOREIGN KEY (file_path, entry_offset) REFERENCES logbook (file_path, entry_offset) ON UPDATE CASCADE ON DELETE CASCADE,PRIMARY KEY (file_path ASC, entry_offset ASC));"
"CREATE TABLE planning_changes (file_path TEXT,entry_offset INTEGER,time_old DATE NOT NULL,time_new DATE,planning_type TEXT CHECK (planning_type = \"d\" or (planning_type = \"s\")),FOREIGN KEY (file_path, entry_offset) REFERENCES logbook (file_path, entry_offset) ON UPDATE CASCADE ON DELETE CASCADE,PRIMARY KEY (file_path ASC, entry_offset ASC));"
"CREATE TABLE links (file_path TEXT,headline_offset INTEGER,link_offset INTEGER,link_path TEXT,link_text TEXT,link_type TEXT,FOREIGN KEY (file_path, headline_offset) REFERENCES headlines (file_path, headline_offset) ON UPDATE CASCADE ON DELETE CASCADE,PRIMARY KEY (file_path ASC, link_offset ASC));")
"Table schemas for the org database.")
#+END_SRC
**** org element functions
@ -3097,7 +3058,10 @@ headline."
ACC is treated as a set; therefore no duplicates are retained."
(let ((parent-hl (nd/org-element-get-parent-headline obj)))
(if parent-hl
(let* ((tags (org-element-property :tags parent-hl))
(let* ((tags (nd/org-sql->>
parent-hl
(org-element-property :tags)
(mapcar #'nd/strip-string)))
(i-tags (org-element-property :ARCHIVE_ITAGS parent-hl))
(i-tags (when i-tags (split-string i-tags)))
(all-tags (delete-dups (append acc tags i-tags))))
@ -3169,7 +3133,6 @@ but this has the advantage of being always available and comprehensive."
See `org-log-note-headings' for escape sequences that are matched
and replaces by regexps that match what would be inserted in place
of the escapes."
;; no pipes :( so sad for mario bros
(let* ((escapes '("%u" "%U" "%t" "%T" "%d" "%D" "%s" "%S"))
(todo-list (nd/org-todo-keywords-stripped))
(todo-regexp (mapconcat #'regexp-quote todo-list "\\|"))
@ -3322,16 +3285,6 @@ The header text is solely used for determining :type and :match-data."
**** org sql db function
These are the main functions to populate the db.
#+BEGIN_SRC emacs-lisp
(defmacro nd/org-sql-> (&rest body)
(let ((result (pop body)))
(dolist (form body result)
(setq result (append (list (car form) result) (cdr form))))))
(defmacro nd/org-sql->> (&rest body)
(let ((result (pop body)))
(dolist (form body result)
(setq result (append form (list result))))))
(defun nd/org-sql-extract (acc fun objs &rest args)
"Iterate through OBJS and add them to accumulator ACC using FUN.
FUN is a function that takes a single object from OBJS, the accumulator,
@ -3591,12 +3544,14 @@ HL-PART is an object as returned by `nd/org-sql-partition-headline'."
(tags (nd/org-sql->> hl
(org-element-property :tags)
(mapcar #'nd/strip-string)))
;; split-string returns nil if it gets ""
(i-tags (nd/org-sql->
(org-element-property :ARCHIVE_ITAGS hl)
(or "")
(split-string)))
;; then retrieve i-tags, optionally going up to parents
(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))
(i-tags (when nd/org-sql-use-tag-inheritance
(nd/org-element-get-parent-tags hl i-tags)))
(from
(lambda (acc tag hl-part &optional inherited)
(let* ((hl (alist-get :headline hl-part))
@ -3613,7 +3568,6 @@ HL-PART is an object as returned by `nd/org-sql-partition-headline'."
(nd/org-sql-extract from tags hl-part)
(nd/org-sql-extract from i-tags hl-part t))))
(defun nd/org-sql-extract-links (acc hl-part)
"Add link data from headline HL-PART to accumulator ACC.
HL-PART is an object as returned by `nd/org-sql-partition-headline'."
@ -3626,9 +3580,11 @@ HL-PART is an object as returned by `nd/org-sql-partition-headline'."
(hl-offset (org-element-property :begin hl))
(ln-offset (org-element-property :begin ln))
(ln-path (org-element-property :path ln))
(ln-text (org-element-contents ln))
(ln-text (mapcar #'nd/strip-string ln-text))
(ln-text (string-join ln-text))
(ln-text (nd/org-sql->>
ln
(org-element-contents)
(org-element-interpret-data)
(nd/strip-string)))
(ln-type (org-element-property :type ln))
(ln-data (list :file_path fp
:headline_offset hl-offset
@ -3780,9 +3736,21 @@ The results are accumulated in ACC which is returned on exit."
fp-qry (cdr found))))
(if fp-qry (nd/org-sql-mk-delete fp-qry acc)) acc))
;; (defvar nd/org-sql-files '("~/Org" "~/Org/projects")
(defvar nd/org-sql-files '("~/Org/general.org_archive")
"A list of org files or directories to put into sql database.")
(defun nd/org-sql-files ()
(nd/org-sql->>
nd/org-sql-files
(mapcar (lambda (f) (if (file-directory-p f)
(directory-files f t "\\`.*\\.org\\(_archive\\)?\\'")
(list f))))
(apply #'append)))
(defun nd/org-sql-files-from-disk ()
"Return alist of metadata for filepaths PATHS."
(let ((paths (mapcar (lambda (p) (expand-file-name p org-directory)) nd/org-sql-files))
(let ((paths (nd/org-sql-files))
(cons-md5
(lambda (fp)
(let* ((fp-buf (find-file-noselect fp t)))
@ -3811,20 +3779,18 @@ the plist of metadata."
(nd/org-sql-fmt-trans)
(plist-put trans op)))))
(nd/org-sql->>
(nd/org-sql-files-from-db)
;; (nd/org-sql-files-from-db)
nil
(nd/org-sql-compare-files fp-dsk)
(funcall map-trns 'insert #'nd/org-sql-fmt-inserts)
(funcall map-trns 'update #'nd/org-sql-fmt-updates)
(funcall map-trns 'delete #'nd/org-sql-fmt-deletes))))
(defvar nd/org-sql-files '("test1.org_archive" "test2.org_archive")
"A list of org files to put into sql database.")
(defun nd/org-init-db ()
"Make a sqlite database for org files if it does not exist already."
(unless (file-exists-p nd/org-sqlite-db-path)
(process-file-shell-command (concat "touch " nd/org-sqlite-db-path))
(mapcar (lambda (s) (nd/sql-cmd nd/org-sqlite-db-path s)) nd/org-sql-schemas)))
;; (unless (file-exists-p nd/org-sqlite-db-path)
;; (process-file-shell-command (concat "touch " nd/org-sqlite-db-path))
(nd/org-sql->> nd/org-sql-schemas (nd/sql-cmd)))
(defun nd/org-archive-to-db (&optional show-err)
"Transfer archive files to sqlite database."
@ -3835,9 +3801,9 @@ the plist of metadata."
;; note, the order of sql commands matters in transactions,
;; so, we need to do deletes, update, then inserts in that order
;; `(,(nd/sql-cmd nd/org-sqlite-db-path trans-dlt show-err))))
`(,(nd/sql-cmd nd/org-sqlite-db-path trans-dlt show-err t)
,(nd/sql-cmd nd/org-sqlite-db-path trans-upd show-err t)
,(nd/sql-cmd nd/org-sqlite-db-path trans-ins show-err nil))))
`(,(nd/sql-cmd trans-dlt)
,(nd/sql-cmd trans-upd)
,(nd/sql-cmd trans-ins))))
#+END_SRC
* tools
** printing