拥有ID的Org节点
1 实现
在 org-N 的基础上，特化出具有 Org ID 的 Org节点。
org-id.PROPERTIES
#+name: 2025-08-20-21-02
#+begin_src emacs-lisp :lexical t :results silent
;;; org-id-property -*- lexical-binding: t; -*-
(defun org-id-property (property &optional id force)
"Org ID Property.
PROPERTY: 同 ‘org-referent-get’.
ID: Org ID.
FORCE: t 强制更新缓存。
返回: 属性值。"
(declare (indent 2))
(let ((at-point? (null id)) epom)
(when at-point?
(setq id (org-entry-get nil "ID" t))
(unless id
(user-error
"No ID refer to position %S %S"
(current-buffer) (point)))
;; (message "org-id at point: %s" id)
;; 因为上边获取 ID 时使用了 inherit 的方式
;; 所以需要定位所指位置。 在此代码路径下,
;; ‘org-referent-get’具有LINK 及 :epom
;; 信息，无需再定位。
(setq epom (org-find-entry-with-id id)))
(org-N property (format "id:%s" id)
:type 'id :force force :epom epom)))
(defmacro org-id-defprop (name base &rest kargs)
(declare (indent defun))
`(org-N-defprop ,name ,base
:type id
:get
(lambda (&optional id force)
"ID: Org ID.
FORCE: t 强制更新缓存。"
(org-id-property ',name id
(or force (eq this-command fn))))
,@kargs))
#+end_src
2 基于Org Properties的属性
#+name: 2025-08-20-21-03
#+begin_src emacs-lisp :lexical t :results silent
(org-id-defprop id "ID") ; => #'org-id.id
(org-id-defprop title "ITEM")
(org-id-defprop todo "TODO")
(org-id-defprop closed "CLOSED")
(org-id-defprop timestamp-ia "TIMESTAMP_IA")
#+end_src
3 基于函数符号的属性
#+name: 2025-08-20-21-04
#+begin_src emacs-lisp :lexical t :results silent
(org-id-defprop tags #'org-get-tags)
(org-id-defprop level #'org-current-level)
#+end_src
4 基于lambda的属性
基于lambda的属性: 节点的前链与后链。
#+name: 2025-08-20-21-05
#+begin_src emacs-lisp :lexical t :results silent
(org-id-defprop links
(lambda nil
"返回当前节点中所有 ID 链接。"
(org-with-wide-buffer
(org-narrow-to-subtree)
(org-element-map
(org-element-parse-buffer nil t t)
'(link)
(lambda (link)
(let ((type (org-element-property
:type link)))
(when (string= type "id")
(intern
(org-element-property
:path link)))))))))
(org-id-defprop backlinks
(lambda nil
"返回当前节点所有的 ID 后链。"
(when-let*
;; 同 org-id-property 保持一致，使用 inherited.
((id (org-entry-get nil "ID" t))
(_
(always
(unless (hash-table-p org-id-locations)
(org-id-update-id-locations))))
(scope
(when (hash-table-p org-id-locations)
(seq-uniq
(hash-table-values
org-id-locations))))
(bufs
(mapcar
(lambda (file)
(or (find-buffer-visiting file)
(find-file-noselect file)))
scope))
(backlinks
(mapcan
(lambda (buf)
(let ((re (concat
"\\["
"\\[id:" id "\\]"
"\\(\\[.*?\\]\\)?"
"\\]"))
(m (make-marker))
P)
(org-with-point-at (set-marker m 1 buf)
(save-match-data
(while (re-search-forward re nil t)
(and-let*
((p (org-entry-get
nil "ID" t))
(_ (not (string= p id)))
(p (intern p))
(_ (not (member p P))))
(push p P)))))
P))
bufs))
(backlinks
(seq-remove #'null backlinks)))
backlinks)))
#+end_src