init-segmentation.el (4252B)
1 ;;; init-segmentation.el --- Chinese word segmentation -*- lexical-binding: t -*- 2 3 ;;; Commentary: 4 5 ;;; Code: 6 7 (my-use-package cns 8 :straight 9 (cns :type git 10 :host github 11 :repo "kanglmf/emacs-chinese-word-segmentation") 12 :autoload cns-start-process 13 :hook 14 (after-init . my-global-cns-boundary-mode) 15 :init 16 (defvar my-cns-dir (my-straight-package-dir "cns")) 17 (defun my-compile-cns () 18 (interactive) 19 (let ((default-directory my-cns-dir)) 20 (compile "make"))) 21 (setq cns-prog (expand-file-name (if *is-windows* "cnws.exe" "cnws") my-cns-dir) 22 cns-dict-directory (expand-file-name "cppjieba/dict" my-cns-dir) 23 cns-recent-segmentation-limit 40 24 cns-process-type 'shell 25 cns-process-shell-command 26 (format "%s %s %s %s %s %s" 27 cns-prog 28 (concat (file-name-as-directory cns-dict-directory) "jieba.dict.utf8") 29 (concat (file-name-as-directory cns-dict-directory) "hmm_model.utf8") 30 (concat (file-name-as-directory cns-dict-directory) "user.dict.utf8") 31 (concat (file-name-as-directory cns-dict-directory) "idf.utf8") 32 (concat (file-name-as-directory cns-dict-directory) "stop_words.utf8"))) 33 34 ;; word segmentation via `find-word-boundary-function-table' 35 ;; NOT compatible with any other modes that use this char table 36 (defvar cns-process nil) 37 (defconst my-cns-boundary-table 38 (let ((tab (make-char-table nil))) 39 (map-char-table 40 (lambda (key value) 41 (when (aref value ?C) 42 (set-char-table-range tab key #'my-cns-boundary-find-word-boundary))) 43 (standard-category-table)) 44 tab) 45 "Char table assigned to `find-word-boundary-function-table' in 46 `my-cns-boundary-mode' buffers.") 47 48 (defun my-cns-boundary-han-run-at (pos) 49 "Return (START . END) of the maximal run of HànZì around POS." 50 (save-excursion 51 (goto-char pos) 52 (cons (if (re-search-backward "\\CC" nil t) (1+ (point)) (point-min)) 53 (progn (goto-char pos) 54 (if (re-search-forward "\\CC" nil t) (1- (point)) (point-max)))))) 55 56 (defun my-cns-boundary-word-boundaries (pos) 57 "Return the ascending list of absolute word boundary positions of 58 the HànZì run around POS. e.g. (1 3 5) for \"中文分词\"." 59 (let* ((run (my-cns-boundary-han-run-at pos)) 60 (start (car run)) 61 (end (cdr run)) 62 (segs (cns-segmentation-handler 63 (buffer-substring-no-properties start end)))) 64 (let ((bounds (list start))) 65 (dolist (len segs) 66 (push (+ (car bounds) len) bounds)) 67 (setq bounds (nreverse bounds))))) 68 69 (defun my-cns-boundary-find-word-boundary (pos limit) 70 "Find the Chinese word boundary near POS bounded by LIMIT.." 71 (let ((bounds (my-cns-boundary-word-boundaries pos))) 72 (if (< pos limit) 73 ;; POS is at the first character of a word. 74 (cl-find-if (lambda (b) (> b pos)) bounds) 75 ;; POS is at the last character of a word. 76 (car (last (cl-remove-if (lambda (b) (> b pos)) bounds)))))) 77 78 (defun my-cns-boundary-mode-enable nil 79 "Enable `my-cns-boundary-mode'." 80 (unless (process-live-p cns-process) 81 (cns-start-process)) 82 (cns-buffer-list-add-buffer) 83 (setq-local find-word-boundary-function-table my-cns-boundary-table) 84 (add-hook 'kill-buffer-hook #'my-cns-boundary-mode-disable nil t)) 85 86 (defun my-cns-boundary-mode-disable nil 87 "Disable `my-cns-boundary-mode'." 88 (cns-buffer-list-delete-buffer) 89 (kill-local-variable 'find-word-boundary-function-table) 90 (when (and (process-live-p cns-process) (= 0 (length cns-buffer-list))) 91 (cns-stop-process)) 92 (remove-hook 'kill-buffer-hook #'my-cns-boundary-mode-disable t)) 93 94 (define-minor-mode my-cns-boundary-mode 95 "Toggle Chinese word segmentation mode in current buffer. 96 Unlike `cns-mode', this mode rebinds no keys." 97 :group 'cns 98 (if my-cns-boundary-mode (my-cns-boundary-mode-enable) (my-cns-boundary-mode-disable))) 99 100 (define-globalized-minor-mode my-global-cns-boundary-mode my-cns-boundary-mode 101 (lambda nil (my-cns-boundary-mode 1)) 102 :group 'cns)) 103 104 (provide 'init-segmentation) 105 ;;; init-segmentation.el ends here