2023-07-10 15:21:52 +02:00
|
|
|
;;; org-index-capture --- dynamic block example -*- lexical-binding: t; -*-
|
|
|
|
|
;;; Blog: https://one-octet.dev/posts/org-mode-dynamic-index.html
|
|
|
|
|
|
|
|
|
|
(require 'org)
|
|
|
|
|
|
2024-01-14 12:42:32 +01:00
|
|
|
(declare-function org-element-map "org-element" (data types fun &optional info first-match no-recursion with-affiliated))
|
|
|
|
|
(declare-function org-element-parse-buffer "org-element" (&optional granularity visible-only keep-deferred))
|
|
|
|
|
(declare-function org-element-property "org-element-ast" (property node))
|
|
|
|
|
|
2023-07-10 15:21:52 +02:00
|
|
|
(defun org-index-extract-infos (file-path)
|
|
|
|
|
"Extract all information for an index from FILE-PATH."
|
|
|
|
|
(with-temp-buffer
|
|
|
|
|
(insert-file-contents file-path)
|
|
|
|
|
(append
|
|
|
|
|
(org-element-map (org-element-parse-buffer) 'keyword
|
|
|
|
|
(lambda (keyword)
|
|
|
|
|
(list (org-element-property :key keyword)
|
|
|
|
|
(org-element-property :value keyword))))
|
|
|
|
|
(list (list "FILE-PATH" file-path)
|
|
|
|
|
(list "FILE-FULL-PATH" (expand-file-name file-path))))))
|
|
|
|
|
|
|
|
|
|
(defun org-index-list-files-path (directory)
|
|
|
|
|
"Get the DIRECTORY based names of all `.org' files in DIRECTORY."
|
|
|
|
|
(mapcar (lambda (file-name)
|
|
|
|
|
(file-name-concat directory file-name))
|
|
|
|
|
(directory-files directory nil ".org$")))
|
|
|
|
|
|
|
|
|
|
(defun org-index-sort-file-alists (alists)
|
|
|
|
|
"Sort a list of `.org' information alists by date."
|
|
|
|
|
(sort alists (lambda (file-a file-b)
|
|
|
|
|
(string> (cadr (assoc "DATE" file-a))
|
|
|
|
|
(cadr (assoc "DATE" file-b))))))
|
|
|
|
|
|
|
|
|
|
(defun org-index-spec-make (alist)
|
|
|
|
|
"Call `format-spec-make' using an `.org' file ALIST."
|
|
|
|
|
(let ((author (or (cadr (assoc "AUTHOR" alist)) "NO-AUTHOR"))
|
|
|
|
|
(creator (or (cadr (assoc "CREATOR" alist)) "NO-CREATOR"))
|
|
|
|
|
(date (or (cadr (assoc "DATE" alist)) "1999.12.31"))
|
|
|
|
|
(description (or (cadr (assoc "DESCRIPTION" alist)) "NO-DESCRIPTION"))
|
|
|
|
|
(file-full-path (cadr (assoc "FILE-FULL-PATH" alist)))
|
|
|
|
|
(file-path (cadr (assoc "FILE-PATH" alist)))
|
|
|
|
|
(language (or (cadr (assoc "LANGUAGE" alist)) "NO-LANGUAGE"))
|
|
|
|
|
(options (or (cadr (assoc "OPTIONS" alist)) "NO-OPTIONS"))
|
|
|
|
|
(title (or (cadr (assoc "TITLE" alist)) "NO-TITLE")))
|
|
|
|
|
(format-spec-make ?a author ?c creator
|
|
|
|
|
?d date ?D description
|
|
|
|
|
?l language ?o options
|
|
|
|
|
?P file-full-path ?p file-path
|
|
|
|
|
?t title)))
|
|
|
|
|
|
|
|
|
|
(defun org-dblock-write:index (params)
|
|
|
|
|
"Write a directory index."
|
|
|
|
|
(let ((directory (or (plist-get params :directory )
|
|
|
|
|
(file-name-directory (buffer-file-name))))
|
|
|
|
|
(sort-recent (plist-get params :sort-recent))
|
|
|
|
|
(fmt (or (plist-get params :format) "- %d: [[file:%p][%t]]"))
|
|
|
|
|
(alists nil))
|
|
|
|
|
(if sort-recent
|
|
|
|
|
(setq alists (org-index-sort-file-alists
|
|
|
|
|
(mapcar
|
|
|
|
|
'org-index-extract-infos
|
|
|
|
|
(org-index-list-files-path directory))))
|
|
|
|
|
(setq alists (mapcar
|
|
|
|
|
'org-index-extract-infos
|
|
|
|
|
(org-index-list-files-path directory))))
|
|
|
|
|
(mapcar
|
|
|
|
|
(lambda (alist)
|
|
|
|
|
(insert (format-spec fmt (org-index-spec-make alist)) "\n"))
|
|
|
|
|
alists)))
|
|
|
|
|
|
|
|
|
|
;;;###autoload
|
|
|
|
|
(defun org-index-insert-dblock (directory)
|
|
|
|
|
"Create a dynamic block capturing a directory index."
|
|
|
|
|
(interactive
|
|
|
|
|
(list (string-replace
|
|
|
|
|
(file-name-directory (buffer-file-name))
|
|
|
|
|
""
|
|
|
|
|
(expand-file-name (read-directory-name "Directory to index: ")))))
|
|
|
|
|
(org-create-dblock
|
|
|
|
|
(list :name "index"
|
|
|
|
|
:directory directory)))
|
|
|
|
|
|
|
|
|
|
(org-dynamic-block-define "index" 'org-index-insert-dblock)
|
|
|
|
|
|
|
|
|
|
(provide 'org-index-capture)
|
|
|
|
|
|
|
|
|
|
;;; org-index-capture.el ends here
|
