UCD Browser

# 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 を選択
![2014-03-13_220846.png](https://qiita-image-store.s3.amazonaws.com/0/32214/f5172d84-1f8f-ec07-b165-8a76827b9103.png)

```el
;;; 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
```