;;; nf-ucs.el --- unicode character lookup utils

;; Author: Noah Friedman <friedman@splode.com>
;; Created: 2012-09-21
;; Public domain.

;; $Id: nf-ucs.el,v 1.4 2017/09/10 03:04:30 friedman Exp $

;;; Commentary:

;; `ucs-names' became a hashtable in Emacs 26.

;;; Code:

(require 'tabulated-list)

(defconst nf-ucs-tabulated-list-format
  '[("Char"         6 nf-ucs-sort-pred :pad-right 4 :right-align nil)
    ("Oct"          8 nf-ucs-sort-pred :pad-right 4 :right-align t)
    ("Dec"          7 nf-ucs-sort-pred :pad-right 4 :right-align t)
    ("Hex"          6 nf-ucs-sort-pred :pad-right 4 :right-align t)
    ("Description" 13 t)])

(defvar nf-ucs-tabulated-list-entries nil)
(defvar nf-ucs-use-header-line        t)

(define-derived-mode nf-ucs-apropos-mode tabulated-list-mode "UCS Apropos"
  "Document me."
  (setq tabulated-list-format          nf-ucs-tabulated-list-format
        tabulated-list-entries         nf-ucs-tabulated-list-entries
        tabulated-list-use-header-line nf-ucs-use-header-line)
  (setq bidi-display-reordering        nil))

;; The table id is the character number, so for numeric fields, sort on that.
(defun nf-ucs-sort-pred (a b)
  (< (car a) (car b)))

(defun nf-ucs-apropos-display (matches)
  (with-current-buffer (get-buffer-create "*UCS Apropos*")
    (let ((inhibit-read-only t)
          (nf-ucs-tabulated-list-entries
           (mapcar (lambda (ent)
                     (let ((c (cdr ent)))
                       (list c
                             (vector (format "%c"   c)
                                     (format "%o"   c)
                                     (format "%d"   c)
                                     (format "%04X" c)
                                     (car ent)))))
                   (sort matches (lambda (a b) (< (cdr a) (cdr b)))))))
      (erase-buffer)
      (nf-ucs-apropos-mode)
      (tabulated-list-init-header)
      (tabulated-list-print)
      (display-buffer (current-buffer)))))

;;;###autoload
(defun nf-ucs-apropos (regexp)
  (interactive "sApropos UCS names (regexp): ")
  (let ((case-fold-search t)
        (match nil)
        (mfn (if (hash-table-p (ucs-names))
                 'maphash
               'mapc)))
    (save-match-data
      (cond ((hash-table-p (ucs-names))
             (maphash (lambda (key val)
                        (when (string-match regexp key)
                          (setq match (cons (cons key val) match))))
                      (ucs-names)))
            (t
              (mapc (lambda (pair)
                      (when (string-match regexp (car pair))
                        (setq match (cons pair match))))
                (ucs-names)))))
    (when (called-interactively-p 'interactive)
      (if match
          (nf-ucs-apropos-display match)
        (message "No matches for \"%s\"" regexp)))
    match))

;;;###autoload
(defun nf-ucs-char-name (char)
  (interactive "MCharacter: ")
  (save-match-data
    (cond ((characterp char))
          ((= (length char) 1)
           (setq char (aref char 0)))
          ((string-match "^\\(?:[0#\\\\]x\\|U\\+\\)\\([0-9a-f]+\\)" char)
           (setq char (string-to-number (match-string 1 char) 16)))
          ((string-match "^[#\\\\]o\\([0-7]+\\)" char)
           (setq char (string-to-number (match-string 1 char)  8)))
          ((string-match "^[0-9]+$" char)
           (setq char (string-to-number char 10)))))
  (let ((s nil)
        (fmt "%c  0%o  %d  U+%04X  %s"))

    (cond ((hash-table-p (ucs-names))
           (setq s (catch 'found
                     (maphash (lambda (k v)
                                (when (equal v char)
                                  (throw 'found k)))
                              (ucs-names)))))
          (t
           (setq s (car (rassq char (ucs-names))))))
    (when (called-interactively-p 'interactive)
      (if s
          (message fmt char char char char s)
        (message fmt char char char char  "not found")))
    s))

(provide 'nf-ucs)

;; eof