Notes: Update
This commit is contained in:
parent
337bfa6695
commit
2b21871a02
1 changed files with 270 additions and 270 deletions
540
notes.org
540
notes.org
|
|
@ -267,233 +267,6 @@ To implement this with good performance probably needs an outline-path cache. I
|
||||||
|
|
||||||
[2019-10-07 Mon 13:09] This is basically done with =be2bf6df316b96b3ed56851b8ffe0e227796b621= and =be2bf6df316b96b3ed56851b8ffe0e227796b621=, but not the specific-path matching. I left a =MAYBE= in the code about "anchored" path matching, which would accomplish that.
|
[2019-10-07 Mon 13:09] This is basically done with =be2bf6df316b96b3ed56851b8ffe0e227796b621= and =be2bf6df316b96b3ed56851b8ffe0e227796b621=, but not the specific-path matching. I left a =MAYBE= in the code about "anchored" path matching, which would accomplish that.
|
||||||
|
|
||||||
** UNDERWAY [#B] Recursive queries
|
|
||||||
|
|
||||||
For lack of a better term. A way to query for certain headings, and then gather results of a different query at each result of the first query, displaying all results in a single view.
|
|
||||||
|
|
||||||
This works pretty well. It needs polishing, and some refactoring so items can be indented completely (rather than leaving the keyword unindented, as it is now).
|
|
||||||
|
|
||||||
#+BEGIN_SRC elisp
|
|
||||||
(cl-defun org-ql-agenda-recursive (buffers-or-files queries &key action narrow sort)
|
|
||||||
(cl-labels ((rec (queries element indent)
|
|
||||||
(org-with-point-at (org-element-property :org-marker element)
|
|
||||||
(when-let* ((results (progn
|
|
||||||
(org-narrow-to-subtree)
|
|
||||||
(org-ql-select (current-buffer)
|
|
||||||
(car queries)
|
|
||||||
:action 'element-with-markers
|
|
||||||
:narrow t
|
|
||||||
:sort sort))))
|
|
||||||
;; Indent entry for each level
|
|
||||||
(setf results (--map
|
|
||||||
(org-element-put-property it :raw-value
|
|
||||||
(concat (s-repeat (* 5 indent) " ")
|
|
||||||
(org-element-property :raw-value it)))
|
|
||||||
results))
|
|
||||||
(cons it (if (cdr queries)
|
|
||||||
(--map (rec (cdr queries) it)
|
|
||||||
results)
|
|
||||||
results))))))
|
|
||||||
(when-let* ((indent 0)
|
|
||||||
(results (org-ql-select buffers-or-files
|
|
||||||
(car queries)
|
|
||||||
:action 'element-with-markers
|
|
||||||
:narrow narrow
|
|
||||||
:sort sort)))
|
|
||||||
(->> (if (cdr queries)
|
|
||||||
(--map (rec (cdr queries) it (1+ indent))
|
|
||||||
results)
|
|
||||||
results)
|
|
||||||
(-flatten-n (1- (length queries)))
|
|
||||||
-non-nil
|
|
||||||
(org-ql-agenda--agenda nil nil
|
|
||||||
:entries)))))
|
|
||||||
|
|
||||||
(cl-defun org-ql-select-recursive (buffers-or-files queries &key action narrow sort)
|
|
||||||
(cl-labels ((rec (queries element indent)
|
|
||||||
(org-with-point-at (org-element-property :org-marker element)
|
|
||||||
(when-let* ((results (progn
|
|
||||||
(org-narrow-to-subtree)
|
|
||||||
(org-ql-select (current-buffer)
|
|
||||||
(car queries)
|
|
||||||
:action 'element-with-markers
|
|
||||||
:narrow t
|
|
||||||
:sort sort))))
|
|
||||||
;; Indent entry for each level
|
|
||||||
(setf results (--map
|
|
||||||
(org-element-put-property it :raw-value
|
|
||||||
(concat (s-repeat (* 5 indent) " ")
|
|
||||||
(org-element-property :raw-value it)))
|
|
||||||
results))
|
|
||||||
(cons it (if (cdr queries)
|
|
||||||
(--map (rec (cdr queries) it)
|
|
||||||
results)
|
|
||||||
results))))))
|
|
||||||
(when-let* ((indent 0)
|
|
||||||
(results (org-ql-select buffers-or-files
|
|
||||||
(car queries)
|
|
||||||
:action 'element-with-markers
|
|
||||||
:narrow narrow
|
|
||||||
:sort sort)))
|
|
||||||
(->> (if (cdr queries)
|
|
||||||
(--map (rec (cdr queries) it (1+ indent))
|
|
||||||
results)
|
|
||||||
results)
|
|
||||||
(-flatten-n (1- (length queries)))
|
|
||||||
-non-nil))))
|
|
||||||
#+END_SRC
|
|
||||||
|
|
||||||
** UNDERWAY [#B] Timeline view
|
|
||||||
:PROPERTIES:
|
|
||||||
:ID: 00573552-ffe9-4608-8904-7f6c73246b6d
|
|
||||||
:END:
|
|
||||||
|
|
||||||
e.g. as mentioned by Samuel Wales at https://lists.gnu.org/archive/html/emacs-orgmode/2019-08/msg00330.html. Prototype code:
|
|
||||||
|
|
||||||
#+BEGIN_SRC elisp
|
|
||||||
(cl-defun org-ql-timeline (buffers-files query)
|
|
||||||
(let ((results
|
|
||||||
(org-ql-select buffers-files
|
|
||||||
query :action
|
|
||||||
(lambda ()
|
|
||||||
(let* ((heading-string
|
|
||||||
(->> (org-element-headline-parser
|
|
||||||
(line-end-position))
|
|
||||||
org-ql--add-markers
|
|
||||||
org-ql-agenda--format-element))
|
|
||||||
(timestamps
|
|
||||||
(cl-loop with limit = (org-entry-end-position)
|
|
||||||
while (re-search-forward org-ts-regexp-both
|
|
||||||
limit t)
|
|
||||||
collect (ts-parse-org (match-string 0))))
|
|
||||||
(timestamp-strings
|
|
||||||
(->> timestamps
|
|
||||||
(-sort #'ts<)
|
|
||||||
(--map (concat " " (ts-format it))))))
|
|
||||||
(s-join "\n" (cons heading-string timestamp-strings))))
|
|
||||||
:sort '(date))))
|
|
||||||
(org-ql-agenda--agenda nil nil :strings results)))
|
|
||||||
|
|
||||||
(org-ql-timeline (org-agenda-files)
|
|
||||||
'(and "Emacs" (ts)))
|
|
||||||
|
|
||||||
;; More timeline-like version, organized by date rather than task.
|
|
||||||
|
|
||||||
(cl-defun org-ql-timeline* (buffers-files query &key filter-ts)
|
|
||||||
(let* ((ts-ht (ht))
|
|
||||||
(results (org-ql-select buffers-files
|
|
||||||
query
|
|
||||||
:action (lambda ()
|
|
||||||
(let* ((heading-string
|
|
||||||
(->> (org-element-headline-parser
|
|
||||||
(line-end-position))
|
|
||||||
org-ql--add-markers
|
|
||||||
org-ql-agenda--format-element))
|
|
||||||
(date-timestamps
|
|
||||||
;; Each one set to 00:00:00.
|
|
||||||
(cl-loop with limit = (org-entry-end-position)
|
|
||||||
while (re-search-forward org-ts-regexp-both
|
|
||||||
limit t)
|
|
||||||
collect (->> (match-string 0)
|
|
||||||
ts-parse-org
|
|
||||||
(ts-apply :hour 0 :minute 0 :second 0)))))
|
|
||||||
(setf date-timestamps (delete-dups date-timestamps))
|
|
||||||
(when filter-ts
|
|
||||||
(setf date-timestamps (cl-remove-if-not filter-ts date-timestamps)))
|
|
||||||
(--each date-timestamps
|
|
||||||
(push heading-string (gethash it ts-ht)))))))
|
|
||||||
(tss-sorted (-sort #'ts< (ht-keys ts-ht)))
|
|
||||||
(strings (cl-loop for ts in tss-sorted
|
|
||||||
collect (concat "\n"
|
|
||||||
(propertize (ts-format "%Y-%m-%d" ts)
|
|
||||||
'face 'org-agenda-structure))
|
|
||||||
append (ht-get ts-ht ts))))
|
|
||||||
(org-ql-agenda--agenda nil nil :strings strings)))
|
|
||||||
|
|
||||||
(org-ql-timeline* (org-agenda-files)
|
|
||||||
'(ts :from -14)
|
|
||||||
:filter-ts `(lambda (ts)
|
|
||||||
(ts<= ,(ts-adjust 'day -14 (ts-now)) ts)))
|
|
||||||
#+END_SRC
|
|
||||||
|
|
||||||
Another, more up-to-date implementation:
|
|
||||||
|
|
||||||
#+BEGIN_SRC elisp
|
|
||||||
;; NOTE: ts structs don't (sometimes? or always?) compare properly
|
|
||||||
;; with default hash tables, e.g. this code:
|
|
||||||
|
|
||||||
;; (let* ((ts-a #s(ts nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 1572670800.0))
|
|
||||||
;; (ts-b #s(ts nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 1572584400.0)))
|
|
||||||
;; (list :equal (equal ts-a ts-b)
|
|
||||||
;; :sxhash-equal (equal (sxhash ts-a) (sxhash ts-b)))) ;;=> (:equal nil :sxhash-equal t)
|
|
||||||
|
|
||||||
;; So we must use the "contents-hash" table as described in the Elisp manual.
|
|
||||||
(define-hash-table-test 'contents-hash 'equal 'sxhash-equal)
|
|
||||||
|
|
||||||
(cl-defun org-ql-view-timeline (buffers-files &key from to on)
|
|
||||||
"FIXME: DOcstring"
|
|
||||||
(cl-flet ((parse-ts-arg
|
|
||||||
(arg type)
|
|
||||||
;; Parse ARG as a string or TS struct and adjust it to the beginning
|
|
||||||
;; or end of its day, depending on whether TYPE is `:begin' or `:end'.
|
|
||||||
(-let (((hour minute second) (cl-ecase type
|
|
||||||
(:begin '(0 0 0))
|
|
||||||
(:end '(23 59 59)))))
|
|
||||||
(->> (cl-typecase arg
|
|
||||||
(string (ts-parse arg))
|
|
||||||
(ts arg))
|
|
||||||
(ts-apply :hour hour :minute minute :second second)))))
|
|
||||||
(let* ((ts-predicate `(lambda (ts)
|
|
||||||
,(cond (on `(ts-in ,(parse-ts-arg on :begin)
|
|
||||||
ts
|
|
||||||
,(parse-ts-arg on :end)))
|
|
||||||
((and from to) `(ts-in ,(parse-ts-arg from :begin)
|
|
||||||
ts
|
|
||||||
,(parse-ts-arg to :end)))
|
|
||||||
(from `(ts<= ,(parse-ts-arg from :begin) ts))
|
|
||||||
(to `(ts<= ts ,(parse-ts-arg to :end)))
|
|
||||||
(t (user-error "Huh?")))))
|
|
||||||
(query (cond (on `(ts :from ,(parse-ts-arg on :begin)
|
|
||||||
:to ,(parse-ts-arg on :end)))
|
|
||||||
(t (append (list 'ts)
|
|
||||||
(when from
|
|
||||||
`(:from ,(parse-ts-arg from :begin)))
|
|
||||||
(when to
|
|
||||||
`(:to ,(parse-ts-arg to :end)))))))
|
|
||||||
(date-ts-table (make-hash-table :test 'contents-hash))
|
|
||||||
(_results (org-ql-select buffers-files query
|
|
||||||
:action (lambda ()
|
|
||||||
(let* ((string (->> (org-element-headline-parser
|
|
||||||
(line-end-position))
|
|
||||||
org-ql--add-markers
|
|
||||||
org-ql-view--format-element)))
|
|
||||||
(cl-loop with limit = (org-entry-end-position)
|
|
||||||
while (re-search-forward org-ts-regexp-both limit t)
|
|
||||||
for ts = (->> (match-string 0) ts-parse-org)
|
|
||||||
when (funcall ts-predicate ts)
|
|
||||||
do (cl-pushnew (cons ts (concat (ts-format " %H:%M" ts)
|
|
||||||
string))
|
|
||||||
(gethash (ts-apply :hour 0 :minute 0 :second 0 ts)
|
|
||||||
date-ts-table)
|
|
||||||
:test #'equal))))))
|
|
||||||
(date-tss-sorted (->> date-ts-table hash-table-keys (-sort #'ts<)))
|
|
||||||
(string (cl-loop for date-ts in date-tss-sorted
|
|
||||||
for date-string = (propertize (ts-format "%Y-%m-%d" date-ts)
|
|
||||||
'face 'org-agenda-structure)
|
|
||||||
concat (concat "\n" date-string)
|
|
||||||
concat (cl-loop for (ts . entry) in (->> (gethash date-ts date-ts-table)
|
|
||||||
(-sort (-on #'ts< #'car)))
|
|
||||||
concat (concat "\n" entry)))))
|
|
||||||
(org-ql-view--display :buffer "Timeline"
|
|
||||||
:header "Timeline"
|
|
||||||
:string string))))
|
|
||||||
|
|
||||||
;; Used like:
|
|
||||||
;; (org-ql-view-timeline "~/org/main.org" :from "2019-11-01")
|
|
||||||
#+END_SRC
|
|
||||||
|
|
||||||
[2019-09-26 Thu 21:28] Would probably make sense to implement this using the view-sections someday.
|
|
||||||
|
|
||||||
** UNDERWAY [#B] "Node" caching
|
** UNDERWAY [#B] "Node" caching
|
||||||
|
|
||||||
[2019-09-05 Thu 12:30] At each node checked by a predicate, make a struct that stores attributes we can query for, as well as parent node position. This would let us speed up ancestor-based queries, like =(ancestor (todo "WAITING"))=. Ideally it would also serve as the tag hierarchy cache.
|
[2019-09-05 Thu 12:30] At each node checked by a predicate, make a struct that stores attributes we can query for, as well as parent node position. This would let us speed up ancestor-based queries, like =(ancestor (todo "WAITING"))=. Ideally it would also serve as the tag hierarchy cache.
|
||||||
|
|
@ -598,49 +371,6 @@ This works okay (except the priority accessor needs to be fixed, because Org pri
|
||||||
:action #'helm-org-goto-marker))))
|
:action #'helm-org-goto-marker))))
|
||||||
#+END_SRC
|
#+END_SRC
|
||||||
|
|
||||||
** UNDERWAY [#B] Implement view with tabulated-list-mode or magit-section
|
|
||||||
|
|
||||||
[2019-09-02 Mon 05:20] Especially with some of the new packages that make =tabulated-list-mode= easier to use, like =navigel=. However, it would probably break grouping, or require some kind of adapter or extension to do grouping, so I don't know if that would work. Something like =magit-section= would be more flexible, and could be recursively grouped, like in =magit-todos=.
|
|
||||||
|
|
||||||
[2019-09-08 Sun 10:06] Came up with a prototype yesterday, in branch =wip/view-section=. Seems to work pretty well.
|
|
||||||
|
|
||||||
One of the things in that branch is =org-ql-item=, which is a struct used to carry data for query results. It seems to work well.
|
|
||||||
|
|
||||||
Another idea for it is to simply store the element from =org-element-headline-parser= in one of its slots, and populate all of the other slots lazily, like =ts=. It already does that for a couple of slots, but I think it makes sense to do it for all of them, to reduce the overhead of making the struct for every query result.
|
|
||||||
|
|
||||||
*** MAYBE [#C] Experiment with =widget=
|
|
||||||
|
|
||||||
The code that powers the customization UI. Has collapsible and customizable widgets. Might be perfect. Might even enable editing items in the list, with functions to make the changes in the source buffers.
|
|
||||||
|
|
||||||
*** Code idea
|
|
||||||
|
|
||||||
Inserting items into a view could look something like this:
|
|
||||||
|
|
||||||
#+BEGIN_SRC elisp
|
|
||||||
(org-ql-view--insert-items
|
|
||||||
:header (ts-format "%Y-%m-%d" (ts-now))
|
|
||||||
:items (org-ql-query
|
|
||||||
:select #'org-ql-current-item
|
|
||||||
:from (org-agenda-files)
|
|
||||||
:where '(or (deadline auto)
|
|
||||||
(scheduled :on today)
|
|
||||||
(ts-active :on today)))
|
|
||||||
:group-by '(org-ql-item-priority
|
|
||||||
org-ql-item-todo))
|
|
||||||
#+END_SRC
|
|
||||||
|
|
||||||
Items would be structs, and the =group-by= argument would be a list of accessors, like how =magit-todos= works. Arbitrary functions could also be passed to =group-by=, as whatever value the function returns is used to group them. =org-ql-current-item= would be a function that turns the result of =org-element-headline-parser= into the struct.
|
|
||||||
|
|
||||||
Not sure if it should automatically add the number of items to the header, or if that should be done manually.
|
|
||||||
|
|
||||||
*** Prior art
|
|
||||||
|
|
||||||
**** [[https://github.com/m2ym/direx-el][GitHub - m2ym/direx-el: Directory Explorer for GNU Emacs]]
|
|
||||||
|
|
||||||
Appears to be another implementation of magit-section-like expandable sections. Not sure which came first. Its code seems like it may be helpful.
|
|
||||||
|
|
||||||
**** magit-section
|
|
||||||
|
|
||||||
** MAYBE [#C] Overlay-based caching inspired by org-num-mode
|
** MAYBE [#C] Overlay-based caching inspired by org-num-mode
|
||||||
|
|
||||||
[2019-12-30 Mon 22:42] Newer versions of Org have =org-num-mode=, which uses =font-lock= and =after-change-functions= to update overlays in the buffer with outline numbering. Maybe a similar approach could be used to cache arbitrary values for headings in a buffer without having to discard the whole buffer's cache when the buffer changes.
|
[2019-12-30 Mon 22:42] Newer versions of Org have =org-num-mode=, which uses =font-lock= and =after-change-functions= to update overlays in the buffer with outline numbering. Maybe a similar approach could be used to cache arbitrary values for headings in a buffer without having to discard the whole buffer's cache when the buffer changes.
|
||||||
|
|
@ -1249,6 +979,276 @@ For the query expression:
|
||||||
|
|
||||||
[2020-11-11 Wed 23:27] That's all the parameters and all the types that I can think to test.
|
[2020-11-11 Wed 23:27] That's all the parameters and all the types that I can think to test.
|
||||||
|
|
||||||
|
** PROJECT [#B] Recursive queries
|
||||||
|
|
||||||
|
For lack of a better term. A way to query for certain headings, and then gather results of a different query at each result of the first query, displaying all results in a single view.
|
||||||
|
|
||||||
|
This works pretty well. It needs polishing, and some refactoring so items can be indented completely (rather than leaving the keyword unindented, as it is now).
|
||||||
|
|
||||||
|
#+BEGIN_SRC elisp
|
||||||
|
(cl-defun org-ql-agenda-recursive (buffers-or-files queries &key action narrow sort)
|
||||||
|
(cl-labels ((rec (queries element indent)
|
||||||
|
(org-with-point-at (org-element-property :org-marker element)
|
||||||
|
(when-let* ((results (progn
|
||||||
|
(org-narrow-to-subtree)
|
||||||
|
(org-ql-select (current-buffer)
|
||||||
|
(car queries)
|
||||||
|
:action 'element-with-markers
|
||||||
|
:narrow t
|
||||||
|
:sort sort))))
|
||||||
|
;; Indent entry for each level
|
||||||
|
(setf results (--map
|
||||||
|
(org-element-put-property it :raw-value
|
||||||
|
(concat (s-repeat (* 5 indent) " ")
|
||||||
|
(org-element-property :raw-value it)))
|
||||||
|
results))
|
||||||
|
(cons it (if (cdr queries)
|
||||||
|
(--map (rec (cdr queries) it)
|
||||||
|
results)
|
||||||
|
results))))))
|
||||||
|
(when-let* ((indent 0)
|
||||||
|
(results (org-ql-select buffers-or-files
|
||||||
|
(car queries)
|
||||||
|
:action 'element-with-markers
|
||||||
|
:narrow narrow
|
||||||
|
:sort sort)))
|
||||||
|
(->> (if (cdr queries)
|
||||||
|
(--map (rec (cdr queries) it (1+ indent))
|
||||||
|
results)
|
||||||
|
results)
|
||||||
|
(-flatten-n (1- (length queries)))
|
||||||
|
-non-nil
|
||||||
|
(org-ql-agenda--agenda nil nil
|
||||||
|
:entries)))))
|
||||||
|
|
||||||
|
(cl-defun org-ql-select-recursive (buffers-or-files queries &key action narrow sort)
|
||||||
|
(cl-labels ((rec (queries element indent)
|
||||||
|
(org-with-point-at (org-element-property :org-marker element)
|
||||||
|
(when-let* ((results (progn
|
||||||
|
(org-narrow-to-subtree)
|
||||||
|
(org-ql-select (current-buffer)
|
||||||
|
(car queries)
|
||||||
|
:action 'element-with-markers
|
||||||
|
:narrow t
|
||||||
|
:sort sort))))
|
||||||
|
;; Indent entry for each level
|
||||||
|
(setf results (--map
|
||||||
|
(org-element-put-property it :raw-value
|
||||||
|
(concat (s-repeat (* 5 indent) " ")
|
||||||
|
(org-element-property :raw-value it)))
|
||||||
|
results))
|
||||||
|
(cons it (if (cdr queries)
|
||||||
|
(--map (rec (cdr queries) it)
|
||||||
|
results)
|
||||||
|
results))))))
|
||||||
|
(when-let* ((indent 0)
|
||||||
|
(results (org-ql-select buffers-or-files
|
||||||
|
(car queries)
|
||||||
|
:action 'element-with-markers
|
||||||
|
:narrow narrow
|
||||||
|
:sort sort)))
|
||||||
|
(->> (if (cdr queries)
|
||||||
|
(--map (rec (cdr queries) it (1+ indent))
|
||||||
|
results)
|
||||||
|
results)
|
||||||
|
(-flatten-n (1- (length queries)))
|
||||||
|
-non-nil))))
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
** PROJECT [#B] Timeline view
|
||||||
|
:PROPERTIES:
|
||||||
|
:ID: 00573552-ffe9-4608-8904-7f6c73246b6d
|
||||||
|
:END:
|
||||||
|
|
||||||
|
e.g. as mentioned by Samuel Wales at https://lists.gnu.org/archive/html/emacs-orgmode/2019-08/msg00330.html. Prototype code:
|
||||||
|
|
||||||
|
#+BEGIN_SRC elisp
|
||||||
|
(cl-defun org-ql-timeline (buffers-files query)
|
||||||
|
(let ((results
|
||||||
|
(org-ql-select buffers-files
|
||||||
|
query :action
|
||||||
|
(lambda ()
|
||||||
|
(let* ((heading-string
|
||||||
|
(->> (org-element-headline-parser
|
||||||
|
(line-end-position))
|
||||||
|
org-ql--add-markers
|
||||||
|
org-ql-agenda--format-element))
|
||||||
|
(timestamps
|
||||||
|
(cl-loop with limit = (org-entry-end-position)
|
||||||
|
while (re-search-forward org-ts-regexp-both
|
||||||
|
limit t)
|
||||||
|
collect (ts-parse-org (match-string 0))))
|
||||||
|
(timestamp-strings
|
||||||
|
(->> timestamps
|
||||||
|
(-sort #'ts<)
|
||||||
|
(--map (concat " " (ts-format it))))))
|
||||||
|
(s-join "\n" (cons heading-string timestamp-strings))))
|
||||||
|
:sort '(date))))
|
||||||
|
(org-ql-agenda--agenda nil nil :strings results)))
|
||||||
|
|
||||||
|
(org-ql-timeline (org-agenda-files)
|
||||||
|
'(and "Emacs" (ts)))
|
||||||
|
|
||||||
|
;; More timeline-like version, organized by date rather than task.
|
||||||
|
|
||||||
|
(cl-defun org-ql-timeline* (buffers-files query &key filter-ts)
|
||||||
|
(let* ((ts-ht (ht))
|
||||||
|
(results (org-ql-select buffers-files
|
||||||
|
query
|
||||||
|
:action (lambda ()
|
||||||
|
(let* ((heading-string
|
||||||
|
(->> (org-element-headline-parser
|
||||||
|
(line-end-position))
|
||||||
|
org-ql--add-markers
|
||||||
|
org-ql-agenda--format-element))
|
||||||
|
(date-timestamps
|
||||||
|
;; Each one set to 00:00:00.
|
||||||
|
(cl-loop with limit = (org-entry-end-position)
|
||||||
|
while (re-search-forward org-ts-regexp-both
|
||||||
|
limit t)
|
||||||
|
collect (->> (match-string 0)
|
||||||
|
ts-parse-org
|
||||||
|
(ts-apply :hour 0 :minute 0 :second 0)))))
|
||||||
|
(setf date-timestamps (delete-dups date-timestamps))
|
||||||
|
(when filter-ts
|
||||||
|
(setf date-timestamps (cl-remove-if-not filter-ts date-timestamps)))
|
||||||
|
(--each date-timestamps
|
||||||
|
(push heading-string (gethash it ts-ht)))))))
|
||||||
|
(tss-sorted (-sort #'ts< (ht-keys ts-ht)))
|
||||||
|
(strings (cl-loop for ts in tss-sorted
|
||||||
|
collect (concat "\n"
|
||||||
|
(propertize (ts-format "%Y-%m-%d" ts)
|
||||||
|
'face 'org-agenda-structure))
|
||||||
|
append (ht-get ts-ht ts))))
|
||||||
|
(org-ql-agenda--agenda nil nil :strings strings)))
|
||||||
|
|
||||||
|
(org-ql-timeline* (org-agenda-files)
|
||||||
|
'(ts :from -14)
|
||||||
|
:filter-ts `(lambda (ts)
|
||||||
|
(ts<= ,(ts-adjust 'day -14 (ts-now)) ts)))
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
Another, more up-to-date implementation:
|
||||||
|
|
||||||
|
#+BEGIN_SRC elisp
|
||||||
|
;; NOTE: ts structs don't (sometimes? or always?) compare properly
|
||||||
|
;; with default hash tables, e.g. this code:
|
||||||
|
|
||||||
|
;; (let* ((ts-a #s(ts nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 1572670800.0))
|
||||||
|
;; (ts-b #s(ts nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 1572584400.0)))
|
||||||
|
;; (list :equal (equal ts-a ts-b)
|
||||||
|
;; :sxhash-equal (equal (sxhash ts-a) (sxhash ts-b)))) ;;=> (:equal nil :sxhash-equal t)
|
||||||
|
|
||||||
|
;; So we must use the "contents-hash" table as described in the Elisp manual.
|
||||||
|
(define-hash-table-test 'contents-hash 'equal 'sxhash-equal)
|
||||||
|
|
||||||
|
(cl-defun org-ql-view-timeline (buffers-files &key from to on)
|
||||||
|
"FIXME: DOcstring"
|
||||||
|
(cl-flet ((parse-ts-arg
|
||||||
|
(arg type)
|
||||||
|
;; Parse ARG as a string or TS struct and adjust it to the beginning
|
||||||
|
;; or end of its day, depending on whether TYPE is `:begin' or `:end'.
|
||||||
|
(-let (((hour minute second) (cl-ecase type
|
||||||
|
(:begin '(0 0 0))
|
||||||
|
(:end '(23 59 59)))))
|
||||||
|
(->> (cl-typecase arg
|
||||||
|
(string (ts-parse arg))
|
||||||
|
(ts arg))
|
||||||
|
(ts-apply :hour hour :minute minute :second second)))))
|
||||||
|
(let* ((ts-predicate `(lambda (ts)
|
||||||
|
,(cond (on `(ts-in ,(parse-ts-arg on :begin)
|
||||||
|
ts
|
||||||
|
,(parse-ts-arg on :end)))
|
||||||
|
((and from to) `(ts-in ,(parse-ts-arg from :begin)
|
||||||
|
ts
|
||||||
|
,(parse-ts-arg to :end)))
|
||||||
|
(from `(ts<= ,(parse-ts-arg from :begin) ts))
|
||||||
|
(to `(ts<= ts ,(parse-ts-arg to :end)))
|
||||||
|
(t (user-error "Huh?")))))
|
||||||
|
(query (cond (on `(ts :from ,(parse-ts-arg on :begin)
|
||||||
|
:to ,(parse-ts-arg on :end)))
|
||||||
|
(t (append (list 'ts)
|
||||||
|
(when from
|
||||||
|
`(:from ,(parse-ts-arg from :begin)))
|
||||||
|
(when to
|
||||||
|
`(:to ,(parse-ts-arg to :end)))))))
|
||||||
|
(date-ts-table (make-hash-table :test 'contents-hash))
|
||||||
|
(_results (org-ql-select buffers-files query
|
||||||
|
:action (lambda ()
|
||||||
|
(let* ((string (->> (org-element-headline-parser
|
||||||
|
(line-end-position))
|
||||||
|
org-ql--add-markers
|
||||||
|
org-ql-view--format-element)))
|
||||||
|
(cl-loop with limit = (org-entry-end-position)
|
||||||
|
while (re-search-forward org-ts-regexp-both limit t)
|
||||||
|
for ts = (->> (match-string 0) ts-parse-org)
|
||||||
|
when (funcall ts-predicate ts)
|
||||||
|
do (cl-pushnew (cons ts (concat (ts-format " %H:%M" ts)
|
||||||
|
string))
|
||||||
|
(gethash (ts-apply :hour 0 :minute 0 :second 0 ts)
|
||||||
|
date-ts-table)
|
||||||
|
:test #'equal))))))
|
||||||
|
(date-tss-sorted (->> date-ts-table hash-table-keys (-sort #'ts<)))
|
||||||
|
(string (cl-loop for date-ts in date-tss-sorted
|
||||||
|
for date-string = (propertize (ts-format "%Y-%m-%d" date-ts)
|
||||||
|
'face 'org-agenda-structure)
|
||||||
|
concat (concat "\n" date-string)
|
||||||
|
concat (cl-loop for (ts . entry) in (->> (gethash date-ts date-ts-table)
|
||||||
|
(-sort (-on #'ts< #'car)))
|
||||||
|
concat (concat "\n" entry)))))
|
||||||
|
(org-ql-view--display :buffer "Timeline"
|
||||||
|
:header "Timeline"
|
||||||
|
:string string))))
|
||||||
|
|
||||||
|
;; Used like:
|
||||||
|
;; (org-ql-view-timeline "~/org/main.org" :from "2019-11-01")
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
[2019-09-26 Thu 21:28] Would probably make sense to implement this using the view-sections someday.
|
||||||
|
|
||||||
|
** PROJECT [#B] Implement view with tabulated-list-mode or magit-section
|
||||||
|
|
||||||
|
[2019-09-02 Mon 05:20] Especially with some of the new packages that make =tabulated-list-mode= easier to use, like =navigel=. However, it would probably break grouping, or require some kind of adapter or extension to do grouping, so I don't know if that would work. Something like =magit-section= would be more flexible, and could be recursively grouped, like in =magit-todos=.
|
||||||
|
|
||||||
|
[2019-09-08 Sun 10:06] Came up with a prototype yesterday, in branch =wip/view-section=. Seems to work pretty well.
|
||||||
|
|
||||||
|
One of the things in that branch is =org-ql-item=, which is a struct used to carry data for query results. It seems to work well.
|
||||||
|
|
||||||
|
Another idea for it is to simply store the element from =org-element-headline-parser= in one of its slots, and populate all of the other slots lazily, like =ts=. It already does that for a couple of slots, but I think it makes sense to do it for all of them, to reduce the overhead of making the struct for every query result.
|
||||||
|
|
||||||
|
*** MAYBE [#C] Experiment with =widget=
|
||||||
|
|
||||||
|
The code that powers the customization UI. Has collapsible and customizable widgets. Might be perfect. Might even enable editing items in the list, with functions to make the changes in the source buffers.
|
||||||
|
|
||||||
|
*** Code idea
|
||||||
|
|
||||||
|
Inserting items into a view could look something like this:
|
||||||
|
|
||||||
|
#+BEGIN_SRC elisp
|
||||||
|
(org-ql-view--insert-items
|
||||||
|
:header (ts-format "%Y-%m-%d" (ts-now))
|
||||||
|
:items (org-ql-query
|
||||||
|
:select #'org-ql-current-item
|
||||||
|
:from (org-agenda-files)
|
||||||
|
:where '(or (deadline auto)
|
||||||
|
(scheduled :on today)
|
||||||
|
(ts-active :on today)))
|
||||||
|
:group-by '(org-ql-item-priority
|
||||||
|
org-ql-item-todo))
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
Items would be structs, and the =group-by= argument would be a list of accessors, like how =magit-todos= works. Arbitrary functions could also be passed to =group-by=, as whatever value the function returns is used to group them. =org-ql-current-item= would be a function that turns the result of =org-element-headline-parser= into the struct.
|
||||||
|
|
||||||
|
Not sure if it should automatically add the number of items to the header, or if that should be done manually.
|
||||||
|
|
||||||
|
*** Prior art
|
||||||
|
|
||||||
|
**** [[https://github.com/m2ym/direx-el][GitHub - m2ym/direx-el: Directory Explorer for GNU Emacs]]
|
||||||
|
|
||||||
|
Appears to be another implementation of magit-section-like expandable sections. Not sure which came first. Its code seems like it may be helpful.
|
||||||
|
|
||||||
|
**** magit-section
|
||||||
|
|
||||||
** PROJECT Dynamic blocks
|
** PROJECT Dynamic blocks
|
||||||
|
|
||||||
*** TODO [#B] Save view to dynamic block
|
*** TODO [#B] Save view to dynamic block
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue