Work on introspection for better `org-columns' support

This commit is contained in:
Gerard Vermeulen 2023-06-22 17:34:55 +02:00
parent e417de40b4
commit 0aab3875c9

View File

@ -2172,7 +2172,8 @@ list detailing and motivating each listing:
ol-info ol-info
org-id org-id
org-protocol org-protocol
org-tempo))) org-tempo)
org-use-property-inheritance t))
#+end_src #+end_src
#+caption[Setup =org-babel=]: #+caption[Setup =org-babel=]:
@ -2716,14 +2717,13 @@ Set ~org-html-style-default~ option to add =HTML+CSS+JS= for ~mhtml-mode~:
*** Org introspection *** Org introspection
:PROPERTIES: :PROPERTIES:
:CUSTOM_ID: sec:org-introspection :CUSTOM_ID: sec:org-introspection
:header-args:emacs-lisp: :exports code :tangle no
:END: :END:
#+caption[Find valid entries for =org-babel-load-languages=]: #+caption[Find valid entries for =org-babel-load-languages=]:
#+caption: Find valid entries for =org-babel-load-languages=. #+caption: Find valid entries for =org-babel-load-languages=.
#+name: lst:valid-org-babel-load-languages-entries #+name: lst:valid-org-babel-load-languages-entries
#+header: :wrap "src emacs-lisp :results silent :tangle no" #+header: :wrap "src emacs-lisp :results silent :tangle no"
#+begin_src emacs-lisp :exports both :results value pp #+begin_src emacs-lisp :exports both :results value pp :tangle no
(defun all-org-babel-execute-fns () (defun all-org-babel-execute-fns ()
"Find `ob-LANGUAGE' files in Org defining `org-babel-execute:LANGUAGE'. "Find `ob-LANGUAGE' files in Org defining `org-babel-execute:LANGUAGE'.
@ -2803,7 +2803,7 @@ Return a list of items where the filename is the `car' of each item and the
#+caption: Find active Org Babel languages. #+caption: Find active Org Babel languages.
#+name: lst:org-babel-active-languages #+name: lst:org-babel-active-languages
#+header: :wrap "src emacs-lisp :results silent :tangle no" #+header: :wrap "src emacs-lisp :results silent :tangle no"
#+begin_src emacs-lisp :exports both :results value pp #+begin_src emacs-lisp :exports both :results value pp :tangle no
(defun org-babel-active-languages () (defun org-babel-active-languages ()
(let ((result '("conf" "text" "toml"))) (let ((result '("conf" "text" "toml")))
(mapatoms (mapatoms
@ -2851,6 +2851,83 @@ Return a list of items where the filename is the `car' of each item and the
("toml")) ("toml"))
#+end_src #+end_src
#+caption[Jump to an Org =headline=]:
#+caption: Jump to an Org =headline=. A ~mapcan~ filter works on the
#+caption: result of ~cl-loop~ and ~collect~ to return a list containing
#+caption: the position and text of all matching headlines.
#+name: lst:jump-org-headline
#+begin_src emacs-lisp :results silent
(with-eval-after-load 'org-element
(defun jump-org-headline (target)
"Jump to the first org-mode headline matching TARGET."
(interactive "sTarget: ")
(if (derived-mode-p 'org-mode)
(when-let
((ok (mapcan
(lambda (x) (when (car x) (cdr x)))
(cl-loop
for (here . text)
in (org-element-map (org-element-parse-buffer) 'headline
(lambda (hl)
(cons (org-element-property :begin hl)
(org-element-property :raw-value hl))))
collect (list (string= target text) here text))))
(n (/ (length ok) 2)))
(goto-char (car ok))
(when (> n 1)
(user-error "Found %s headlines `%s'" n target)))
(message "Found no `%s' headline (`%s')" target major-mode))))
#+end_src
#+caption[Sync the "#+COLUMNS:" keyword with a ":COLUMNS:" property]:
#+caption: Sync the "#+COLUMNS:" keyword with a ":COLUMNS:" property.
#+name: lst:sync-columns-keyword-with-property
#+begin_src emacs-lisp :results silent
(with-eval-after-load 'org
(defun get-org-columns-property (target level)
"Get headline TARGET \":COLUMNS:\" property at LEVEL."
(let (case-fold-search done (here (point)))
(goto-char (point-max))
(while (re-search-backward org-complex-heading-regexp nil t)
(let ((beginning (match-beginning 1))
(headline (match-string-no-properties 4)))
(when (and (string= headline target)
(= (org-current-level) level))
(goto-char beginning)))
(setq done (plist-get (org-element--get-node-properties) ':COLUMNS)))
(goto-char here)
done))
(defun get-org-columns-keyword-match ()
"Get \"#+COLUMNS:\" keyword match data for replacement."
(org-with-wide-buffer
(goto-char (point-min))
(let ((case-fold-search t) done
(regexp "\\(^[ \t]*#\\+COLUMNS: \\)\\(.+\\)$"))
(while (and (not done) (re-search-forward regexp nil t 1))
(when (eq (org-element-type (org-element-at-point)) 'keyword)
(setq done (list (regexp-quote (match-string 2))
(match-beginning 2) (match-end 2)))))
done)))
(defun sync-org-columns-keyword-property (target level)
"Sync \"#+COLUMNS:\" keyword with \":COLUMNS:\" property.
The property is from the drawer of headline matching TARGET and LEVEL."
(when-let ((property (get-org-columns-property target level))
(match (get-org-columns-keyword-match)))
(org-with-wide-buffer
(goto-char (point-min))
(let ((case-fold-search t) done
(regexp "\\(^[ \t]*#\\+COLUMNS: \\)\\(.+\\)$"))
(while (and (not done) (re-search-forward regexp nil t 1))
(when (eq (org-element-type (org-element-at-point)) 'keyword)
(replace-string
(nth 0 match) property nil (nth 1 match) (nth 2 match))
(setq done t)))))
(unless property (message "Can't find \":COLUMNS:\" property"))
(unless match (message "Can't find \"#+COLUMNS:\" keyword")))))
#+end_src
*** [[https://github.com/bdarcus/citar][Citar: citing bibliography]] with [[https://orgmode.org/][Org Mode]] *** [[https://github.com/bdarcus/citar][Citar: citing bibliography]] with [[https://orgmode.org/][Org Mode]]
:PROPERTIES: :PROPERTIES:
:CUSTOM_ID: sec:citing-bibliography :CUSTOM_ID: sec:citing-bibliography