石见 石页 https://dustincys.github.com 2026-11-07T10:28:31+00:00 yanshuoc@gmail.com 从土电话到 Emacs 收音机 https://dustincys.github.io/cn/2026/11/emacs-radio/ 2026-11-06T00:00:00+00:00 石见 石页 https://dustincys.github.io/cn/2026/11/emacs-radio 小时候没有什么娱乐,家里那台收音机,就是最好的伙伴。

天刚蒙蒙亮,中央人民广播电台的《新闻和报纸摘要》就响了,播音员字正腔圆地念着国家大事,那是全家的起床号。到了晚上,是孩子们的黄金时间——《小喇叭》一开播,小伙伴们就都凑到收音机跟前,跟着“哒嘀哒”的开场,听童话、听儿歌、听谜语。再大一点,又迷上了《广播书场》:说书人一拍惊堂木,武侠的刀光剑影、志怪的离奇诡谲,一个接一个从收音机里蹦出来,听得人饭都忘了吃。

平日里闲下来,我也爱拧着旋钮一个台一个台地找,专挑那些“有意思的节目”。等夜深了,家人都睡下,那才是一天里最妙的时刻——旋钮“咔哒咔哒”地一格一格走过去,指针越过中波、越过短波,忽然就撞进一个陌生的波段。夜深人静,天波反射得远,竟还能听到俄罗斯的远东广播电台。播音员说一口磕磕绊绊的普通话,信号飘飘忽忽,像从另一个世界传来的回声。

那时候我就想,这小小的收音机背后,到底藏着一个多大的世界。

后来读博士,网络又慢又贵,慢得只够听广播。 那几年常听的是中国国际广播电台的轻松调频(CRI Easy FM),尤其是下午那个三个人聊天的圆桌会议节目。 一边听广播,一边写代码,竟也成了一种修行、一种情怀。 我在网站里的“听广播”一栏里,还专门记过这事。

前些日子和娃娃玩“土电话”——两个纸杯、一根棉线,杯底打个洞,线绷直了,这头说话,那头把杯子扣在耳朵上就能听见。娃娃问,为什么隔着线也能听见?我解释:你说话让杯底震动,震动顺着棉线一路传到对面,对面的杯底再把震动还原成声音。娃娃似懂非懂地点点头,我却忽然想起了广播。

土电话说到底,是“有线”的:震动老老实实地在棉线里走。广播呢,是“无线”的:声音本身传不远,得把它“抬”到电磁波上,让电磁波驮着它满世界飞。这“抬上去”的动作,就是调制。最常见的两种调制,一种是调幅(AM),让载波的幅度跟着声音变;一种是调频(FM),让载波的频率跟着声音变。接收端再把声音从载波上“摘”下来,这叫解调。合起来,调制器加解调器,就是我们天天念叨却未必深究的那个词——调制解调器。我琢磨着,等娃娃再大一点,拿两个对讲机、一个示波器,就能把这套“调幅、调频、调制解调”给他讲明白了。

想明白了这些,也就想明白了广播的好处。它单向——一个台说话,千千万万人听,不用握手、不用协商,谁也不耽误谁;它同时——同一份信号,大家同时收到,没有先后;它传播简单——一条载波,一片天空,山高水远都拦不住;它接收最方便——一台收音机,拧开就响,不用交费、不用账号、不用配对、不用升级。这些在今天看来稀松平常,当年却是了不起的本事。

于是又想起小时候晚上拧旋钮的感觉,心里痒痒的。我查了些长波、中波电台的资料,下单买了一台德生 PL-330——长波、中波、短波、调频样样俱全的小机器,重新找回那种“旋钮咔哒、指针游走、电台从噪声里浮出来”的乐趣。 手机上也安装了收音机App,在老美开车的时候,听怀集音乐之声,在德州乡村小路上,有一种恍若隔世的感觉。 现在手机上的收音机App竟然一个赛一个地收费,广告还特别多,塞一堆花花绿绿的推荐,反而把“拧开就听”的干净劲儿给弄丢了。这不叫听广播,这叫刷广告。

那就不如自己做一个。于是有了 emacs-radio——一个放在Emacs里的网络收音机。既然手机App不可靠,就在自己最顺手的编辑器里听。一边写代码、写邮件,一边听着英文广播;想歇歇脑子,就切到新闻、音乐,或者听一段评书。昨日重现,仿佛回到小时候一边听广播一边写作业的时光,多美好。

Emacs Radio 图标

下面是演示视频:

它是怎么工作的

emacs-radio 本身不解码音频,它只做电台管理界面这一件事,把重活都交给现成的工具。整条流水线是这样的:

原始 radio_sources.tsv(分类 / 电台 / URL)
        │
        └─ M-x emacs-radio-scan
             │ make-process:后台执行 emacs-radio-probe.py
             │ Python 用 FFmpeg 检验流是否真的能解码,并按 URL 去重
             ▼
缓存目录 radio_playable.tsv / radio_results.csv / radio_playable.m3u
        │
        └─ emacs-radio-load:只载入"通过检测"的电台
             │
             └─ M-x emacs-radio:按播放次数倒序,用 Helm 列出候选
                   │
                   └─ emacs-radio-play:启动后台 mpv
                         │
                         ├─ mode-line 显示电台名与播放状态
                         ├─ 鼠标点击 → 暂停/恢复(经 mpv JSON IPC)
                         └─ emacs-radio-stop → 停止并隐藏显示

这里有个关键的设计判断:不是收到 HTTP 200 就算数,而是要让 FFmpeg 真的解码出 2 秒音频才算”可播放”。网络电台的流地址常常改版,很多链接表面活着、点进去却是一片死寂,所以先扫一遍、只留能出声的,是必要的一步。扫描是异步的,跑起来不卡编辑器,进度可以随时用 M-x emacs-radio-scan-log 查看。

安装

依赖很少:Emacs 27.1+、helm,外加系统里的 ffmpeg 和 mpv。

sudo apt install ffmpeg mpv

把 emacs-radio.el 和 emacs-radio-probe.py 放在同一个目录,radio_sources.tsv 可以单独放。然后在配置里加几句:

(add-to-list 'load-path "~/github/emacs-radio/")
(require 'emacs-radio)
(setq emacs-radio-sources-file "~/github/emacs-radio/radio_sources.tsv")
(setq emacs-radio-cache-directory "~/.emacs.d/emacs-radio-cache/")
(emacs-radio-mode 1)

;; 顺手绑几个快捷键
(global-set-key (kbd "C-c r r") #'emacs-radio)
(global-set-key (kbd "C-c r s") #'emacs-radio-scan)
(global-set-key (kbd "C-c r SPC") #'emacs-radio-toggle-pause)
(global-set-key (kbd "C-c r q") #'emacs-radio-stop)

使用

第一次先 M-x emacs-radio-scan,等它扫完。缓存目录里会多出三个文件:

  • radio_results.csv——所有测过的电台及状态/失败原因;
  • radio_playable.tsv——只含 FFmpeg 能解码的电台;
  • radio_playable.m3u——对应的播放列表。

之后 M-x emacs-radio(或 C-c r r)就能用 Helm 搜索这份验证过的清单。缓存启动时自动加载,只有流地址大面积失效时才需要重新扫描。

电台表 radio_sources.tsv 只有三列:分类、电台、URL,制表符分隔。仓库里已经附了一份覆盖全国几十个省市台、中央台和国际英语频道的清单,直接可用,也可以照格式自己添。扫描不会改动这份原始表,想加台、想换源,改 TSV 再扫一次即可。

界面

M-x emacs-radio 弹出来的 Helm 电台列表长这样,按播放次数从高到低排,常听的台自然浮在最上面:

电台列表

播放时,mode-line 上会多出一小段随音量起伏的绿色波形——它不是花架子,而是通过 mpv 的 astats 滤镜实时算出来的响度包络;左键点一下就能暂停:

mode-line 状态与波形

几个贴心的地方

  • 状态常驻 mode-line。连接时显示 [Radio … Station],播放中显示 [Radio ▶ Station],暂停显示 [Radio ⏸ Station];emacs-radio-stop 之后标记彻底消失,直到下一次开播。左键点一下那个收音机图标,就能暂停/恢复,不必切窗口敲命令。
  • 按使用习惯排序。v0.3.0 起,Helm 候选项按”选中次数”倒序排列,常听的台自然浮到最上面。次数按 URL 记,改名字也不丢;暂停、打开列表不选台,都不计入。次数落在 radio_usage.tsv 里,扫描不会覆盖它。
  • 去重。扫描前 Python 会先按 URL 去重(同一地址只留第一条名字/分类),一个电台有多个备用地址则保留多行,互不干扰。
  • Unix 下的 IPC 暂停。C-c r SPC 通过 mpv 的 Unix-domain JSON IPC 套接字控制暂停,干净利落,适合 Debian 这类 Linux 系统。

写在最后

广播这东西,妙就妙在它”单向、同时、简单、方便”的朴素劲儿——没有握手、没有推送、没有算法,一台机器一片天,谁都能听。小时候拧旋钮听俄罗斯的远东电台是这种感觉,读博士时听轻松调频也是这种感觉;如今土电话勾起了话头,我买了德生 PL-330,又在 Emacs 里攒出这么个 emacs-radio,绕了一大圈,说到底还是想把这股劲儿留住:拧开,就响。

]]>
在Notmuch Message中用Ranger管理邮件附件 https://dustincys.github.io/cn/2026/11/attachment-ranger/ 2026-11-04T00:00:00+00:00 石见 石页 https://dustincys.github.io/cn/2026/11/attachment-ranger 用 notmuch 收发邮件已有若干年。检索与阅读都很轻快,唯独附件一项不太顺手:在 notmuch-message-mode 里挂附件,标准做法是 C-c C-a 调 mml-attach-file,一次一个文件,路径要靠 completing-read 一层层点下去。写一封带七八个文件(源码、图、PDF)的信,或者干脆要把一整个目录打包带上时,这套流程就显得笨拙。

而 Emacs 里的文件管理,我一直用 ranger.el。多栏目录漫游,t 选择、TAB 选择并下移,肌肉记忆早已形成。年初还写过一篇《如何优雅地给spacemacs打补丁》,讲的正是它在 dired 之上做了哪些手脚。既然 ranger 只是 dired 之上的又一层 UI,那么让它暂时放下”文件管理器”的身份,改行做”附件选择器”,似乎是顺理成章的事。

于是有了 attachment-ranger.el(v0.2.0)。行为很朴素:在写信缓冲区里按 C-c C-a,跳进 ranger,像平常一样选文件、选目录,再按 C-c C-a 应用;不满意就按 q 走人,原信一字不动。

按键约定

键 作用
t 切换当前项的选择状态
TAB 切换选择并下移一行
C-c C-a 同步附件并返回邮件
q 放弃本次选择并返回邮件

两条隐含的规矩很重要:

其一,选择跨目录保持。在 ~/Downloads 里选了两个文件,切到 ~/Documents 再选三个,五个都算数,直到按下 C-c C-a 为止。

其二,只同步自己插入的内容。这个包在信件正文里维护一段由它托管的 MML 区域,你手写的 <#multipart>、<#part> 之类的 MML 标记一概不碰;反过来说,如果你手动改动过它托管的那一段,它会拒绝覆盖并报错。

状态分层

写这种”从工具 A 里操作工具 B 的缓冲区”的小包,麻烦往往不在功能本身,而在状态该放在哪里。这里的做法是分成两层:

一层是每个 message 缓冲区自己的状态,用 defvar-local 声明,随缓冲区生死:

(defvar-local attachment-ranger--items nil
  "Selected files/directories for this message.")

(defvar-local attachment-ranger--files nil
  "Expanded regular files attached to this message.")

(defvar-local attachment-ranger--start nil
  "Start marker of managed MML region.")

(defvar-local attachment-ranger--end nil
  "End marker of managed MML region.")

(defvar-local attachment-ranger--snapshot nil
  "Expected text of managed MML region.")

(defvar-local attachment-ranger--directory nil
  "Last attachment directory for this message.")

注意 --items 与 --files 是分开记的:前者是你选的目录与文件(可能含目录),后者是目录递归展开之后的真实文件列表。再次打开选择器时应该停在原来的目录、恢复原来的勾选,而不是只知道最终展开了哪些文件。

另一层是一次拾取会话的全局状态:源邮件缓冲区、临时选择、打开 ranger 之前的窗口配置、本次访问过的所有 ranger 缓冲区,以及一个重入保护标志。

(defvar attachment-ranger--mail nil
  "Message buffer currently using the picker.")

(defvar attachment-ranger--selection nil
  "Temporary selection during picker session.")

(defvar attachment-ranger--windows nil
  "Window configuration before opening the picker.")

(defvar attachment-ranger--buffers nil
  "Ranger buffers visited during this session.")

(defvar attachment-ranger--busy nil
  "Non-nil while updating picker marks.")

--buffers 这一项值得解释:ranger.el 每进入一个目录就换上对应的缓冲区,所以”当前 ranger 缓冲区”是会变的。会话结束时要把这一路上进过的每一个缓冲区里的 picker 模式都关掉,否则键位会漏在某个还开着的目录缓冲区里。--busy 则是给重绘 mark 时的保护开关,避免 dired-mark 触发的钩子递归回到重绘函数。

只加一层临时的 minor mode

不要改 ranger 的键位表,也不要改写 ranger 的函数。最干净的办法是定义一个只在选择期间生效的 minor mode:

(defvar attachment-ranger-picker-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map (kbd "t")     #'attachment-ranger-toggle)
    (define-key map (kbd "TAB")   #'attachment-ranger-toggle-next)
    (define-key map (kbd "<tab>") #'attachment-ranger-toggle-next)
    (define-key map (kbd "C-c C-a") #'attachment-ranger-commit)
    (define-key map (kbd "q")     #'attachment-ranger-cancel)
    map)
  "Keymap active only during attachment selection.")

(define-minor-mode attachment-ranger-picker-mode
  "Minor mode for selecting mail attachments."
  :init-value nil
  :lighter " Attach"
  :keymap attachment-ranger-picker-mode-map)

minor mode 的键位优先级高于主模式,而 C-c C-a 是保留给用户的组合,ranger 本身不会占用,正好不冲突。

用 Evil 或 Spacemacs 的话还要补一刀:evil 有自己的状态键位表,光有 minor mode 的 keymap 在 normal 状态下不生效。所以要显式地把这套键位挂到 evil 的 normal、motion、visual、insert 四个状态上:

(with-eval-after-load 'evil
  (evil-define-minor-mode-key
    '(normal motion visual insert)
    'attachment-ranger-picker-mode
    (kbd "t") #'attachment-ranger-toggle
    (kbd "TAB") #'attachment-ranger-toggle-next
    (kbd "<tab>") #'attachment-ranger-toggle-next
    (kbd "C-c C-a") #'attachment-ranger-commit
    (kbd "q") #'attachment-ranger-cancel))

还有一个细节:ranger 换目录之后,新缓冲区里并没有开启 picker 模式。所以把”给当前缓冲区补上 picker 模式、并把已选项重新标出来”挂到 post-command-hook 上,每次命令执行完检查一遍:

(defun attachment-ranger--activate-current-buffer ()
  "Activate picker mode for the selected Ranger buffer."
  (when (and (attachment-ranger--active-p)
             (attachment-ranger--ranger-buffer-p)
             (not attachment-ranger--busy))
    (unless attachment-ranger-picker-mode
      (attachment-ranger-picker-mode 1))
    (cl-pushnew (current-buffer)
                attachment-ranger--buffers)
    (attachment-ranger--paint-marks)))

用 dired 的 mark 当视觉反馈

选择状态不必另画一套高亮:ranger 的每一行本来就是 dired 的行,直接调用 dired-mark / dired-unmark 把选中项标上 * 即可。好处是大得不成比例的——你看到的就是平时熟悉的那个星号,ranger 的一应显示设置也照旧生效。

代价是要绕过 dired 的只读与副作用:动态绑定 inhibit-read-only,事后再恢复原本的 buffer-modified-p,并用 --busy 挡住重入。下面只留骨架,逐行比对与标记的具体动作从略:

(defun attachment-ranger--paint-marks ()
  "Restore Dired marks from attachment selection."
  (when (and (attachment-ranger--active-p)
             (attachment-ranger--ranger-buffer-p)
             (not attachment-ranger--busy))
    (let ((attachment-ranger--busy t)
          (inhibit-read-only t)
          (was-modified (buffer-modified-p)))
      (save-excursion
        (goto-char (point-min))
        (while (not (eobp))
          ;; ...逐行比对 (member (normalize file) selection)
          ;; 该标而未标的 dired-mark,该掉而未掉的 dired-unmark
          ))
      (set-buffer-modified-p was-modified))))

比对用的是 expand-file-name 归一化之后的绝对路径。ranger 在不同目录下传给 dired-get-filename 的可能是相对路径,不归一化就会漏标。

托管区域:怎么只覆盖自己的那一份

这是整个包里最需要小心的地方。信件正文在 message-mode 眼里是普通文本,附件以 MML 标记的形式嵌在里面。如果每次提交都粗暴地”清空所有附件再重加”,用户手写的标记就没了;反过来只加不删,同一个文件会被挂三四遍。

办法是维护一段由本包托管的区域:用它插入时的起点与终点的 marker,加上一段文本快照。

(defun attachment-ranger--check-mml ()
  "Ensure previously managed MML text has not been changed."
  (let ((start attachment-ranger--start)
        (end attachment-ranger--end))
    (when (or start end)
      (unless
          (and (markerp start)
               (markerp end)
               (eq (marker-buffer start) (current-buffer))
               (eq (marker-buffer end) (current-buffer))
               (<= start end)
               (equal
                (buffer-substring-no-properties start end)
                attachment-ranger--snapshot))
        (user-error
         "Managed attachment region changed; refusing to overwrite")))))

提交前先校验收管区域是否仍是当初插入的样子:如果不一致,说明中间有人手动改过,此时报错退出比悄悄覆盖要负责任得多。

校验通过之后的同步本体,把”删旧的、插新的、更新标记与快照”包在 atomic-change-group 里:

(defun attachment-ranger--sync (files items)
  "Synchronize FILES and remember selected ITEMS.
This function must be called in a message composition buffer."
  (unless (derived-mode-p 'message-mode)
    (user-error "Not a message composition buffer"))

  (attachment-ranger--check-mml)

  (unless (equal files attachment-ranger--files)
    (atomic-change-group
      (save-excursion
        (let ((old-start attachment-ranger--start)
              (old-end attachment-ranger--end)
              (mml-attach-file-at-the-end nil))

          ;; Remove only previously managed attachments.
          (if (and old-start old-end)
              (progn
                (goto-char old-start)
                (delete-region old-start old-end))
            (goto-char (point-max)))

          ;; Insert the new managed attachment group.
          (let ((begin (point)))
            (when files
              (insert "\n")
              (dolist (file files)
                (mml-attach-file
                 file
                 (or (mm-default-file-type file)
                     "application/octet-stream")
                 nil
                 "attachment")))

            (let ((finish (point))
                  (snapshot
                   (buffer-substring-no-properties
                    begin (point))))

              ;; Clear previous markers.
              (when (markerp old-start) (set-marker old-start nil))
              (when (markerp old-end) (set-marker old-end nil))

              (if files
                  (setq attachment-ranger--start (copy-marker begin nil)
                        attachment-ranger--end   (copy-marker finish t)
                        attachment-ranger--snapshot snapshot)
                (setq attachment-ranger--start nil
                      attachment-ranger--end nil
                      attachment-ranger--snapshot nil)))))))

    ;; Keep directory selections independently of expanded files.
    (setq attachment-ranger--files (copy-sequence files)
          attachment-ranger--items (copy-sequence items))))

三处值得留意:

  • mml-attach-file-at-the-end 动态绑定为 nil。默认情况下 mml-attach-file 会把附件插到 point-max,只有把它按下去,才能在光标所在地插入,从而保证整段托管区域连续。
  • 终点 marker 用 (copy-marker finish t),插入类型为 t:以后在区域末尾继续输入时,终点会跟着往后走,而起点用 nil 固定在前面。marker 的插入类型在这种场景里不是可有可无的细节。
  • 只有当展开后的 files 真的变了才动正文。仅仅改选了目录(比如把一个目录换成它下面的子目录,展开结果相同)时,正文保持不动,只更新 --items。

失败就留在 ranger

提交函数有一处刻意的顺序安排:先 sync,再 exit。

(defun attachment-ranger-commit ()
  "Synchronize selected attachments and return to the email."
  (interactive)
  (unless (attachment-ranger--active-p)
    (user-error "No active attachment picker"))

  (let* ((mail attachment-ranger--mail)
         (items (copy-sequence attachment-ranger--selection))
         (directory default-directory)
         (files (attachment-ranger--expand items)))

    ;; If synchronization fails, remain in Ranger so that
    ;; selections are not lost.
    (with-current-buffer mail
      (attachment-ranger--sync files items)
      (setq attachment-ranger--directory directory))

    (attachment-ranger--exit)

    (message "Attachments synchronized: %d file(s)" (length files))))

如果 sync 因为快照校验失败而抛错,exit 根本执行不到,人还留在 ranger 里,刚才在若干目录间辛苦攒下的选择也还在——改完邮件正文里的托管区域之后,可以再提交一次。

退出流程则要处理相反的问题:清理工作本身可能出错(比如 ranger 的状态已经不正常),但无论出错与否,都必须恢复窗口配置、回到邮件缓冲区。

(defun attachment-ranger--exit ()
  "Close the picker and restore the original mail window."
  (let ((mail attachment-ranger--mail)
        (config attachment-ranger--windows))

    (attachment-ranger--clear-session)

    ;; Do not allow Ranger cleanup failure to block returning.
    (unwind-protect
        (condition-case err
            (when (fboundp 'ranger-disable)
              (ranger-disable))
          (error
           (message "Ranger cleanup: %s" (error-message-string err))))

      (when config
        (set-window-configuration config))

      (when (buffer-live-p mail)
        (pop-to-buffer-same-window mail)))))

关闭模式的顺序在会话清理里也有一条讲究:先把 attachment-ranger--mail 置空,再逐个关闭 picker 模式。反过来的话,关闭模式时触发的钩子会看到”会话仍在”,从而再次进入激活分支,老死循环。

再配一个应急出口 attachment-ranger-reset:会话万一卡住(比如 ranger 抛错但没走到清理),可以手工复位,而不影响已经写好的信。

目录展开

选中目录时,attachment-ranger--expand 用 directory-files-recursively 递归收集其中的普通文件,过滤非法项,去重,并在数量超过 attachment-ranger-directory-limit(默认 100)时弹一次确认——防止手一滑把 ~/ 整个挂到信上。

这份清单只用于生成 MML,原始选择仍存在 --items 里,所以”上次选了哪两个目录”这个信息不会因为展开而丢失。

安装与配置

把 attachment-ranger.el 放到 load-path 上即可。三个自定义变量都有合理的默认值:

(use-package attachment-ranger
  :load-path "~/path/to/attachment-ranger"
  :after (notmuch ranger)
  :custom
  (attachment-ranger-default-directory "~/Downloads/")
  (attachment-ranger-use-deer nil)
  (attachment-ranger-directory-limit 100))

依赖是 Emacs 29.1 与 ranger 0.9.9。attachment-ranger-use-deer 置 t 时用 Deer 代替完整的 ranger,多窗口环境下更省事。

C-c C-a 的绑定由包内自行完成:

(with-eval-after-load 'notmuch-message
  (define-key notmuch-message-mode-map
              (kbd "C-c C-a")
              #'attachment-ranger-open))

这条绑定会覆盖 notmuch 原本挂在 C-c C-a 上的 mml-attach-file。如果你想保留单文件挂载的入口,把上面这一句的键位换掉,或者干脆在 picker 里选一个文件,效果是一样的。

几个踩过的坑

  • 模式检查:notmuch-message-mode 派生于 message-mode,但反过来不成立。打开选择器时检查前者,同步时检查后者,这两个检查的位置不能混。
  • dired-get-filename 的第二个参数:一律传 t(no-error),否则光标落在 .. 或标题行上时会直接抛错。
  • q 的语义:q 只是放弃本次的勾选变化,已经提交过的附件不会被撤销。要撤附件,就在 picker 里把对应项取消勾选再提交。
  • Deer 与 Ranger 的差别:Deer 复用当前窗口,没有独立的 ranger 布局,退出时 ranger-disable 的行为也略有不同;unwind-protect 那一段正是为了兜住这些差异。

完整源码

;;; attachment-ranger.el --- Ranger picker for Notmuch -*- lexical-binding: t; -*-

;; Version: 0.2.0
;; Package-Requires: ((emacs "29.1") (ranger "0.9.9"))
;; Keywords: mail, files

;;; Commentary:
;;
;; Notmuch:
;;   C-c C-a  Open attachment picker
;;
;; Ranger/Deer attachment picker:
;;   t        Toggle selection
;;   TAB      Toggle selection and advance
;;   C-c C-a  Synchronize attachments and return
;;   q        Cancel selection and return
;;
;; Selections persist across directory navigation.
;; Only attachments created by this package are synchronized.
;; Ordinary Ranger key bindings remain unchanged outside the picker.

;;; Code:

(require 'cl-lib)
(require 'seq)
(require 'dired)
(require 'message)
(require 'mml)
(require 'mm-util)

(defgroup attachment-ranger nil
  "Manage mail attachments using Ranger."
  :group 'mail)

(defcustom attachment-ranger-default-directory "~/Downloads/"
  "Initial attachment directory."
  :type 'directory
  :group 'attachment-ranger)

(defcustom attachment-ranger-use-deer nil
  "Use Deer instead of full Ranger when non-nil."
  :type 'boolean
  :group 'attachment-ranger)

(defcustom attachment-ranger-directory-limit 100
  "Ask confirmation when attaching more than this many directory files."
  :type 'integer
  :group 'attachment-ranger)

;; ============================================================
;; State belonging to each message buffer
;; ============================================================

(defvar-local attachment-ranger--items nil
  "Selected files/directories for this message.")

(defvar-local attachment-ranger--files nil
  "Expanded regular files attached to this message.")

(defvar-local attachment-ranger--start nil
  "Start marker of managed MML region.")

(defvar-local attachment-ranger--end nil
  "End marker of managed MML region.")

(defvar-local attachment-ranger--snapshot nil
  "Expected text of managed MML region.")

(defvar-local attachment-ranger--directory nil
  "Last attachment directory for this message.")

;; ============================================================
;; Global active picker session
;; ============================================================

(defvar attachment-ranger--mail nil
  "Message buffer currently using the picker.")

(defvar attachment-ranger--selection nil
  "Temporary selection during picker session.")

(defvar attachment-ranger--windows nil
  "Window configuration before opening the picker.")

(defvar attachment-ranger--buffers nil
  "Ranger buffers visited during this session.")

(defvar attachment-ranger--busy nil
  "Non-nil while updating picker marks.")

(defun attachment-ranger--active-p ()
  "Return non-nil if a picker session is active."
  (buffer-live-p attachment-ranger--mail))

(defun attachment-ranger--normalize (file)
  "Return the absolute pathname of FILE."
  (expand-file-name file))

;; ============================================================
;; Picker minor mode
;; ============================================================

(defvar attachment-ranger-picker-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map (kbd "t")
                #'attachment-ranger-toggle)
    (define-key map (kbd "TAB")
                #'attachment-ranger-toggle-next)
    (define-key map (kbd "<tab>")
                #'attachment-ranger-toggle-next)
    (define-key map (kbd "C-c C-a")
                #'attachment-ranger-commit)
    (define-key map (kbd "q")
                #'attachment-ranger-cancel)
    map)
  "Keymap active only during attachment selection.")

(define-minor-mode attachment-ranger-picker-mode
  "Minor mode for selecting mail attachments."
  :init-value nil
  :lighter " Attach"
  :keymap attachment-ranger-picker-mode-map)

;; ------------------------------------------------------------
;; Evil / Spacemacs integration
;; ------------------------------------------------------------

(with-eval-after-load 'evil
  (evil-define-minor-mode-key
    '(normal motion visual insert)
    'attachment-ranger-picker-mode
    (kbd "t") #'attachment-ranger-toggle
    (kbd "TAB") #'attachment-ranger-toggle-next
    (kbd "<tab>") #'attachment-ranger-toggle-next
    (kbd "C-c C-a") #'attachment-ranger-commit
    (kbd "q") #'attachment-ranger-cancel))

;; ============================================================
;; Ranger buffer detection and mark display
;; ============================================================

(defun attachment-ranger--ranger-buffer-p ()
  "Return non-nil in a Ranger directory buffer."
  (derived-mode-p 'ranger-mode))

(defun attachment-ranger--paint-marks ()
  "Restore Dired marks from attachment selection."
  (when (and (attachment-ranger--active-p)
             (attachment-ranger--ranger-buffer-p)
             (not attachment-ranger--busy))
    (let ((attachment-ranger--busy t)
          (inhibit-read-only t)
          (was-modified (buffer-modified-p)))
      (save-excursion
        (goto-char (point-min))
        (while (not (eobp))
          (let* ((position (point))
                 (file (dired-get-filename nil t))
                 (selected
                  (and file
                       (member
                        (attachment-ranger--normalize file)
                        attachment-ranger--selection)))
                 (marked
                  (eq (char-after
                       (line-beginning-position))
                      dired-marker-char)))
            (when file
              (cond
               ((and selected (not marked))
                (dired-mark 1))
               ((and marked (not selected))
                (dired-unmark 1))))
            (goto-char position)
            (forward-line 1))))
      (set-buffer-modified-p was-modified))))

(defun attachment-ranger--activate-current-buffer ()
  "Activate picker mode for the selected Ranger buffer."
  (when (and (attachment-ranger--active-p)
             (attachment-ranger--ranger-buffer-p)
             (not attachment-ranger--busy))
    (unless attachment-ranger-picker-mode
      (attachment-ranger-picker-mode 1))
    (cl-pushnew (current-buffer)
                attachment-ranger--buffers)
    (attachment-ranger--paint-marks)))

(defun attachment-ranger--post-command ()
  "Follow Ranger directory changes during attachment selection."
  (when (attachment-ranger--active-p)
    (when (attachment-ranger--ranger-buffer-p)
      (attachment-ranger--activate-current-buffer))))

;; ============================================================
;; Selection operations
;; ============================================================

(defun attachment-ranger-toggle (&optional advance)
  "Toggle current item.
Move to the next file when ADVANCE is non-nil."
  (interactive)
  (unless (attachment-ranger--active-p)
    (user-error "No active attachment picker"))

  (unless (attachment-ranger--ranger-buffer-p)
    (user-error "Not in a Ranger directory"))

  (let ((file (dired-get-filename nil t)))
    (unless file
      (user-error "No file at point"))

    (setq file (attachment-ranger--normalize file))

    (if (member file attachment-ranger--selection)
        (setq attachment-ranger--selection
              (delete file attachment-ranger--selection))
      (setq attachment-ranger--selection
            (append attachment-ranger--selection
                    (list file))))

    (attachment-ranger--paint-marks)

    (when advance
      (condition-case nil
          (ranger-next-file 1)
        (end-of-buffer nil)))

    (message "Selected: %d item(s)"
             (length attachment-ranger--selection))))

(defun attachment-ranger-toggle-next ()
  "Toggle current item and advance."
  (interactive)
  (attachment-ranger-toggle t))

;; ============================================================
;; Expand directories into files
;; ============================================================

(defun attachment-ranger--expand (items)
  "Expand selected ITEMS into unique regular files."
  (let (result)
    (dolist (item items)
      (cond
       ((file-regular-p item)
        (push item result))

       ((file-directory-p item)
        (let* ((all
                (directory-files-recursively
                 item ".*" nil nil))
               (files
                (seq-filter #'file-regular-p all)))

          (when (and
                 (> (length files)
                    attachment-ranger-directory-limit)
                 (not
                  (yes-or-no-p
                   (format
                    "Attach %d files from %s? "
                    (length files) item))))
            (user-error "Directory selection cancelled"))

          (dolist (file files)
            (push file result))))

       (t
        (user-error "Missing or unsupported file: %s"
                    item))))

    (delete-dups (nreverse result))))

;; ============================================================
;; Managed MIME region validation
;; ============================================================

(defun attachment-ranger--check-mml ()
  "Ensure previously managed MML text has not been changed."
  (let ((start attachment-ranger--start)
        (end attachment-ranger--end))

    (when (or start end)
      (unless
          (and (markerp start)
               (markerp end)
               (eq (marker-buffer start) (current-buffer))
               (eq (marker-buffer end) (current-buffer))
               (<= start end)
               (equal
                (buffer-substring-no-properties start end)
                attachment-ranger--snapshot))
        (user-error
         "Managed attachment region changed; refusing to overwrite")))))

;; ============================================================
;; Synchronize MIME attachments
;; ============================================================

(defun attachment-ranger--sync (files items)
  "Synchronize FILES and remember selected ITEMS.
This function must be called in a message composition buffer."
  (unless (derived-mode-p 'message-mode)
    (user-error "Not a message composition buffer"))

  (attachment-ranger--check-mml)

  (unless (equal files attachment-ranger--files)
    (atomic-change-group
      (save-excursion
        (let ((old-start attachment-ranger--start)
              (old-end attachment-ranger--end)
              (mml-attach-file-at-the-end nil))

          ;; Remove only previously managed attachments.
          (if (and old-start old-end)
              (progn
                (goto-char old-start)
                (delete-region old-start old-end))
            (goto-char (point-max)))

          ;; Insert the new managed attachment group.
          (let ((begin (point)))
            (when files
              (insert "\n")
              (dolist (file files)
                (mml-attach-file
                 file
                 (or (mm-default-file-type file)
                     "application/octet-stream")
                 nil
                 "attachment")))

            (let ((finish (point))
                  (snapshot
                   (buffer-substring-no-properties
                    begin (point))))

              ;; Clear previous markers.
              (when (markerp old-start)
                (set-marker old-start nil))
              (when (markerp old-end)
                (set-marker old-end nil))

              (if files
                  (setq attachment-ranger--start
                        (copy-marker begin nil)
                        attachment-ranger--end
                        (copy-marker finish t)
                        attachment-ranger--snapshot snapshot)
                (setq attachment-ranger--start nil
                      attachment-ranger--end nil
                      attachment-ranger--snapshot nil)))))))

    ;; Keep directory selections independently of expanded files.
    (setq attachment-ranger--files
          (copy-sequence files)
          attachment-ranger--items
          (copy-sequence items))))

;; ============================================================
;; Session cleanup
;; ============================================================

(defun attachment-ranger--clear-session ()
  "Clear the active picker state and disable its keymaps."
  (let ((buffers attachment-ranger--buffers))

    ;; Clear active session first to prevent re-entry errors.
    (setq attachment-ranger--mail nil
          attachment-ranger--selection nil
          attachment-ranger--windows nil
          attachment-ranger--buffers nil)

    (remove-hook 'post-command-hook
                 #'attachment-ranger--post-command)

    (dolist (buffer buffers)
      (when (buffer-live-p buffer)
        (with-current-buffer buffer
          (when attachment-ranger-picker-mode
            (attachment-ranger-picker-mode -1)))))))

(defun attachment-ranger--exit ()
  "Close the picker and restore the original mail window."
  (let ((mail attachment-ranger--mail)
        (config attachment-ranger--windows))

    (attachment-ranger--clear-session)

    ;; Do not allow Ranger cleanup failure to block returning.
    (unwind-protect
        (condition-case err
            (when (fboundp 'ranger-disable)
              (ranger-disable))
          (error
           (message "Ranger cleanup: %s"
                    (error-message-string err))))

      (when config
        (set-window-configuration config))

      (when (buffer-live-p mail)
        (pop-to-buffer-same-window mail)))))

;;;###autoload
(defun attachment-ranger-reset ()
  "Reset a stuck attachment picker without changing the email."
  (interactive)
  (let ((mail attachment-ranger--mail)
        (config attachment-ranger--windows))
    (attachment-ranger--clear-session)
    (when config
      (set-window-configuration config))
    (when (buffer-live-p mail)
      (pop-to-buffer-same-window mail))
    (message "Attachment picker state reset")))

;; ============================================================
;; Commit and cancel
;; ============================================================

(defun attachment-ranger-commit ()
  "Synchronize selected attachments and return to the email."
  (interactive)

  (unless (attachment-ranger--active-p)
    (user-error "No active attachment picker"))

  (let* ((mail attachment-ranger--mail)
         (items
          (copy-sequence attachment-ranger--selection))
         (directory default-directory)
         (files (attachment-ranger--expand items)))

    ;; If synchronization fails, remain in Ranger so that
    ;; selections are not lost.
    (with-current-buffer mail
      (attachment-ranger--sync files items)
      (setq attachment-ranger--directory directory))

    (attachment-ranger--exit)

    (message "Attachments synchronized: %d file(s)"
             (length files))))

(defun attachment-ranger-cancel ()
  "Cancel changes and return to the email."
  (interactive)

  (unless (attachment-ranger--active-p)
    (user-error "No active attachment picker"))

  (attachment-ranger--exit)
  (message "Attachment selection cancelled"))

;; ============================================================
;; Open attachment picker
;; ============================================================

;;;###autoload
(defun attachment-ranger-open ()
  "Open Ranger or Deer to manage current Notmuch attachments."
  (interactive)

  (unless (derived-mode-p 'notmuch-message-mode)
    (user-error "Not a Notmuch composition buffer"))

  (when (attachment-ranger--active-p)
    (user-error
     "Another picker is active; use attachment-ranger-reset if stuck"))

  (require 'ranger)

  (let* ((mail (current-buffer))
         (dir
          (expand-file-name
           (or attachment-ranger--directory
               attachment-ranger-default-directory)))
         (dir
          (if (file-directory-p dir)
              dir
            (expand-file-name "~/"))))

    ;; Initialize the new session.
    (setq attachment-ranger--mail mail
          attachment-ranger--selection
          (copy-sequence attachment-ranger--items)
          attachment-ranger--windows
          (current-window-configuration)
          attachment-ranger--buffers nil)

    ;; Register navigation tracking before opening Ranger.
    (add-hook 'post-command-hook
              #'attachment-ranger--post-command)

    (condition-case err
        (progn
          (if attachment-ranger-use-deer
              (deer dir)
            (ranger dir))

          (attachment-ranger--activate-current-buffer)

          (message
           "Attachment picker: t/TAB select | C-c C-a apply | q cancel"))

      (error
       (attachment-ranger--clear-session)
       (signal (car err) (cdr err))))))

;; ============================================================
;; Notmuch integration
;; ============================================================

(with-eval-after-load 'notmuch-message
  (define-key notmuch-message-mode-map
              (kbd "C-c C-a")
              #'attachment-ranger-open))

(provide 'attachment-ranger)

;;; attachment-ranger.el ends here

写到这里,附件这一环总算是顺手了。这类小包的价值不在代码量,而在把已经练成的肌肉记忆原样搬到一个原本需要另学一套操作的地方——ranger 还是那个 ranger,只是这一次,它管的是信里的附件。

]]>
平庸逃逸速度 https://dustincys.github.io/cn/2026/06/escapevelocity/ 2026-06-21T00:00:00+00:00 石见 石页 https://dustincys.github.io/cn/2026/06/escapevelocity

这个脱口秀演员提到了一个概念——平庸逃逸速度。

有点意思。AI 会让那些不假思索、直接依赖 AI 输出的人逐渐丧失独立思考的能力,像被黑洞吸入一样,不可逆转地坠入平庸。 而能在这场洪流中生存下来的人,需要达到一个临界速度——平庸逃逸速度。 也就是说,真正领悟底层规律、能够驾驭 AI 而非被 AI 驾驭的人,才能挣脱平庸的引力。

那么,如何获得这个逃逸速度?几点想法:

建立第一性原理思维。 AI 擅长归纳,不擅长从零推导。当你习惯从最基础的原理出发推演问题——而不是直接索要答案——你就拥有了 AI 所不具备的能力。问自己:这个问题的底层结构是什么?如果不让 AI 代劳,我会怎么拆解它?

用 AI 放大思考,而非替代思考。 把 AI 当作 sparring partner(对练伙伴),而不是答案机器。让它挑战你的假设、找出你的盲点、从你不曾考虑的角度审视问题。关键是:你永远是思考的主体,AI 是陪练。

保持输出。 写作、编码、演讲——任何形式的输出都在强迫你将模糊的直觉转化为清晰的结构。AI 可以帮你润色,但如果连初稿都不想自己写,你连”自己到底在想什么”都搞不清楚。输出是思考的显影剂。

拥抱 friction(摩擦力)。 AI 让一切变得太顺滑了——一键生成、即时回答。但真正的成长发生在有阻力的时候:啃一本难懂的书、调试一个棘手的 bug、和比你强的人争论。不要用 AI 熨平所有不适,那些让你感到费劲的事,恰恰是你在加速逃离平庸的瞬间。

平庸的引力很大,而且会越来越大。逃逸速度不是一次达到就一劳永逸——它是一种持续对抗引力的状态。

]]>
用Emacs打造课堂随机提问系统 https://dustincys.github.io/cn/2026/06/classroom/ 2026-06-14T00:00:00+00:00 石见 石页 https://dustincys.github.io/cn/2026/06/classroom 引言

作为教师,课堂上如何公平地提问、记录学生的回答质量,一直是个不大不小的难题。手动点名容易不自觉偏爱某些学生,纸质记录效率低下,课后统计更是费时费力。 并且,现在学生名字生僻字太多,喊错名字又太尴尬。

classroom-call 是一个 Emacs 扩展,专为课堂场景设计——随机点名、语音播报、评分记录、统计图表、CSV导出,全部在 Emacs 中完成。

本文带你从安装到进阶,全面掌握这个”Emacs教师利器”。


功能一览

  • 🎲 随机点名 — 从学生池中随机抽取,配合滚动动画,增强课堂趣味性与紧张感
  • 🔊 TTS 语音播报 — 集成 Microsoft Edge TTS,用中文朗读学生姓名和评分结果
  • 📊 五级评分制 — 不仅看答案对错,更看重学生的逻辑表达能力(0–4 分)
  • 🔄 多轮次支持 — 每轮学生顺序随机打乱,避免同一节课重复点到同一学生
  • 📝 Org 记录 — 全部点名与评分以 Org mode 格式保存,可检索、可回顾
  • 🚫 无回答处理 — 累计 ≤2 次无回答推迟至下节,第 3 次移出本轮池,防止逃避
  • ↩️ 取消提问 — 误触或改变主意?按 c 即可取消,学生放回池中
  • 💾 状态持久化 — 课堂状态自动保存,Emacs 崩溃或重启后可无缝恢复
  • 📈 统计图表 — 按班级生成成绩分布柱状图 + 平均分折线(matplotlib 绘制)
  • 📤 CSV 导出 — 一键导出全量成绩 CSV,每轮一列,Excel 友好

安装

环境依赖

组件 用途 安装命令
Emacs ≥ 27 运行平台 各系统包管理器
Python 3 拼音转换 & 图表生成 apt install python3
pypinyin 中文姓名 → 拼音 pip3 install pypinyin
matplotlib + numpy 成绩分布图表 pip3 install matplotlib numpy
edge-tts 语音合成 pip3 install edge-tts
mpv 或 ffplay 播放合成语音 apt install mpv

💡 不需要语音功能?跳过 edge-tts 和 mpv,设置 classroom-enable-tts 为 nil 即可。

配置 Emacs

克隆仓库后,在 Emacs 配置中添加:

;; 添加到 load-path
(add-to-list 'load-path "~/.emacs.d/site-lisp/classroom-call/")
(require 'classroom-call)

推荐使用 use-package:

(use-package classroom-call
  :load-path "~/.emacs.d/site-lisp/classroom-call/"
  :custom
  (classroom-enable-tts t)
  (classroom-tts-voice "zh-CN-XiaoxiaoNeural")
  (classroom-tts-player-command '("mpv" "--volume-max=200")))

所有可配置项都可以通过 Emacs 的 customize-group 界面进行可视化调整:

M-x customize-group RET classroom-call RET

学生名单

准备一个 CSV 文件,三列:学号、姓名、班级。第一行为表头。

id,name,group
20230001,张三,1班
20230002,李四,2班
20230003,王五,2班
20230004,赵六,3班
20230005,孙七,3班
  • id:学号,作为唯一标识
  • name:姓名(支持中文,系统自动调用 pypinyin 生成带声调的拼音)
  • group:班级/分组(用于按班级生成统计图表)

文件名默认为仓库目录下的 students.csv,也可以在启动时互动选择其他文件。


使用指南

启动系统

在 Emacs 中执行:

M-x classroom-start

首次启动会提示你选择学生名单 CSV 文件。如果检测到上次课堂的状态文件(classroom-state.el),会询问是否恢复——选 y 即可继续上次未完成的课堂。

命令 说明
classroom-start 启动课堂系统(自动检测状态恢复)
classroom-load-csv 手动重新加载学生名单
classroom-load-state 手动恢复上次保存的课堂状态

点名流程

  1. 在 *Classroom Call* 缓冲区,按 c 开始点名
  2. 屏幕上出现滚动动画——学生姓名快速随机切换,营造悬念
  3. 动画结束,被点中的学生信息全屏居中显示:姓名、拼音、学号、班级
  4. 若启用 TTS,系统会用中文朗读 “请 XXX 回答问题”
  5. 学生在回答完毕后,教师按数字键 0–4 评分,或者按 c 取消本次提问

五级评分标准

这套评分体系不仅考察答案的正确性,更重视逻辑思维与表达能力:

按键 等级 含义
0 无回答 学生未回应提问
1 回答错误且解释无逻辑 答案和论证都存在明显问题
2 回答正确但解释不清 蒙对答案但说不出所以然
3 逻辑清晰(无论对错) 回答正确且解释到位,或回答错误但推理路径有价值
4 批判性思维 推翻已有结论并提出新观点,超越标准答案
c 取消提问 学生放回池中,重新随机

这套标准的核心理念:“说清楚为什么”比”说对答案”更重要。等级 3 的设计尤为精妙——即使答案有误,只要逻辑推理清晰,同样获得高分肯定。

键盘快捷键

在 *Classroom Call* 主界面:

按键 功能
c 开始点名
s 显示统计信息与成绩分布图
p 查看当前轮次剩余学生名单
t 预生成全部 TTS 语音缓存
T 后台异步预热 TTS 缓存
C 清空 TTS 缓存目录

核心特性详解

1. 滚动动画

点名时的滚动动画并非华而不实——它在心理学上有助于营造公平感和紧张氛围。动画持续约 1.2 秒,学生姓名以递减速度切换,最终定格在选中的学生上。

实现上,它使用了 Emacs 的 sit-for 来控制刷新间隔,初期快速切换(每帧 15ms),后期逐渐变慢(约 185ms),模拟”转盘减速”的效果。

2. 无回答处理机制

这是对真实课堂场景的深度适配——总有学生会以”没想好”“不会”为由不回答。系统的处理逻辑:

次数 处理方式
第 1–2 次 学生放入 unanswered-pool(挂起池),下次启动时重新加入点名池
第 3 次 学生永久移出当前轮次点名池,不再被点到

如果挂起的学生之后正常回答了问题(1–4 分),其无回答计数自动清零,挂起状态清除。这确保了学生有机会补救,但无法无限期逃避。

3. 防止连续点到同一学生

两重保护:

  • 每轮的点名池在开始时随机打乱,按序弹出——同一轮内不会重复
  • 取消提问后,被取消的学生不会在下次点名中立即出现(系统会检测并重新洗牌)

4. TTS 语音播报

系统使用 Microsoft Edge TTS 引擎,免费且音质自然。默认使用 “晓晓”(zh-CN-XiaoxiaoNeural) 语音角色。

缓存策略:合成后的 MP3 文件以 MD5(voice + rate + text) 命名,缓存在 classroom-tts-cache/ 目录。同一文本绝不重复合成。

预热建议:正式上课前,按 t 执行 classroom-precache-tts,提前生成所有学生姓名和评分等级的语音文件。点名时播放是即时的,不会有任何等待。

异步生成:如果课前忘了预热也不用担心——系统会在后台异步生成语音,绝不阻塞评分菜单。教师可以继续操作而不受影响。

可自定义的 TTS 参数:

(setq classroom-tts-voice "zh-CN-YunxiNeural")  ; 换个语音角色
(setq classroom-tts-rate "+30%")                 ; 调整语速
(setq classroom-tts-player-command
      '("ffplay" "-nodisp" "-autoexit" "-loglevel" "quiet"))  ; 换用 ffplay

5. 统计图表

按 s 即可查看统计面板,内容包括:

  • 当前轮次、剩余人数、已回答人数
  • 成绩分布柱状图:按班级分组,每个班级显示 0–4 各等级的计数
  • 平均分折线图(红色):等级映射为百分制分数
    • 0 分 → 0,1 分 → 60,2 分 → 80,3 分 → 98,4 分 → 100
  • 全员平均分参考线(红色虚线)
  • 当前挂起(无回答)的学生列表

图表由 Python 脚本 classroom-plot.py 使用 matplotlib 生成,以 PNG 格式嵌入 Org 缓冲区显示。支持任意数量的班级,图表宽度自适应。

6. Org 记录

所有点名和评分记录以 Org mode 格式保存,结构清晰:

* 第1轮 张三 (Zhāng Sān) [20230001] <1班>
:PROPERTIES:
:ID:       20230001
:NAME:     张三
:PINYIN:   Zhāng Sān
:GROUP:    1班
:GRADE:    回答正确解释有逻辑,或回答错误但解释很有逻辑
:TIME:     [2026-06-14 Mon 10:23:45]
:END:

每条记录包含完整属性列,你可以用 Emacs 的 Org mode 搜索、过滤功能进行回顾。比如 C-c / p 按属性查找,或 org-sparse-tree 按正则匹配。

7. CSV 导出

执行 M-x classroom-export-csv,系统会解析 classroom-record.org 文件,将全量成绩导出为:

姓名,学号,班级,Round1,Round2,Round3
张三,20230001,1班,3,,1
李四,20230002,2班,1,0,1
王五,20230003,2班,,2,4
  • 成绩以数字 0–4 表示
  • 未参与轮次留空
  • 可直接导入 Excel / Google Sheets 做进一步分析(计算班级平均分、成绩趋势等)

8. 状态持久化

每次评分后自动保存课堂状态到 classroom-state.el,包含:

  • 当前轮次编号
  • 点名池(剩余学生及顺序)
  • 全部历史评分记录
  • 学生名单
  • 最后取消的学生 ID
  • 无回答累计计数
  • 挂起学生列表

Emacs 意外退出?下次启动时选择恢复,一切如初。

9. Spacemacs 支持

仓库 spacemacs-layer/ 目录提供了 Spacemacs layer 配置,Spacemacs 用户可以直接将此 layer 添加到 dotspacemacs-configuration-layers 中使用。


个性化配置

以下是完整的可配置项及其默认值:

;; ========== 文件路径 ==========
(setq classroom-directory
      (file-name-directory load-file-name))          ; 包所在目录
(setq classroom-org-file
      (expand-file-name "classroom-record.org" classroom-directory))
(setq classroom-state-file
      (expand-file-name "classroom-state.el" classroom-directory))
(setq classroom-default-students-file
      (expand-file-name "students.csv" classroom-directory))
(setq classroom-stats-image-file
      (expand-file-name "classroom-stats.png" classroom-directory))
(setq classroom-export-csv-default-file
      (expand-file-name "classroom-grades.csv" classroom-directory))

;; ========== Python ==========
(setq classroom-python-path "python3")
(setq classroom-plot-script
      (expand-file-name "classroom-plot.py" classroom-directory))

;; ========== TTS ==========
(setq classroom-enable-tts t)                        ; 启用语音
(setq classroom-tts-voice "zh-CN-XiaoxiaoNeural")   ; 语音角色
(setq classroom-tts-rate "+50%")                    ; 语速
(setq classroom-tts-player-command '("mpv" "--volume-max=200"))

;; ========== TTS 缓存 ==========
(setq classroom-tts-cache-dir
      (expand-file-name "classroom-tts-cache/" classroom-directory))

典型工作流

课前准备(2 分钟)

  1. 打开 Emacs,执行 M-x classroom-start
  2. (首次)选择本班学生 CSV 文件
  3. 按 t 预生成全部 TTS 缓存(等待 30 秒 – 2 分钟,取决于学生数和 CPU)
  4. 确认音量正常,关闭 TTS 日志缓冲区

课堂进行中

按 c   → 点名,学生姓名滚动,语音播报
学生回答
按 0-4 → 评分,系统朗读评分结果
按 c   → (可选)取消提问,换一个学生
按 s   → (可选)查看成绩分布和统计数据
重复

课后分析

  1. M-x classroom-show-statistics 查看成绩分布图,截图放到教学总结中
  2. M-x classroom-export-csv 导出成绩 CSV,在 Excel 中进一步分析
  3. 打开 classroom-record.org 回顾每位学生的回答记录

设计哲学

classroom-call 的设计贯穿了几个核心理念:

1. 公平性优先。 随机点名 + 防止连续重复 + 无回答处理,确保每个学生有均等的被提问机会,同时防止逃避。

2. 评价逻辑而非结果。 评分标准向”表达清晰度”倾斜——等级 3 对错误但逻辑清楚的回答给予高分,等级 4 奖励批判性思维。这与”培养独立思考能力”的教育目标一致。

3. 非侵入式语音。 TTS 异步生成、缓存预热、音频播放不阻塞操作——教师体验流畅,不需要为”等语音生成”而尴尬停顿。

4. 纯 Emacs Lisp 核心。 核心点名、评分、状态管理逻辑全部用 Elisp 实现,不依赖外部进程。只有拼音转换、图表生成、语音合成这些辅助功能才调用 Python / 外部工具——而且是异步的,不影响主流程。

5. 数据归教师所有。 所有记录保存在本地 Org 文件和 CSV 文件中,无云端依赖、无隐私泄露风险。教师完全掌控自己的教学数据。


小结

classroom-call 用 780 行 Elisp 代码 + 120 行 Python 脚本,将 Emacs 变成了一个功能完备的课堂互动工具。它或许不是最”现代化”的解决方案(那可能是某个 SaaS 平台),但它是:

  • 🆓 完全自由(GPL-3.0)
  • 🔒 数据本地化(无隐私顾虑)
  • 🎛️ 深度可定制(Elisp 配置一切)
  • ⌨️ 键盘驱动(Emacs 用户的最爱)

如果你是一名使用 Emacs 的教师,不妨试试在下次课堂上用 classroom-call 来点名——学生们听到电脑用中文朗读自己名字时的反应,本身就是课堂气氛的调味剂。


📦 项目地址:github.com/dustincys/classroom-call

📄 许可证:GPL-3.0

✍️ 作者:Yanshuo Chu

]]>
GPT2Org v0.0.14 更新 https://dustincys.github.io/cn/2026/06/GPT2Org/ 2026-06-14T00:00:00+00:00 石见 石页 https://dustincys.github.io/cn/2026/06/GPT2Org GPT2Org 是一款浏览器扩展(支持 Firefox 和 Chrome),能够提取网页正文内容,通过 AI(DeepSeek、OpenAI 或 Kimi)生成摘要,并通过 org-protocol 将结果直接发送到 Emacs 的 org-mode 或 org-roam 中。v0.0.14 版本带来多项体验优化,让扩展更安全、更便捷、更好用。


新功能速览

🔒 API 密钥默认隐藏

之前,API 密钥在选项页中以明文显示——任何瞥到你屏幕的人都能看到。现在三个 API 密钥输入框(OpenAI、DeepSeek、Kimi)全部改为 type="password",密钥内容默认以圆点遮蔽。你的密钥只有你自己知道。

🖱️ 右键菜单随处可用

右键上下文菜单(Org-protocol、Journal、Clock-in 三种捕获方式)之前仅在选中文本时才会出现。现在它们扩展到了所有页面上下文——你可以在链接上、图片上、页面的任意位置右键触发捕获。特别适合不需要先选中文字、直接保存链接目标的场景。

📝 摘要可在保存前编辑

AI 生成的摘要不再是只能看不能改的静态文本。摘要出现在弹窗中后,你可以直接编辑——修正翻译错误、删除冗余内容、或者补充自己的笔记。摘要区域使用 contentEditable 实现,确保发往 Emacs 的内容完全符合你的期望。

⚡ 流式响应——实时看到摘要逐字生成

不再盯着转圈圈等 API 慢慢返回了。GPT2Org 现在使用 SSE 流式传输,摘要内容逐 token 实时显示。底层实现将原来的阻塞式 fetch 替换为基于 ReadableStream 的流式读取:

  1. 请求体带上 "stream": true
  2. 通过 response.body.getReader() 逐块读取响应
  3. 解析 SSE 格式的 data: 行,提取 choices[0].delta.content
  4. 通过 chrome.runtime.sendMessage({ action: "streamChunk", ... }) 将每个片段推送到弹窗

第一个 token 到达时转圈立即消失,摘要文本框逐步填充,整个过程流畅自然。

🧠 DeepSeek 深度思考模式

。 需要更深入、更全面的分析时,可以通过右键菜单中的 “GPT2Org (Deep Think)” 来触发 DeepSeek 的思考模式(Thinking Mode)。扩展会向 API 发送 "thinking": {"type": "enabled"} 和 "reasoning_effort": "high" 参数,启动扩展推理。普通左键点击使用标准模式。思考模式的结果与普通摘要分开缓存,不会混淆。

📋 文档全面升级

README 进行了全面重构,新增了清晰的安装说明、使用指南,以及上下文菜单、思考模式、org-protocol 模板配置等各项功能的文档。


功能全景

功能 说明
多提供商 AI DeepSeek (deepseek-v4-pro)、OpenAI (gpt-4o-mini)、Kimi (moonshot-v1-32k)
五种捕获模式 Roam 已有节点、Roam 新节点、计时条目、每日日记、Elfeed 条目
流式响应 弹窗中逐 token 实时显示摘要
摘要可编辑 发送到 Emacs 前可修改摘要内容
智能缓存 按 URL(及思考模式)缓存摘要,避免重复调用 API
右键菜单 在所有页面上下文中右键即可捕获
深度思考模式 中键点击或右键菜单启用 DeepSeek 扩展推理
密码字段 选项页中 API 密钥默认隐藏
Org-protocol 直接集成 Emacs org-mode / org-roam

安装与配置

  1. 从 Releases 页面 下载安装,或通过 make 从源码构建。
  2. 进入扩展选项页(右键工具栏图标 → “管理扩展” / “选项”)。
  3. 填入 API 密钥,选择要使用的模型。
  4. 配置 org-protocol 模板(参考 README)。
  5. 点击 Save。

打开任意网页,点击工具栏图标,选择捕获模式。摘要会流式生成,你可以编辑后一键发送到 Emacs。


后续计划

一些正在考虑的方向:

  • 自定义提示词预设——保存并切换多组提示词,适配不同场景
  • 弹窗深色模式——夜间使用更护眼
  • 本地模型支持——通过 Ollama 等接入本地部署的 LLM
  • 多语言摘要——自动检测语言并按需翻译

如果你有想法或遇到问题,欢迎到 GitHub Issues 反馈。


GPT2Org 将整个网络变成你 org-mode 笔记的研究管道。试试看,期待你的反馈!

]]>
如何优雅地给spacemacs打补丁 https://dustincys.github.io/cn/2026/03/patch/ 2026-03-29T00:00:00+00:00 石见 石页 https://dustincys.github.io/cn/2026/03/patch Spacemacs的架构设计精妙绝伦,通过层的封装将各个功能模块化,使得配置井然有序,更赋予了系统无穷的扩展潜力。作为日常文件管理的利器,我习惯于使用ranger。 而在Emacs中集成ranger.el后,路径的获取更显得直观而便利,仿佛指尖轻点间,万物皆在掌握。

然而,近来在使用ranger.el时,我却遭遇了一个小小的烦恼:每当我试图通过快捷键yn来复制第一行文件的文件名时,系统总是顽固地返回文件夹的绝对路径。起初我并未在意,以为只是偶然的失误,但反复出现的bug让我终于忍无可忍。

经过一番细致的调查,真相浮出水面:原来,ranger.el覆盖了dired的用户界面,其函数ranger-copy-filename在幕后调用了dired的函数dired-copy-filename-as-kill。而后者作用于原始的dired UI,其中第一行恰恰是文件夹的路径——正是这一细微的差异,导致了文件名获取的南辕北辙。

那么,如何优雅地修复这个bug,让流畅的体验重回指尖呢?

一个简洁而有效的方案就此诞生:在Spacemacs中创建一个私有层my-bug-fix-layer。首先,在layers.el中添加必要的声明:

(configuration-layer/declare-layer 'ranger)

随后,在config.el中植入修复的代码,轻巧地绕过这个陷阱。

(with-eval-after-load 'ranger
  (when ranger-override-dired
    (defun my-ranger-copy-fix-advice (orig-fun &rest args)
      (cl-letf (((symbol-function 'dired-get-subdir) (lambda (&optional arg) nil)))
        (apply orig-fun args)))
    (advice-add 'dired-copy-filename-as-kill :around #'my-ranger-copy-fix-advice)
    (advice-add 'ranger-copy-filename :around #'my-ranger-copy-fix-advice)))

如此,困扰多时的问题便如晨雾般消散,一切恢复宁静与高效。

]]>
《小河那边的家》 https://dustincys.github.io/cn/2026/01/music/ 2026-01-22T00:00:00+00:00 石见 石页 https://dustincys.github.io/cn/2026/01/music
灰色的屋瓦,落着旧雪花
红色的砖墙,年轮刻风沙
屋檐下燕子窝,又一年归家
一声一声,叫醒春芽

家门前的柳树,低垂着枝桠
清澈的小河,绕过人家
河水里有鱼,闪着银花
像儿时的梦,静静流淌着它

儿时梦,散如沙,谁知转瞬即天涯
一回头,人已远,雪落在异乡街巷下
灰瓦红墙还在吗
风一吹,心就回到那

那条狗叫大黑,守着篱笆
黄昏一声吠,夜色落下
我沿着河岸,把童年追查
脚印一深一浅,踩碎月光下

儿时梦,散如沙,谁知转瞬即天涯
酒未满,话未说,思念先落下
清澈的小河还流吗
我在远方,一直想家

小河那一边,是青色山崖
世界再大,也走不出它
人走得再远,梦不会散吧
那一声乡音,把我带回家
]]>
昨日重现 https://dustincys.github.io/cn/2025/10/fvwm2/ 2025-10-21T00:00:00+00:00 石见 石页 https://dustincys.github.io/cn/2025/10/fvwm2

All my best memories come back clearly to me. It is yesterday once more.
那些珍藏的时光,如潮水般涌回心间,仿佛昨日在眼前轻轻铺展。

归国后,我渐渐倾心于Debian发行版的Linux,它如一位沉稳的老友,以无比的可靠与宁静陪伴左右:

  • ‌严苛的考验‌:稳定版历经时光打磨,软件包皆经过漫长验证,每两至三年方更新一次,恰似为服务器与重任之地筑起坚固堡垒。
  • ‌自由的节奏‌:透过APT,我可随心择选更新,甚至守护特定软件免于变迁,避开意外波澜, 让一切如诗般从容。

在将Linux植入Dell台式机前,我细细探看硬件与支持,发现无线网卡的驱动自Debian13内核始得拥抱。安装毕,我迫不及待想重拾fvwm2与 hifvwm的旧梦。

fvwm2的设计哲学,深得我心,宛如一首未完成的诗篇。2017至2018年间,我在原作的基底上,添上了最小化缩略图的灵韵、最小化图标的透明幻影,以及返回上桌面页面的轻巧函数,让透明效果浑然一体,如梦境般连贯。

我下载源码,欲在本地编织,却见编译中错误丛生——Debian13的依赖库已不再支持往昔的痕迹。转而一试,apt install fvwm 竟能从Debian源中轻松获取,原来这包裹已被社区巧妙修饰,依赖库悄然更迭。

当用 apt-get source 命令采撷源码时,它携来完整的包裹,内含上游代码与Debian的补丁缀饰。社区在构建二进制包时,依循 debian/rules 的指引,将这些补丁轻轻缝合,融入 Debian独有的匠心。这机制让定制如流水般自然,既保留上游的纯净,又织入自身的华彩。

如何将我往昔对fvwm2的个性化雕琢,直接烙入Debian的源码,让“昨日重现”?

  1. 步入我的fvwm2文件夹,将2017到2018年的代码修改细细收拢,打包成补丁的画卷:
    git log --author="dustin" --pretty=format:"%H" | xargs -I {} git show {} --pretty=format: --patch > dustin_total.diff
    
  2. 踏入Debian的fvwm2源码殿堂,将这补丁轻柔嵌入:
     patch -p1 < ~/github/fvwm/dustin_total.diff
    
  3. 重新构筑Debian的fvwm软件包,如匠人打磨珍品:
     debuild -us -uc -b
    
  4. 最终,将这心血之作安放妥帖:
    dpkg -i fvwm*.deb
    
]]>
机器应该如何理解人类的注意力? https://dustincys.github.io/cn/2025/09/roam-agenda/ 2025-09-13T00:00:00+00:00 石见 石页 https://dustincys.github.io/cn/2025/09/roam-agenda 在高效管理时间和日程时,我们需要正视几个基本事实: 人类大脑的存储能力有限,注意力资源稀缺,时间以线性方式不可逆地流逝,同时计算机的算力也存在上限。 因此,在实践日程安排时,必须从海量文件中精准提取关键待办事项。 对于已完成的任务,应效仿大脑的“遗忘”机制,自动将其忽略,以避免资源浪费。 这样不仅能节省算力,还能实现快速、动态的日程优化,在纷繁事务中维持高效与平衡。 这种仿生型时间管理系统,本质上是在数字世界重构了人类认知的过滤机制。当技术开始理解我们的注意力如何分配时,真正的效率革命才会发生。

对于org-roam的节点node文件,需要判断其所有内容是否都完成,如果完成是不是已经过去1月时间。 如果是,在查看日程时,忽略这个文件。

(defun my-org/org-contains-agenda-p (&optional minutes)
    "Return non-nil if current buffer has any relevant task.

This includes:
- TODO entries,
- Entries not marked DONE but scheduled or with a deadline,
- DONE entries that have clock-in/out information."
    (let ((minutes (or minutes 43200)))
      (org-element-map
          (org-element-parse-buffer 'headline)
          'headline
        (lambda (h)
          (let* ((todo-type (org-element-property :todo-type h))
                 (scheduled (org-element-property :scheduled h))
                 (deadline (org-element-property :deadline h))
                 (contents-begin (org-element-property :contents-begin h))
                 (contents-end (org-element-property :contents-end h))
                 (clocked-in
                  (when (and contents-begin contents-end)
                    (save-excursion
                      (goto-char contents-begin)
                      (re-search-forward "CLOCK:.*" contents-end t))))
                 (recent-clock-out
                  (when (and contents-begin contents-end)
                    (save-excursion
                      (goto-char contents-begin)
                      (when (re-search-forward
                             "CLOCK:.*--\\(\\[[^]]+\\]\\)" contents-end t)
                        (let* ((time-str (match-string 1))
                               (time (org-time-string-to-time time-str))
                               (diff (float-time
                                      (time-subtract (current-time) time))))
                          (< diff (* minutes 60)))))))
                 )
            (or (eq todo-type 'todo)
                (and (not (eq todo-type 'done))
                     (or scheduled deadline))
                (and (eq todo-type 'done)
                     clocked-in
                     recent-clock-out)
                )))
        nil 'first-match)))

但随着时间流逝,我们需要在构建日程之前,自动检查文件是否已经“过期”,如果是,自动更新标签。

(defun my-org/org-agenda-files ()
    "Return a list of note files containing 'agenda' tag and with relevant tasks."
    (let* ((agenda-files
            (seq-uniq
             (seq-map
              #'car
              (org-roam-db-query
               [:select [nodes:file]
                        :from tags
                        :left-join nodes
                        :on (= tags:node-id nodes:id)
                        :where (glob tag "AGENDA")]))))
           (tagged-files
            (seq-uniq
             (seq-map
              #'car
              (org-roam-db-query
               [:select [nodes:file]
                        :from tags
                        :left-join nodes
                        :on (= tags:node-id nodes:id)
                        :where (glob tag "agenda")]))))
           (today (format-time-string "%Y-%m-%d"))
           (already-run (and my-org/daily-last-filter-tag-date
                             (string= today my-org/daily-last-filter-tag-date))))
      (if already-run
          (seq-uniq (append
                     tagged-files
                     agenda-files))
        (setq my-org/daily-last-filter-tag-date today)
        (prog2
            (org-roam-db-sync)
            (seq-uniq (append
                       (seq-filter
                        (lambda (file)
                          (when (and file (file-exists-p file))
                            (with-current-buffer (find-file-noselect file)
                              (let ((is-agenda-file (my-org/org-agenda-update-tag)))
                                (when (buffer-modified-p)
                                  (save-buffer))
                                is-agenda-file))))
                        tagged-files)
                       agenda-files))
          (org-roam-db-sync)))))

但为了优化计算,每天只更新一次。 所以需要设置一个全局变量来判断。

  (defvar my-org/daily-last-filter-tag-date nil
    "The date when `my-org/org-agenda-files' was last successfully run.")

这样将以上逻辑添加入日程管理的步骤中即可。

  (defun my-org/org-agenda-files-update (&rest _)
    "Update the value of `org-agenda-files'."
    (setq org-agenda-files (my-org/org-agenda-files)))

  (add-hook 'find-file-hook #'my-org/org-agenda-update-tag)
  (add-hook 'before-save-hook #'my-org/org-agenda-update-tag)

  (dolist (fn '(org-agenda org-agenda-list org-todo-list))
    (when (fboundp fn)
      (advice-add fn :before #'my-org/org-agenda-files-update)))
]]>
用于Capture到Org-roam知识库的模板函数 https://dustincys.github.io/cn/2025/08/Capture2Roam/ 2025-08-03T00:00:00+00:00 石见 石页 https://dustincys.github.io/cn/2025/08/Capture2Roam 合理的org捕获模板应该使其具备:捕获内容到org-roam知识库中任意一个标题之下。 且这个模板应该有一个函数自动寻找目标地址。

例如,有如下模板:

      (setq org-capture-templates
            '(; For email todo ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
              ("e" "Email todo")
              ("et" "Mail org file" entry (file+headline "~/NutstoreFiles/Nutstore/org-roam/20220715212413-mail.org" "Mails TODO")
               "* TODO %?	 :MAIL:%^{Set tag|WORK|HOME|BABY|}:\n%U %a")
              ("eo" "Mail org file" entry (function my-org/roam-capture-to-headline)
               "* TODO %?	 :MAIL:\n%U %a")
              ("t" "Temp todo templates")
              ("tt" "Temp org file" entry (file+headline "~/NutstoreFiles/Nutstore/org-roam/20220715212959-temp.org" "Temporary task")
               "* TODO %?    :%^{Set tag|WORK|HOME|BABY|}:"
               :jump-to-captured t)
              ("to" "Org-roam TODO" entry (function my-org/roam-capture-to-headline)
               "* TODO %?"
               :jump-to-captured t))

那么如果设置如下函数,可以实现更智能的目标查找。

(defun my-org/roam-capture-to-headline ()
    "Visit an Org-roam file and move point just under a chosen headline."
    (let* ((node (org-roam-node-read))
           (file (org-roam-node-file node))
           (headline
            (with-current-buffer (find-file-noselect file)
              (org-mode)
              (org-element-cache-reset)
              (let ((headlines
                     (org-element-map (org-element-parse-buffer) 'headline
                       (lambda (hl)
                         (org-element-property :raw-value hl)))))
                (completing-read "Choose headline: " headlines nil nil)))))
      (find-file file)
      (goto-char (point-min))
      (if (re-search-forward
           (format org-complex-heading-regexp-format (regexp-quote headline))
           nil t)
          (point)
        (progn
          (goto-char (point-max))
          (unless (bolp) (insert "\n\n"))
          (if (yes-or-no-p "Insert the new headline?")
              (insert (concat "* " headline)))
          (point)))))

2025-11-13更新:

以上,所有各级标题都在一个级别目录内,且无法进行roam跳转。 所以一个更合理的函数是my-org/roam-capture-to-headline,能够把当前roam节点的org文件中所有标题构建一个树形结构,然后按照树形结构逐级来回跳转,同时如果是链接到新节点,那么提供选项跳到新节点。并提供反跳会含有该节点连接的任意节点。 这就真正意义上实现了“漫游”。

  (cl-defstruct hl-node title begin level children parent)


  (defun my-org/parse-headline-tree ()
    "Return headline tree for current buffer."
    (let* ((parsed (org-element-parse-buffer))
           (root (make-hl-node :title "ROOT" :begin (point-min) :level 0 :children nil))
           (stack (list root)))
      (org-element-map parsed 'headline
        (lambda (hl)
          (let* ((title (org-element-property :raw-value hl))
                 (level (org-element-property :level hl))
                 (begin (org-element-property :begin hl))
                 (node (make-hl-node :title title :level level :begin begin :children nil)))
            ;; Pop stack until parent level matches
            (while (> (hl-node-level (car stack)) (1- level))
              (pop stack))
            ;; Add node to parent's children
            (setf (hl-node-children (car stack))
                  (cons node (hl-node-children (car stack))))
            ;; Push node to stack
            (push node stack))))
      ;; Reverse children lists recursively
      (cl-labels ((fix (n)
                    (setf (hl-node-children n)
                          (mapcar #'fix (nreverse (hl-node-children n))))
                    n))
        (fix root))))


  (defun my-org/set-parents (node &optional parent)
    (setf (hl-node-parent node) parent)
    (dolist (c (hl-node-children node))
      (my-org/set-parents c node))
    node)


  (defun my-org/extract-id-from-link (s)
    "Return Org-roam ID if S contains a link of the form [[id:UUID]]."
    (when (string-match "\\[\\[id:\\([-0-9a-f]+\\)\\]\\[[^]]*\\]\\]" s)
      (match-string 1 s)))


  (defun my-org/helm-select-from-tree (node &optional file)
    "Recursively choose a headline from NODE. Return either:
 - an hl-node
 - or (node . new-title) for insertion."
    (let* ((children (hl-node-children node))
           (parent (when (> (hl-node-level node) 0) (hl-node-parent node)))
           (node-title (when node (hl-node-title node)))
           (node-id (when node-title (my-org/extract-id-from-link node-title)))
           (child-cands (mapcar (lambda (c) (cons (hl-node-title c) c))
                                children)))

      (helm
       :prompt (format "Choose in [%s]: " (hl-node-title node))
       :sources
       (list
        ;; ---- Source 1 ----
        (helm-build-sync-source "Actions"
          :match (lambda (_) t)
          :candidates
          (append
           (when parent (list (cons "↑↑ Go up" :up)))
           (when node-id (list (cons "→→ Open linked node" :open-link)))
           (list (cons "++ Create new headline WITH typed prefix" :create-with-prefix))
           (list (cons "+- Create new headline WITHOUT prefix" :create-no-prefix))
           (list (cons "↩↩ Open backlinks" :open-backlinks))
           (list (cons "XX Cancel" :cancel))
           )
          :action
          (lambda (choice)
            (cond
             ((eq choice :up)
              (my-org/helm-select-from-tree parent file))

             ;; open linked node
             ((eq choice :open-link)
              (let ((target (org-roam-node-from-id node-id)))
                (when target
                  (let ((next-file (org-roam-node-file target)))
                    (find-file next-file)
                    (goto-char (point-min))
                    (my-org/helm-select-from-tree
                     (my-org/set-parents
                      (my-org/parse-headline-tree))
                     next-file)))))

             ((memq choice '(:create-with-prefix :create-no-prefix))
              ;; Return: (node . (choice . typed-text))
              (cons file (cons node (cons choice helm-pattern))))

             ((eq choice :open-backlinks)
              ;; Call backlink selector for current file
              (my-org/helm-open-backlinks file))

             ((eq choice :cancel)
              :cancel)
             )))

        ;; ---- Source 2 ----
        (helm-build-sync-source "Headlines"
          :candidates child-cands
          :action (lambda (choice)
                    (my-org/helm-select-from-tree choice file)))))))


  (defun my-org/roam-capture-to-tree ()
    "Use the headline tree selector and insert according to returned action.
Return the point where the content ends up."
    (interactive)
    (let* ((node (org-roam-node-read))
           (file (org-roam-node-file node))
           ;; Step 1: parse headline tree in a temp buffer
           (root (with-current-buffer (find-file-noselect file)
                   (org-mode)
                   (org-element-cache-reset)
                   (my-org/set-parents (my-org/parse-headline-tree))))
           ;; Step 2: let user select headline or create new
           (result (my-org/helm-select-from-tree root file))
           parent-node typed)
      ;; (find-file file)
      ;; (message "result: %S" result)
      (pcase result
        ;; Cancel
        (:cancel
         (user-error "cancel"))

        ;; Create with prefix: insert typed headline under parent
        (`(,target-file . (,parent-node . (:create-with-prefix . ,typed)))
         (find-file target-file)
         (goto-char (hl-node-begin parent-node))
         (unless (string-empty-p typed)
           (org-end-of-subtree t)
           (unless (bolp) (insert "\n"))
           (insert (make-string (+ 1 (hl-node-level parent-node)) ?*) " " typed))
         (cons target-file (point-marker))
         )
        ;; Create NO prefix: insert empty under parent
        (`(,target-file . (,parent-node . (:create-no-prefix . ,_typed)))
         (find-file target-file)
         (goto-char (hl-node-begin parent-node))
         (cons target-file (point-marker)))
        ;; Should not happen
        (_
         (user-error "cancle")))))

  (defun my-org/get-backlink-nodes (file)
    "Return a list of (source-id . source-file) that link to FILE."
    (org-roam-db-query
     [:select [links:source nodes:file]
              :from links
              :left-join nodes
              :on (= links:source nodes:id)
              :where (= links:dest
                        [:select id
                                 :from nodes
                                 :where (= file $s1)])]
     file))

  (defun my-org/helm-open-backlinks (current-file)
    "Helm interface to open backlinks of CURRENT-FILE.
Returns the node struct of the selected backlink file."
    (let* ((backlinks (my-org/get-backlink-nodes current-file))
           (candidates
            (mapcar (lambda (row)
                      (let* ((src-id (car row))
                             (src-file (cadr row))
                             (node (org-roam-node-from-id src-id)))
                        (cons (org-roam-node-title node) node)))
                    backlinks)))
      (helm :prompt "Backlinks: "
            :sources
            (helm-build-sync-source "Backlinked Nodes"
              :candidates candidates
              :action (lambda (node)
                        (let ((file (org-roam-node-file node)))
                          (find-file file)
                          (goto-char (point-min))
                          (my-org/helm-select-from-tree
                           (with-current-buffer (current-buffer)
                             (my-org/set-parents (my-org/parse-headline-tree)))
                           file )))))))
]]>