branch: elpa/gnosis
commit b22f7bb91d5891aadeebc098fa2e8004d4bb09f3
Author: Thanos Apollo <pub...@thanosapollo.org>
Commit: Thanos Apollo <pub...@thanosapollo.org>
Rewrite gnosis-org module.
* This module provides parsing of org-mode buffers.
---
gnosis-org.el | 140 ++++++++++++++++++++++++++++++++++++++++++++++++----------
1 file changed, 116 insertions(+), 24 deletions(-)
diff --git a/gnosis-org.el b/gnosis-org.el
index e977083e58..e50d95c1f2 100644
--- a/gnosis-org.el
+++ b/gnosis-org.el
@@ -24,7 +24,7 @@
;;; Commentary:
-;; Under development.
+;; This module provides parsing of org-mode buffers for gnosis.
;;; Code:
@@ -64,29 +64,121 @@ BUFFER defaults to the current buffer if not specified."
(if results (reverse results)
(message "No custom properties found for %s" property)
nil))))
-;; TODO: Add support for tags.
-(cl-defun gnosis-org-insert-heading (&key main id answer type)
- "Insert an Org heading in current buffer.
-
-- MAIN as the title.
-- ID as GNOSIS_ID.
-- ANSWER as the subheading.
-- TYPE as the note type.
-
-If BUFFER is not specified, defaults to the current buffer."
- (cl-assert (stringp main) nil "MAIN must be a string representing the
heading title.")
- (cl-assert (stringp id) nil "ID must be a string representing the
GNOSIS_ID.")
- (cl-assert (stringp type) nil "TYPE must be a string representing the TYPE
property.")
- (let ((main (if (string-match-p "\n" main) (replace-regexp-in-string "\n"
"\\\\n" main) main))
- (answer (cond ((stringp answer)
- answer)
- ((numberp answer)
- (number-to-string answer))
- (t (mapconcat 'identity answer ", ")))))
- (goto-char (point-max)) ;; Ensure we're at the end of the buffer
- (insert (format "* %s\n:PROPERTIES:\n:GNOSIS_ID: %s\n:TYPE: %s\n:END:\n**
%s\n"
- main id type answer))
- (message "Inserted heading: %s with GNOSIS_ID %s and TYPE %s" main id
type)))
+
+(defun gnosis-org--insert-read-only (string)
+ "Insert STRING as read-only."
+ (let ((start (point)))
+ (insert string)
+ ;; Set the just inserted string as read-only
+ (add-text-properties start (point) '(read-only t))
+ ;; Since the space is inserted outside of the read-only region, it's
editable
+ (let ((inhibit-read-only t))
+ (insert " "))))
+
+(defun gnosis-org-make-read-only (&rest values)
+ "Make the provided VALUES read-only in the whole buffer."
+ (goto-char (point-min))
+ (dolist (value values)
+ (while (search-forward value nil t)
+ (put-text-property (match-beginning 0) (match-end 0) 'read-only t)))
+ (goto-char (point-min)))
+
+(cl-defun gnosis-org--insert-thema (id type &optional keimenon hypothesis
apocalypse parathema tags example)
+ "Insert thema for note ID.
+
+TYPE: Thema type, refer to `gnosis-thema-types'
+KEIMENON: Text user is first presented with.
+HYPOTHESIS: Hypothesis for what the APOCALYPSE is
+APOCALYPSE: The revelation after KEIMENON
+PARATHEMA: The text where THEMA is derived from.
+TAGS: List of THEMA tags
+EXAMPLE: Boolean value, if non-nil do not add properties for thema."
+ (let ((components `(("** Keimenon" . ,keimenon)
+ ("** Hypothesis" . ,hypothesis)
+ ("** Apocalypse" . ,apocalypse)
+ ("** Parathema" . ,parathema))))
+ (insert "\n* Thema")
+ (org-set-tags tags)
+ (unless example
+ (org-set-property "GNOSIS_ID" id)
+ (org-set-property "GNOSIS_TYPE" type)
+ (gnosis-org-make-read-only ":PROPERTIES:"
+ (format "GNOSIS_ID: %s" id)
+ (format "GNOSIS_TYPE: %s" type)
+ ":END:"))
+ (dolist (comp components)
+ (goto-char (point-max))
+ (gnosis-org--insert-read-only (car comp))
+ (insert "\n" (or (cdr comp) "") "\n\n"))))
+
+(defun gnosis-org-parse--deck-name (&optional parsed-data)
+ "Retrieve deck name from PARSED-DATA."
+ (let* ((parsed-data (or parsed-data (org-element-parse-buffer)))
+ (title (org-element-map parsed-data 'keyword
+ (lambda (kw)
+ (when (string= (org-element-property :key kw) "DECK")
+ (org-element-property :value kw)))
+ nil t)))
+ title))
+
+(defun gnosis-org-parse-themas ()
+ "Extract content for each level-2 heading for thema headings with a
GNOSIS_ID."
+ (let (results)
+ (org-element-map (org-element-parse-buffer) 'headline
+ (lambda (headline)
+ (let* ((level (org-element-property :level headline))
+ (gnosis-id (org-element-property :GNOSIS_ID headline))
+ (gnosis-type (org-element-property :GNOSIS_TYPE headline))
+ (tags (org-element-property :tags headline)))
+ (when (and (= level 1) gnosis-id gnosis-type)
+ (let (entry)
+ (push gnosis-id entry)
+ (push gnosis-type entry)
+ (dolist (child (org-element-contents headline))
+ (when (eq 'headline (org-element-type child))
+ (let ((child-text (org-element-interpret-data
(org-element-contents child))))
+ (setq child-text (string-trim child-text))
+ (if (string-empty-p child-text)
+ (push nil entry) ; Push nil if the content is empty
+ (push (substring-no-properties child-text) entry)))))
+ (push tags entry) ;; Add tags last
+ (push (nreverse entry) results)))))
+ nil nil)
+ results))
+
+;;;; TODO: Rewrite function that export deck without read-only values.
+;;;; Make them only with built-in to work with async.el
+;; (defun gnosis-org-export-deck (deck)
+;; "Export DECK in an org file."
+;; (interactive (list (gnosis--get-deck-id)))
+;; ;; (find-file (read-file-name "File: "))
+;; ;; TODO: Retrieve all values instead of just ids and then insert them
async
+;; (let* ((notes (append (gnosis-select '[type keimenon hypothesis
apocalypse tags] 'notes `(= deck-id ,deck))
+;; ;; (gnosis-select 'parathema 'extras `(= deck-id ,deck)
t)
+;; nil))
+;; (deck-name (car (gnosis-select 'name 'decks `(= id ,deck) t))))
+;; (async-start
+;; (lambda () (let ((inhibit-read-only 1))
+;; (find-file (format "/tmp/%s.org" (downcase deck-name)))
+;; (erase-buffer)
+;; (org-mode)
+;; (insert "#+DECK: " deck-name "\n\n")
+;; (cl-loop for note in notes
+;; do
+;; (insert "\n* Thema")
+;; (insert "\n** Keimenon\n")
+;; (insert (format "\n%s\n" (nth 1 note))))
+;; (save-buffer)))
+;; ;; (let ((inhibit-read-only 1))
+;; ;; (erase-buffer))
+;; ;; (org-mode)
+;; ;; (insert "#+DECK: " deck-name)
+;; ;; (org-set-property "GNOSIS_DECK" (number-to-string deck))
+;; ;; (goto-char (point-max))
+;; ;; (cl-loop for note in notes
+;; ;; do (gnosis-export-note note))
+;; ;; (save-buffer)
+;; )))
(provide 'gnosis-org)
;;; gnosis-org.el ends here.
