通过 find-word-boundary-function-table 进行中文分词

Emacs 内的中文分词方案已经有不少，但几乎都需要重绑定基础命令，覆盖难免不全，在 words count 等基于 forward-word 的场景更是无能为力。而实际上 Emacs 早在 23 版本就加入了 find-word-boundary-function-table 来配置单词边界的查找方法，曾同样依赖重绑键位的 subword 之后就是用此 char-table 重写的，以实现直接作用于所有 word motion。

find-word-boundary-function-table 中的函数接收 POS 、 LIMIT 两个参数， POS 小于 LIMIT 时返回词的结束位置，否则返回词的起始位置。

我之前一直在使用 kanglmf/emacs-chinese-word-segmentation，本文以此为例提供一种实现思路，所有类似的分词包应该都可复用。

;; 配置好 cns.el 之后
(defconst cns-boundary-table
  (let ((tab (make-char-table nil)))
    (map-char-table
     (lambda (key value)
       (when (aref value ?C)
         (set-char-table-range tab key #'cns-boundary-find-word-boundary)))
     (standard-category-table))
    tab)
  "Char table assigned to `find-word-boundary-function-table' in
`cns-boundary-mode' buffers.")

(defun cns-boundary-han-run-at (pos)
  "Return (START . END) of the maximal run of HànZì around POS."
  (save-excursion
    (goto-char pos)
    (cons (if (re-search-backward "\\CC" nil t) (1+ (point)) (point-min))
          (progn (goto-char pos)
                 (if (re-search-forward "\\CC" nil t) (1- (point)) (point-max))))))

(defun cns-boundary-word-boundaries (pos)
  "Return the ascending list of absolute word boundary positions of
the HànZì run around POS.  e.g. (1 3 5) for \"中文分词\"."
  (let* ((run (cns-boundary-han-run-at pos))
         (start (car run))
         (end (cdr run))
         (segs (cns-segmentation-handler
                (buffer-substring-no-properties start end))))
    (let ((bounds (list start)))
      (dolist (len segs)
        (push (+ (car bounds) len) bounds))
      (setq bounds (nreverse bounds)))))

(defun cns-boundary-find-word-boundary (pos limit)
  "Find the Chinese word boundary near POS bounded by LIMIT.."
  (let ((bounds (cns-boundary-word-boundaries pos)))
    (if (< pos limit)
        ;; POS is at the first character of a word.
        (cl-find-if (lambda (b) (> b pos)) bounds)
      ;; POS is at the last character of a word.
      (car (last (cl-remove-if (lambda (b) (> b pos)) bounds))))))

(defun cns-boundary-mode-enable nil
  "Enable `cns-boundary-mode'."
  (unless (process-live-p cns-process)
    (cns-start-process))
  (cns-buffer-list-add-buffer)
  (setq-local find-word-boundary-function-table cns-boundary-table)
  (add-hook 'kill-buffer-hook #'cns-boundary-mode-disable nil t))

(defun cns-boundary-mode-disable nil
  "Disable `cns-boundary-mode'."
  (cns-buffer-list-delete-buffer)
  (kill-local-variable 'find-word-boundary-function-table)
  (when (and (process-live-p cns-process) (= 0 (length cns-buffer-list)))
    (cns-stop-process))
  (remove-hook 'kill-buffer-hook #'cns-boundary-mode-disable t))

(define-minor-mode cns-boundary-mode
  "Toggle Chinese word segmentation mode in current buffer.
Unlike `cns-mode', this mode rebinds no keys."
  :group 'cns
  (if cns-boundary-mode (cns-boundary-mode-enable) (cns-boundary-mode-disable)))

(define-globalized-minor-mode global-cns-boundary-mode cns-boundary-mode
  (lambda nil (cns-boundary-mode 1))
  :group 'cns)

基本就是通过 cns-segmentation-handler 获取分词结果，再想办法塞进 find-word-boundary-function-table 里，然后包括 forward-word 、 makr-word 在内的原生命令就都获得了中文分词能力。代价是与其他分词模式———实际上也只有 subword-mode 冲突。

不过仍有部分命令，例如 count-words 使用的是 forward-word-strictly ，会故意遮蔽掉这个 char-table，只能重写。

(defun my-count-words-region (start end &optional totals)
  "Count the number of words in the region.
With prefix ARG, report for the entire buffer rather than the region."
  (interactive (if current-prefix-arg
                   (list nil nil current-prefix-arg)
                 (list (region-beginning) (region-end) nil)))
  (cl-letf (((symbol-function 'forward-word-strictly) #'forward-word))
    (if totals
        (message "%s" (count-words--buffer-format))
      (message "%s" (count-words--format
                     "Region" (region-beginning) (region-end))))))

(keymap-global-set [remap count-words-region] #'my-count-words-region)