what
Unicode Character Database を閲覧するもの。tabulated-list-mode の練習を兼ねて作ってみた。
how
- http://www.unicode.org/Public/UNIDATA/ から UCD.zip を取得して、ローカルで展開しておく
- (setq ucd-directory "/home/someone/UCD")
- M-x ucd
- ENTER で BLOCK を選択
;;; ucd.el --- Unicode Character Database Browser
;; Copyright (C) 2013 Kitamoto Tsuyoshi <tsuyoshi.kitamoto@gmail.com>
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with Daredevil SKK, see the file COPYING. If not, write to
;; the Free Software Foundation Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; UCD.zip for http://www.unicode.org/Public/UNIDATA/UCD.zip
;;; How to use:
;; 1. (setq ucd-directory "/home/someone/UCD")
;; 2. M-x ucd
;;; TODO:
;; IVS
;;; Code:
(defvar ucd-directory "./UCD"
"Path/to/ucd/directory/.")
(defvar ucd-blocks-buffer "*UCD Blocks*"
"Docs.")
(defvar ucd-blocks nil
"Docs.")
(defvar ucd-chars-buffer "*ucd-chars*"
"Docs.")
(defvar ucd-data nil
"Docs.")
(defvar ucd-blocks-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map tabulated-list-mode-map)
(define-key map (kbd "RET") #'ucd-chars)
map))
(defvar ucd-chars-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map tabulated-list-mode-map)
(define-key map (kbd "+") #'ucd-chars-face-scale)
(define-key map (kbd "0") #'ucd-chars-face-scale-reset)
map))
(copy-face 'font-lock-keyword-face 'ucd-chars-face)
(defvar ucd-chars-face-height
(let ((h (face-attribute 'ucd-chars-face :height)))
(cond ((eq h 'unspecified)
(face-attribute 'default :height))
(t
h)))
"Docs.")
(set-face-attribute 'ucd-chars-face nil :height ucd-chars-face-height)
;;; Code:
(defun ucd-make-blocks ()
"Docs."
(let (list)
(with-temp-buffer
(insert-file-contents (expand-file-name "Blocks.txt" ucd-directory))
(while (re-search-forward "^[0-9A-F].+\.\.; .+$" nil t)
(setq list (cons (match-string 0) list))))
(setq ucd-blocks (reverse list))))
(define-derived-mode ucd-blocks-mode
tabulated-list-mode
"ucd-blocks-mode"
"docstring."
(setq tabulated-list-format [
("RANGE" 20 t)
("BLOCK" 40 t)
] )
(setq tabulated-list-padding 1)
(tabulated-list-init-header))
(defun ucd ()
"Docs."
(interactive)
(unless ucd-blocks
(ucd-make-blocks))
(cond ((get-buffer ucd-blocks-buffer)
(pop-to-buffer ucd-blocks-buffer))
(t
(pop-to-buffer (get-buffer-create ucd-blocks-buffer))
(ucd-blocks-mode)
(let (v spl s list)
(dolist (elt ucd-blocks)
(setq v (make-vector 2 nil)
spl (split-string elt "; ")
s (split-string (car spl) "\\.\\."))
(aset v 0 (concat (format "%6s" (nth 0 s)) " .. "
(format "%6s" (nth 1 s))))
(aset v 1 (nth 1 spl))
(setq list (cons (list nil v) list))
(setq tabulated-list-entries (reverse list))))
(tabulated-list-print t)
)))
(defun ucd-make-data ()
"Docs."
(let (list line)
(with-temp-buffer
(insert-file-contents (expand-file-name "UnicodeData.txt" ucd-directory))
(goto-char (point-min))
(while (not (eobp))
(setq line (split-string (buffer-substring (point)
(save-excursion
;; (move-end-of-line nil)
(search-forward ";" nil t 2)
(forward-char -1)
(point)))
";"))
(setq list (cons (list (nth 0 line)
(nth 1 line)) list))
(forward-line)))
(setq ucd-data (reverse list))
))
(define-derived-mode ucd-chars-mode
tabulated-list-mode
"ucd-chars-mode"
""
(setq tabulated-list-format [
("UNICODE" 10 t)
("CHAR" 4 t)
("NAME" 40 t)
] )
(setq tabulated-list-padding 1)
(tabulated-list-init-header))
(defun ucd-chars-face-scale ()
"Docs."
(interactive)
(set-face-attribute 'ucd-chars-face nil
:height (+ (round (/ ucd-chars-face-height 10))
(face-attribute 'ucd-chars-face :height))))
(defun ucd-chars-face-scale-reset()
"Docs."
(interactive)
(set-face-attribute 'ucd-chars-face nil
:height ucd-chars-face-height))
(defun ucd-chars ()
"Docs."
(interactive)
(unless ucd-data
(ucd-make-data))
(let ((range (aref (tabulated-list-get-entry) 0))
(block-name (aref (tabulated-list-get-entry) 1))
start end)
(while (string-match " " range)
(setq range (replace-match "" nil nil range)))
(let ((r (split-string range "\\.\\.")))
(setq start (string-to-int (nth 0 r) 16)
end (string-to-int (nth 1 r) 16)))
(when (get-buffer ucd-chars-buffer)
(kill-buffer ucd-chars-buffer))
(switch-to-buffer (get-buffer-create ucd-chars-buffer))
(ucd-chars-mode)
(setq mode-line-buffer-identification block-name)
(let (vec list)
(while (<= start end)
(setq vec (make-vector 3 nil))
(aset vec 0 (format "U+%04x" start))
(aset vec 1 (propertize (char-to-string start)
'face 'ucd-chars-face))
(aset vec 2
(let ((str (nth 1 (assoc (format "%X" start) ucd-data))))
(if (stringp str) str "")))
(setq list (cons (list nil vec) list))
(setq start (1+ start)))
(setq tabulated-list-entries (reverse list)))
(tabulated-list-print t)
))
(provide 'ucd)
;;; ucd.el ends here