PageRenderTime 54ms CodeModel.GetById 23ms RepoModel.GetById 1ms app.codeStats 0ms

/my-customize-lisp/what-char.el

https://github.com/Kanasansoft/emacs-files
Emacs Lisp | 284 lines | 190 code | 39 blank | 55 comment | 9 complexity | ce1d6a5da7099363813620bcf62d65d2 MD5 | raw file
  1. ;;; -*- coding: shift_jis-dos; tab-width: 4; -*-
  2. ;;; what-char.el --- show character code at point
  3. ;;; $Id: what-char.el 1.0.0.1 2005/01/22 07:06:44 satomii Exp $
  4. ;; Copyright (C) 2002-2004, Satomi I.
  5. ;; (satomi atmark ring period gr period jp)
  6. ;; This file is NOT a part of GNU Emacs.
  7. ;; This program is free software; you can redistribute it and/or modify it
  8. ;; under the terms of the GNU General Public License as published by the
  9. ;; Free Software Foundation; either version 2 of the License, or any later
  10. ;; version.
  11. ;;
  12. ;; This program is distributed in the hope that it will be useful, but
  13. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  15. ;; General Public License for more details.
  16. ;;; Commentary:
  17. ;; what-char is a small utility that tells the encoded character codes at
  18. ;; point. It also provides a minor mode to display the character code on
  19. ;; the mode line.
  20. ;;
  21. ;; Main differences from `what-cursor-position' or `describe-char' are:
  22. ;;
  23. ;; - Simplified output. Only the character code information is displayed.
  24. ;; - Coding-system aware. Shows the character code(s) encoded by the
  25. ;; buffer or specified coding-system(s). It would be helpful in
  26. ;; identifying multi-byte characters.
  27. ;;
  28. ;; To show the character code at point on the echo area:
  29. ;;
  30. ;; M-x what-char [RET]
  31. ;;
  32. ;; To enable the minor mode:
  33. ;;
  34. ;; 1. Modify `mode-line-format' to display `what-char-mode-line-format'
  35. ;; (or something like that) when `what-char-mode' is non-nil.
  36. ;; If you are not sure how to configure the mode line format, try
  37. ;; evaluating the following expression:
  38. ;;
  39. ;; (what-char-mode-line-format)
  40. ;;
  41. ;; This will append the entry for `what-char-mode' to
  42. ;; `mode-line-format'. If it does not work properly, your mode line
  43. ;; format might be too complex and needs to be configured manually.
  44. ;;
  45. ;; 2. M-x what-char-mode [RET]
  46. ;;
  47. ;; To specify the coding-systems used by `what-char', customize the
  48. ;; variable `what-char-category-coding-system-alist'.
  49. ;;
  50. ;; To specify the coding-system used by `what-char-mode', customize the
  51. ;; variable `what-char-mode-line-coding-system'.
  52. ;;; Code:
  53. (eval-when-compile
  54. (require 'cl))
  55. (if (fboundp 'propertize)
  56. (defalias 'what-char-propertize 'propertize)
  57. (defsubst what-char-propertize (string &rest properties)
  58. (set-text-properties 0 (length string) properties string)
  59. string))
  60. (defgroup what-char nil
  61. "Display character code at point on the mode line."
  62. :group 'modeline)
  63. (defcustom what-char-mode-line-format
  64. (if (< 20 emacs-major-version)
  65. '(:eval (what-char-propertize
  66. (concat "[" what-char-current-string "]")
  67. 'local-map what-char-mode-line-keymap
  68. 'help-echo '(what-char what-char-current-char -1)))
  69. '("[" what-char-current-string "]"))
  70. "*Mode line format for displaying the character code at point.
  71. See the documentation for `mode-line-format' for details."
  72. :type 'sexp
  73. :group 'what-char)
  74. (put 'what-char-mode-line-format 'risky-local-variable t)
  75. (defcustom what-char-mode-line-coding-system nil
  76. "*Coding system for encoding the character at point.
  77. Used to format the character code displayed on the mode line.
  78. If nil, the buffer's coding system `buffer-file-coding-system' is used."
  79. :type 'coding-system
  80. :group 'what-char)
  81. (defcustom what-char-category-coding-system-alist
  82. `((?j . (shift_jis euc-jp))
  83. (?g . (shift_jis euc-jp))
  84. (t . ,(append (if (coding-system-p 'utf-8)
  85. (list 'utf-8))
  86. (if (coding-system-p 'utf-16-be-no-signature)
  87. (list 'utf-16-be-no-signature)
  88. (if (coding-system-p 'utf-16be)
  89. (list 'utf-16be))))))
  90. "*Alist of character categories vs. coding systems.
  91. Used by `what-char' to determine the character encodings.
  92. Each element is a list:
  93. (CHAR-CATEGORY CODING-SYSTEM ...)
  94. CHAR-CATEGORY is a character that represents the character category.
  95. The value `t' means any category; i.e., it matches any character
  96. regardless of the actual category set.
  97. CODING-SYSTEM is a coding system (a symbol) for encoding a character
  98. that belongs to CHAR-CATEGORY. More than one coding can be specified.
  99. The coding selection is cumulative. For example:
  100. (setq what-char-category-coding-system-alist
  101. '((?j shift_jis) (t utf-8)))
  102. (what-char ?‚ )
  103. => \"S:82A0 u:E38182\""
  104. :group 'what-char
  105. :type '(repeat (cons (choice :tag "Category" character (const t))
  106. (repeat coding-system))))
  107. (defcustom what-char-idle-delay
  108. (if (boundp 'idle-update-delay) idle-update-delay 1)
  109. "*Delay time in seconds before updating the character information
  110. such as `what-char-current-string'."
  111. :type 'number
  112. :group 'what-char)
  113. (defvar what-char-idle-timer nil
  114. "Timer started after `what-char-idle-timer' seconds of idle time.")
  115. (defvar what-char-mode nil
  116. "Non-nil means `what-char-mode' is enabled.")
  117. (make-variable-buffer-local 'what-char-mode)
  118. (defvar what-char-current-char 0
  119. "Current character at point.
  120. Updated only when `what-char-mode' is enabled.")
  121. (make-variable-buffer-local 'what-char-current-char)
  122. (defvar what-char-current-string "??"
  123. "String representation of the current character at point encoded
  124. according to the value of `what-char-mode-line-coding-system'.
  125. Updated only when `what-char-mode' is enabled.")
  126. (make-variable-buffer-local 'what-char-current-string)
  127. (defun what-coding-char (char coding)
  128. (let ((str (encode-coding-string (char-to-string char) coding)))
  129. (mapconcat (lambda (c) (format "%02X" c)) str "")))
  130. (defun what-char (char &optional arg)
  131. "Display the character code(s) of CHAR in the echo area.
  132. If called interactively with prefix ARG, also run `describe-char' or
  133. `describe-char-after'.
  134. If called noninteractively with non-nil ARG, disable the message
  135. output but simply return the result string.
  136. The coding systems used to encode CHAR are taken from the buffer's
  137. coding system `buffer-file-coding-system' and the variable
  138. `what-char-category-coding-system-alist'."
  139. (interactive (list (or (following-char)
  140. (error "No character at point"))
  141. current-prefix-arg))
  142. (let ((category (char-category-set char))
  143. (eol (coding-system-eol-type buffer-file-coding-system))
  144. codings chars)
  145. (dolist (elem what-char-category-coding-system-alist)
  146. (if (or (eq t (car elem))
  147. (aref category (car elem)))
  148. (dolist (cs (cdr elem))
  149. (when (coding-system-p cs)
  150. (setq cs (coding-system-change-eol-conversion cs eol))
  151. (or (coding-system-equal cs buffer-file-coding-system)
  152. (memq cs codings)
  153. (setq codings (cons cs codings)))))))
  154. (setq codings (cons buffer-file-coding-system
  155. (sort codings 'coding-system-lessp)))
  156. (dolist (cs codings)
  157. ;; the mnemonic characters for utf-8 and utf-16 are both "u". is it
  158. ;; necessary to make coding-system prefixes customizable...?
  159. (setq chars (cons (concat (char-to-string (coding-system-mnemonic cs))
  160. ":" (what-coding-char char cs))
  161. chars)))
  162. (setq chars (concat "\""
  163. (case char
  164. (?\n (case eol
  165. (1 "\\r\\n") (2 "\\r") (t "\\n")))
  166. (?\t "\\t")
  167. (t (char-to-string char)))
  168. "\" "
  169. (mapconcat 'identity (nreverse chars) " ")))
  170. (if arg
  171. (when (interactive-p)
  172. (if (fboundp 'describe-char)
  173. (describe-char (point))
  174. (describe-char-after))
  175. (message "%s" chars))
  176. (message "%s" chars))
  177. chars))
  178. (defun what-char-update ()
  179. (when what-char-mode
  180. (let ((char (following-char)))
  181. (unless (eq what-char-current-char char)
  182. (setq what-char-current-char char)
  183. (setq what-char-current-string
  184. (what-coding-char char (or what-char-mode-line-coding-system
  185. buffer-file-coding-system)))
  186. (force-mode-line-update)))))
  187. (defun what-char-mode (&optional arg)
  188. "Toggle `what-char-mode'.
  189. With prefix ARG, turn `what-char-mode' on if ARG is positive or off
  190. otherwise."
  191. (interactive "P")
  192. (if what-char-idle-timer
  193. (cancel-timer what-char-idle-timer))
  194. (setq what-char-mode
  195. (if arg (< 0 (prefix-numeric-value arg))
  196. (not what-char-mode)))
  197. (setq what-char-idle-timer
  198. (if what-char-mode
  199. (run-with-idle-timer what-char-idle-delay t 'what-char-update)))
  200. (force-mode-line-update)
  201. (if (interactive-p)
  202. (message "what-char-mode is %s" (if what-char-mode "on" "off"))))
  203. (defun what-char-mouse-show (event)
  204. "Show the current character codes in response to a mouse event.
  205. See also `what-char'."
  206. (interactive "@e")
  207. (or what-char-current-char
  208. (what-char-update))
  209. (what-char what-char-current-char 1))
  210. (defun what-char-add-to-mode-line (&optional buffer)
  211. "Add an entry for `what-char-mode' to `mode-line-format'.
  212. If BUFFER is given, only the value for that buffer is modified.
  213. Otherwise the default value is modified using `setq-default'.
  214. This function may fail if `mode-line-format' is too complex."
  215. (interactive)
  216. (let ((elem '(what-char-mode ("" what-char-mode-line-format " ")))
  217. format)
  218. (cond ((stringp mode-line-format)
  219. (setq format (list elem mode-line-format)))
  220. ((listp mode-line-format)
  221. (setq format (reverse mode-line-format))
  222. (let ((sep (member "-%-" format)))
  223. (if sep
  224. (setcdr sep (cons elem (cdr sep)))
  225. (setq format (cons elem format)))
  226. (setq format (nreverse format))))
  227. (t
  228. (error "Unsupported form of `mode-line-format'")))
  229. (if buffer
  230. (with-current-buffer buffer
  231. (setq mode-line-format format))
  232. (setq-default mode-line-format format))
  233. (force-mode-line-update)))
  234. (defvar what-char-mode-line-keymap
  235. (let ((parent-map (make-sparse-keymap))
  236. (child-map (make-sparse-keymap)))
  237. (define-key child-map [mouse-2] 'what-char-mouse-show)
  238. (define-key parent-map [mode-line] child-map)
  239. parent-map))
  240. (if (boundp 'mode-line-mode-menu)
  241. (define-key mode-line-mode-menu [what-char-mode]
  242. '(menu-item "What Character Code" what-char-mode
  243. :button (:toggle . what-char-mode))))
  244. (provide 'what-char)
  245. ;;; what-char.el ends here