alphapapa / alphapapa/org-ql

using org-ql to edit org document?

オープン
#373 コメント 6 件 リアクション 0 件 担当者 0 名 GitHub で見る
discussion
主要言語
Emacs Lisp
スター
1.6k
フォーク
120
PR マージ指標
30日以内にマージされた PR はありません

説明

I am trying to carry-over todo items, (similar to what org-journal carry over does)

I used org-ql to do query what I want to carry over.

Here's the code.

I had some perplexing bug on putting

(message (format "title: %s" (org-element-property :title (org-element-at-point))))

*only* when cursor at source buffer is at the end of the end.
Caused my code to not correctly carry-over.

I was suspecting many things, but it turned out

(org-element-at-point) is buggy with non-ascii character (in my case Korean, I guess I'll have to put some encoding hint at the top of file or somewhere)

Since I didn't know what the cause was, I also suspected it might be related to org-ql (specially how it caches..)
But it was not.

@alphapapa Thanks for saying to ask for help. While I prepared the question, I found the bug.
I ask a general question, since org-ql seems to be supporting "query" not "replace or edit" I was wondering if I was misusing library or if there are things I need to know when using it for editing. (maybe too general question.. but I 'll be glad if I can get any hints)

```
(cl-defun ek/ob-collect-nodes-test
(&key (source-query (error "source-query is mandatory"))
source-buffer
(source-spec #'ek/ob-get-sources)
target-buffer
)

(let (
move-data-list
(source-files (if source-buffer
(list source-buffer)
(if (functionp source-spec)
(funcall source-spec)
source-spec)))
)
(org-ql-select source-files source-query
:action (lambda ()

;; (save-excursion
;; (message (format "cursor1: %s" (point)))
;; (message (format "title: %s" (org-element-property :title (org-element-at-point))))
;; (message (format "cursor2: %s" (point))))
(message (format "title: %s" (org-element-property :title (org-element-at-point))))
(let ((start-point (point))
(file-name (buffer-file-name))
(element (org-element-at-point))
end-point
move-data
)
(org-end-of-subtree t t)
(backward-char 1)
(move-end-of-line nil)
(setq end-point (point))
(setq move-data
(list :start-point start-point
:file-name file-name
:element element
:end-point end-point
)
)
(push move-data move-data-list)
)
)
)

(let ((above))
(dolist (move-data move-data-list)

(let ((source-buffer (get-file-buffer (plist-get move-data :file-name))))
(ek/ob-move-node-test
:source-buffer source-buffer
:source-element (plist-get move-data :element)
:source-start (plist-get move-data :start-point)
:source-end (plist-get move-data :end-point)
:target-buffer target-buffer
:above above
))
(setq above t)
))
))

(defun ek/org-make-top-level (content)
(with-temp-buffer

(org-mode)
(erase-buffer)
(insert content)
(unless (org-before-first-heading-p)
(org-back-to-heading))

(while (and (org-at-heading-p) (> (org-current-level) 1))
(org-promote-subtree)
)
(buffer-substring-no-properties (point-min) (point-max))
)
)

(cl-defun ek/ob-move-node-test
(&key
source-buffer
source-element
source-start
source-end
target-buffer
above
)

(let*
((source-content (ek/org-make-top-level
(with-current-buffer source-buffer
(buffer-substring-no-properties source-start source-end)))))
(with-current-buffer target-buffer
(setq target-marker (point-marker)))

(when (and target-marker (not (eq (marker-buffer target-marker) source-buffer)))
(with-current-buffer (marker-buffer target-marker)
(goto-char (marker-position target-marker))
(cond
((org-before-first-heading-p) nil)
(t
(org-back-to-heading)
))
(when above
(unless (org-before-first-heading-p)
(org-backward-heading-same-level 1))
)
(org-insert-todo-heading nil t)

(kill-whole-line 0)
(move-beginning-of-line nil)
(insert source-content)

;; Now remove the node from the source buffer
(with-current-buffer source-buffer
(delete-region source-start source-end)))))

)

(defun ek/ob-collect-nodes-to-buffer (&optional buffer)

(interactive)

(let (
(source-query '(and
(or (todo "NEXT")
(and
(todo "TODO")
(deadline)
)
)
(not (done))

))
)

(ek/ob-collect-nodes-test
:source-spec "~/Dropbox/notes/roam/daily/test.org"
:source-query source-query
:target-buffer (or buffer (current-buffer))
)

)
)

```

and the test org doc is
```

#+title: Test

* TODO finance :@a_trading:

** TODO question

*** TODO what is 한글 ?
DEADLINE: <2023-09-19 Tue 04:00>

*** TODO why is saving
DEADLINE: <2023-09-19 Tue 12:48>

* TODO emacs
DEADLINE: <2023-09-20 Wed 15:30>
- [X] scratch capture template

```

コントリビューションガイド

このリポジトリのコントリビューションガイドは索引されていません

評価

この issue はまだ評価されていません。

新しい issue をメールで受け取る

初心者向けの GitHub issue を短くまとめたダイジェスト。