特性
def
def, (![SYM VAL]), 关联符号及其值。
D:def
SYM 必须满足 symbolp 且非 t, nil.
VAL 必须满足 functionp 或 macrop.
合法时返回 SYM, 否则返回 nil.
用例：
T:def
(! deftest (!def)
`("!def FUNCTION"
(equal
(symbol-function
(!def (make-symbol "x") (![]0)))
(![]0))
"!def MACRO"
(equal
(symbol-function
(!def (make-symbol "x") (!""0)))
(!""0))
"!def as setf"
(let ((x 0))
(and (!def x 1) (eq x 1)
(setf x '((a . 2)))
(!def (alist-get 'a x) 3)
(eq (alist-get 'a x) 3)))
;; 当入参 sym 满足 (not (boundp sym)) 时
;; 将其 bind 到自身。
"!def FM symbol with unbound value"
(let ((s (make-symbol "x")))
(!def s (![]0))
(and
(equal (symbol-function s) (![]0))
(eq (symbol-value s) s)))
"!def FM symbol with bound value"
(let ((s (make-symbol "x")))
(!def s (![]0))
(set s 0)
(and
(equal (symbol-function s) (![]0))
(eq (symbol-value s) 0)))))
默认实现：
F:def
(defalias (fmakunbound '!def)
(! package
(!"sym val"
(declare ((! indent) (! indent 1)))
(let ((v (gensym 'v)))
`(let ((,v ,val))
(or (!def !def
(ignore-error
'void-variable ,sym)
,v)
(setf ,sym ,v)))))))
(!def def 'fm-args?
(![sym val]
(cond
;; check
((null sym) nil) ((eq sym 't) nil)
((not (symbolp sym)) nil)
((not (or (functionp val) (macrop val)
(special-form-p val)))
nil)
(t))))
(!def def '!def)
(!def def '!def
(![sym val]
"定义函数或宏。
<<@([[id:D:def]])>>"
(declare (!export t))
(and (!def fm-args? sym val)
(funcall (symbol-value (!def !def))
sym val))))
;; 入参只有两个时直接进入 default 分支: 定义符号。
(!def def `(and (length= args 2)
(not (eq car (ignore-errors(! test))))
default))
(!def def 'def1
(![sym val &rest conf]
(unless (eq sym val) (defalias sym val))
(unless (boundp sym) (set sym sym))
sym))
(set (!def !def) (!def def1))
declare
处理 Declare Form 的特性。
用例：
T:declare
(! test defcase (!def)
;; (!def s s) 时仅处理 declare form, 因为
;; 因为入参 sym 与 val 相同。此用例提供一种
;; 延迟配置 declare form 的手段。
"!def setup declare properties"
`(let ((s (make-symbol "x")) f)
(defalias s ()))
(set s 1)
(setq f (symbol-function s))
(and
(eq (symbol-function s) f)
(eq (get s 'lisp-indent-function) nil)
(!def s s)
(eq (symbol-function s) f)
(eq (get s 'lisp-indent-function) 1)
(eq (symbol-value s) 1))))
实现：
F:declare
(!def def 'find-decl
(![fm default]
<<@([[id:B:find-decl]])>>))
(!def def 'decl-alist
(![fm alist]
<<@([[id:B:decl-alist]])>>))
(!def def 'def2
(let ((def (symbol-value (!def !def))))
(![sym val &rest conf]
<<@([[id:B:def2]])>>)))
(set (!def !def) (!def def2))
<<@([[id:T:declare]])>>
B:def2
"Declare Form 机制"
(cond*
((bind* (alist (or (plist-get conf :alist)
(!def decl-alist val nil)))))
((null alist) (apply def sym val conf))
((bind* (decl (or (plist-get conf :decl)
(!def find-decl val nil)))))
((null decl) (apply def sym val conf))
;; do declare form
((bind* (decls (cdr-safe decl))
(arglist (help-function-arglist val))))
((bind* (d (and decls (listp arglist))))
(dolist (decl decls)
(setf
d (car (alist-get (car decl) alist))
d (if d (apply d sym arglist (cdr decl)))
d (if d (eval d t)))))
(t (setq conf (plist-put conf :alist alist)
conf (plist-put conf :decl decl))
(apply def sym val conf)))
辅助函数：
B:find-decl
;; 特意添加 default 参数，让 !def 调用时入参数量大于 2.
"提取函宏 FM 的 Declare Form"
(declare (!export t))
(cond*
;; fm?
((not (or (functionp fm) (macrop fm))) nil)
;; impl
((bind* (impl (indirect-function fm))))
((and (macrop impl) (setf impl (cdr impl)) nil))
;; body
((bind* (body nil)))
((and (closurep impl)
(interpreted-function-p impl)
(setf body (aref impl 1))
nil))
((and (null body)
(eq (car-safe impl) 'lambda)
(setf body (cddr impl))
nil))
;; decl
((bind* (e t) (decl))
(while (and (null decl) body)
(setq e (car body) body (cdr body))
(cond
;; (progn '(declare ...) nil)
((and (eq (car-safe e) 'progn)
(memq nil (last e))
(setq e (nth 1 e) e (cdr-safe e))
(setq e (car e))
nil))
;; (declare ...)
((eq (car-safe e) 'declare)
(setq decl e)))))
(t (or decl default)))
D:decl-alist
返回 ‘defun-declarations-alist’
或 ‘macro-declarations-alist’
或 nil 若 FM 非函宏。
B:decl-alist
;; 特意添加 alist 参数，让 !def 调用时入参数量大于 2.
"提取函宏所需的 Declare Form 处理函数。
<<@([[id:D:decl-alist]])>>"
(append
(cond
((and (functionp fm) defun-declarations-alist))
((and (macrop fm) macro-declarations-alist)))
alist)
!declare
针对 excl 的 Declare Form 扩展。当前支持的特性包括：
((! see also) SYMBOL):
参考 SYMBOL 符号。
(!export t) or (!export t if unbound):
将 t 绑定到符号的 !export 属性。
(!apply . APPLY-FORM):
将 APPLY-FORM 绑定到符号的 !apply 属性。
((! indent) INDENT):
求值 INDENT 并绑定到符号的 lisp-indent-function 属性。
实现：
F:!declare
(!def def 'def3
(let ((def (symbol-value (!def !def))))
(![sym val &rest conf]
"针对 !XXX 的 Declare Form"
(cond*
((bind* (alist (or (plist-get conf :alist)
(!def decl-alist val nil)))))
((null alist) (apply def sym val conf))
((bind* (decl (or (plist-get conf :decl)
(!def find-decl val nil)))))
((null decl) (apply def sym val conf))
;; do declare form
((bind* (decls (cdr-safe decl))))
((bind* (d (assoc '(! see also) decls)) e)
(setq
e (indirect-function val)
e (if (macrop e) (cdr e) e)
e (ignore-errors (aref e 2))
d (ignore-errors (eval (cadr d) (or e t)))
decls `(,@decls
,@(cdr-safe (!def find-decl d nil)))))
((bind* (d (assq '!apply decls)))
(put sym '!apply (cadr d)))
((bind* (d (assq '!export decls)))
(cond
((equal (cdr d) '(t if unbound))
(unless (plist-member (symbol-plist sym)
'!export)
(put sym '!export t)))
((put sym '!export (cadr d)))))
((bind* (d (assoc '(! indent) decls)))
(put sym 'lisp-indent-function
(or (ignore-errors (eval (cadr d) t))
(![...]
(ignore-errors
(setq d (eval (cadr d) t))
(prog1 (apply d ...)
(put sym 'lisp-indent-function
d)))))))
(t (setq conf (plist-put conf :alist alist)
conf (plist-put conf :decl decl))
(apply def sym val conf))))))
(set (!def !def) (!def def3))
gen
!def gen, (![sym reuse-unbound]), 一个创建符号的工具。
D:gen
SYM 为 symbol 或 string.
返回一个 unintern 符号。
当 SYM 已是 unintern 符号时，下述情况将返回 SYM 自身：
REUSE-UNBOUND 为 t 且
SYM 的 function 及 value cell unbound;
REUSE-UNBOUND 为 nil 且
SYM 的 function 及 value cell unbound 或为 nil.
用例：
T:gen
(! test defcase (!def)
;; "创建符号"
;; '(let ((x (!def 'x))) (eq x (!def x)))
"用 symbol 创建新符号"
'(and (not (eq (!def gen 'x []) 'x))
(not (eq (!def gen 'x [])
(!def gen 'x []))))
"用 string 创建符号"
'(and (not (eq (!def gen "x" t) 'x))
(not (eq (!def gen "x" t)
(!def gen "x" t))))
"复用 unbound 的 unintern 符号"
'(let ((x (!def gen 'x t)))
(eq (!def gen x t) x))
"复用 null 的 unintern 符号"
'(let ((x (!def gen 'x nil)))
(and (eq (!def gen x nil) x)
(always (setf (symbol-function x) nil))
(eq (!def gen x nil) x)
(always (setf (symbol-value x) nil))
(eq (!def gen x nil) x))))
实现：
F:gen
(!def def 'gen
(![sym reuse-unbound]
<<@([[id:B:gen]])>>))
;; 入参只有一个时创建新符号。
(!def def `(and (length= args 1)
(listp car)
(eq 'quote (car car))
(symbolp (cadr car))
()))
<<@([[id:T:gen]])>>
B:gen
"用 ‘make-symbol’ 创建新符号 SYM.
<<@([[id:D:gen]])>>"
(declare (!export t))
(cond*
((stringp sym) (make-symbol sym))
((not (symbolp sym)) nil)
((bind* (n (symbol-name sym))
(i? (intern-soft n))))
;; 如 sym 非 intern 且 functon, value
;; cell 均 unbound, 直接返回 sym.
((and (not (eq i? sym)) (eq reuse-unbound t)
(null (symbol-function sym))
(not (boundp sym)))
sym)
;; 如 sym 非 intern 且 functon, value
;; cell 为 nil 或 unbound, 直接返回 sym.
((and (not (eq i? sym)) (eq reuse-unbound nil)
(or (not (boundp sym))
(null (symbol-value sym)))
(null (symbol-function sym)))
sym)
((make-symbol n)))
after-define-hook
一个符号定义后的函数钩子特性。
F:after-define-hook
(!def def 'def4
(let ((def (symbol-value (!def !def))))
(![sym val &rest conf]
"After Defined Hook 机制"
(when (apply def sym val conf)
(put sym 'after-defined-hooks
(seq-uniq (get sym 'after-defined-hooks)))
(dolist (h (get sym 'after-defined-hooks))
(cond
((listp h) (eval h t))
((funcall h))))
;; (put sym 'after-defined-hooks nil)
sym))))
(set (!def !def) (!def def4))
wrap
(!def def 'wrap
(![def quote-symbol ignore-!def]
"符号定义封装
调用 DEF 定义符号，并设置同名局部变量。配合 let 局部符号使用。
QUOTE-SYMBOL
t 时，返回的 def 的定义符号时调用式为: (def 'sym val);
nil 时 (def sym val)."
(declare (!export t))
(cond*
((bind* code local-sym))
((when quote-symbol
(setf
local-sym ',(cadr s)
code '(let ((:sym: (:def: ,s ,v)))
(ignore-errors
(setq ,(cadr s) :sym:))
:sym:))
nil))
((when (not quote-symbol)
(setf
local-sym ',s
code '(let ((:sym: (:def: ',s ,v)))
(ignore-errors
(setq ,s :sym:))
:sym:))
nil))
((when ignore-!def
(setf
code `(if (eq ',local-sym '!def)
(ignore-errors (setq !def '!def))
,code))
nil))
((setf
code (! M
(let (p f (s (gensym 's)))
(setf
p (![x]
(if (eq x :def:) def
(if (eq x :sym:) s
(if (atom x) x (! M f x)))))
f ()))
code))
(eval `(!"s &optional v"
,(cons '\` (list code)))
t)))))
DOC
DOC
(! defdoc '!def
"定义符号或设置变量
ARGS: (SYM FM)
关联符号 SYM 与 函宏 FM. 见 "(! button (!def !def))".
ARGS: (PLACE VAL)
关联返回值非符号的泛型变量 PLACE 及其值 VAL.\n\n"
"符号：" (! button
(seq-filter ()
(! export all '!def)))
"\n\n"
"详细用例参考：" (! button (! test (!def))))
版本
x.1
.1, 无依赖，原始引用，一个可 buffer 执行的的自举用版本。
;;; !def -*- lexical-binding: t; -*-
<<2026-02-13-16-19>>
1.x
TARGET
;;; !def -*- lexical-binding: t; -*-
<<@([[id:F:def]])>>
<<@([[id:T:def]])>>
;;;; !def declare
<<@([[id:F:declare]])>>
<<@([[id:F:!declare]])>>
<<@([[id:F:after-define-hook]])>>
;;;; !def utils
<<@([[id:F:gen]])>>
<<@([[id:DOC]])>>
(! test all (!def))
;;;; !def 对 ! 的配置
;; 重新配置 ! 的符号属性
(! :def '!def)
(dolist (s `(! ,@(! export all))) (!def s s))
(dolist (s `(!def ,@(! export all '!def))) (!def s s))
MAPPING
;; F:def
"F:def"
"[[2026-02-13-16-19]]"
"D:def"
"[[2026-02-13-16-21]]"
"T:def"
"[[2026-01-28-16-33]]"
;; F:declare
"F:declare"
"[[2026-02-06-09-43]]"
"B:find-decl"
"[[2026-02-06-09-45]]"
"B:decl-alist"
"[[2026-02-06-09-46]]"
"B:def2"
"[[2026-02-06-09-47]]"
"D:decl-alist"
"[[2026-02-13-16-37]]"
"T:declare"
"[[2026-02-06-09-44]]"
;; F:!declare
"F:!declare"
"[[2026-02-06-16-41]]"
;; F:gen
"F:gen"
"[[2026-02-06-10-01]]"
"B:gen"
"[[2026-02-06-09-57]]"
"D:gen"
"[[2026-02-06-15-02]]"
"T:gen"
"[[2026-02-06-09-56]]"
;; F:after-define-hook
"F:after-define-hook"
"[[2026-02-06-17-08]]"
;; DOC
"DOC"
"[[2026-02-06-14-54]]"
nil nil
"TARGET"
"[[2026-02-06-14-07]]"
"F:wrap"
"[[2026-02-06-16-54]]"
构建
构建
(setq mapping (org-noweb-expand-link mapping)
mapping (read (format "(%s)" mapping)))
(cond
((and conf-only (member conf-only '(t "yes")))
(org-id-remap 'reset)
(apply 'org-id-remap mapping)
(org-id-remap 'enable)
;; return "" for expand nothing
"")
((org-with-id-remap mapping
(cond
(tangle
(org-exec target 'org-babel-tangle '(4) tangle))
((org-exec target nil :eval "yes" :results "none"
:lexical t :noweb "yes"))))))
autoload
(when (not(file-exists-p file))
(org-exec
tangle nil :eval "yes" :results "none"
:lexical t :noweb "yes" 'tangle file))
(load file)
