/my-customize-lisp/what-char.el
Emacs Lisp | 284 lines | 190 code | 39 blank | 55 comment | 9 complexity | ce1d6a5da7099363813620bcf62d65d2 MD5 | raw file
- ;;; -*- coding: shift_jis-dos; tab-width: 4; -*-
- ;;; what-char.el --- show character code at point
- ;;; $Id: what-char.el 1.0.0.1 2005/01/22 07:06:44 satomii Exp $
-
- ;; Copyright (C) 2002-2004, Satomi I.
- ;; (satomi atmark ring period gr period jp)
-
- ;; This file is NOT a part of GNU Emacs.
-
- ;; 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 of the License, or 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.
-
- ;;; Commentary:
-
- ;; what-char is a small utility that tells the encoded character codes at
- ;; point. It also provides a minor mode to display the character code on
- ;; the mode line.
- ;;
- ;; Main differences from `what-cursor-position' or `describe-char' are:
- ;;
- ;; - Simplified output. Only the character code information is displayed.
- ;; - Coding-system aware. Shows the character code(s) encoded by the
- ;; buffer or specified coding-system(s). It would be helpful in
- ;; identifying multi-byte characters.
- ;;
- ;; To show the character code at point on the echo area:
- ;;
- ;; M-x what-char [RET]
- ;;
- ;; To enable the minor mode:
- ;;
- ;; 1. Modify `mode-line-format' to display `what-char-mode-line-format'
- ;; (or something like that) when `what-char-mode' is non-nil.
- ;; If you are not sure how to configure the mode line format, try
- ;; evaluating the following expression:
- ;;
- ;; (what-char-mode-line-format)
- ;;
- ;; This will append the entry for `what-char-mode' to
- ;; `mode-line-format'. If it does not work properly, your mode line
- ;; format might be too complex and needs to be configured manually.
- ;;
- ;; 2. M-x what-char-mode [RET]
- ;;
- ;; To specify the coding-systems used by `what-char', customize the
- ;; variable `what-char-category-coding-system-alist'.
- ;;
- ;; To specify the coding-system used by `what-char-mode', customize the
- ;; variable `what-char-mode-line-coding-system'.
-
- ;;; Code:
-
- (eval-when-compile
- (require 'cl))
-
- (if (fboundp 'propertize)
- (defalias 'what-char-propertize 'propertize)
- (defsubst what-char-propertize (string &rest properties)
- (set-text-properties 0 (length string) properties string)
- string))
-
- (defgroup what-char nil
- "Display character code at point on the mode line."
- :group 'modeline)
-
- (defcustom what-char-mode-line-format
- (if (< 20 emacs-major-version)
- '(:eval (what-char-propertize
- (concat "[" what-char-current-string "]")
- 'local-map what-char-mode-line-keymap
- 'help-echo '(what-char what-char-current-char -1)))
- '("[" what-char-current-string "]"))
- "*Mode line format for displaying the character code at point.
- See the documentation for `mode-line-format' for details."
- :type 'sexp
- :group 'what-char)
- (put 'what-char-mode-line-format 'risky-local-variable t)
-
- (defcustom what-char-mode-line-coding-system nil
- "*Coding system for encoding the character at point.
- Used to format the character code displayed on the mode line.
-
- If nil, the buffer's coding system `buffer-file-coding-system' is used."
- :type 'coding-system
- :group 'what-char)
-
- (defcustom what-char-category-coding-system-alist
- `((?j . (shift_jis euc-jp))
- (?g . (shift_jis euc-jp))
- (t . ,(append (if (coding-system-p 'utf-8)
- (list 'utf-8))
- (if (coding-system-p 'utf-16-be-no-signature)
- (list 'utf-16-be-no-signature)
- (if (coding-system-p 'utf-16be)
- (list 'utf-16be))))))
- "*Alist of character categories vs. coding systems.
- Used by `what-char' to determine the character encodings.
-
- Each element is a list:
-
- (CHAR-CATEGORY CODING-SYSTEM ...)
-
- CHAR-CATEGORY is a character that represents the character category.
- The value `t' means any category; i.e., it matches any character
- regardless of the actual category set.
-
- CODING-SYSTEM is a coding system (a symbol) for encoding a character
- that belongs to CHAR-CATEGORY. More than one coding can be specified.
-
- The coding selection is cumulative. For example:
-
- (setq what-char-category-coding-system-alist
- '((?j shift_jis) (t utf-8)))
- (what-char ?‚ )
- => \"S:82A0 u:E38182\""
- :group 'what-char
- :type '(repeat (cons (choice :tag "Category" character (const t))
- (repeat coding-system))))
-
- (defcustom what-char-idle-delay
- (if (boundp 'idle-update-delay) idle-update-delay 1)
- "*Delay time in seconds before updating the character information
- such as `what-char-current-string'."
- :type 'number
- :group 'what-char)
-
- (defvar what-char-idle-timer nil
- "Timer started after `what-char-idle-timer' seconds of idle time.")
-
- (defvar what-char-mode nil
- "Non-nil means `what-char-mode' is enabled.")
- (make-variable-buffer-local 'what-char-mode)
-
- (defvar what-char-current-char 0
- "Current character at point.
- Updated only when `what-char-mode' is enabled.")
- (make-variable-buffer-local 'what-char-current-char)
-
- (defvar what-char-current-string "??"
- "String representation of the current character at point encoded
- according to the value of `what-char-mode-line-coding-system'.
- Updated only when `what-char-mode' is enabled.")
- (make-variable-buffer-local 'what-char-current-string)
-
- (defun what-coding-char (char coding)
- (let ((str (encode-coding-string (char-to-string char) coding)))
- (mapconcat (lambda (c) (format "%02X" c)) str "")))
-
- (defun what-char (char &optional arg)
- "Display the character code(s) of CHAR in the echo area.
-
- If called interactively with prefix ARG, also run `describe-char' or
- `describe-char-after'.
- If called noninteractively with non-nil ARG, disable the message
- output but simply return the result string.
-
- The coding systems used to encode CHAR are taken from the buffer's
- coding system `buffer-file-coding-system' and the variable
- `what-char-category-coding-system-alist'."
- (interactive (list (or (following-char)
- (error "No character at point"))
- current-prefix-arg))
- (let ((category (char-category-set char))
- (eol (coding-system-eol-type buffer-file-coding-system))
- codings chars)
- (dolist (elem what-char-category-coding-system-alist)
- (if (or (eq t (car elem))
- (aref category (car elem)))
- (dolist (cs (cdr elem))
- (when (coding-system-p cs)
- (setq cs (coding-system-change-eol-conversion cs eol))
- (or (coding-system-equal cs buffer-file-coding-system)
- (memq cs codings)
- (setq codings (cons cs codings)))))))
- (setq codings (cons buffer-file-coding-system
- (sort codings 'coding-system-lessp)))
- (dolist (cs codings)
- ;; the mnemonic characters for utf-8 and utf-16 are both "u". is it
- ;; necessary to make coding-system prefixes customizable...?
- (setq chars (cons (concat (char-to-string (coding-system-mnemonic cs))
- ":" (what-coding-char char cs))
- chars)))
- (setq chars (concat "\""
- (case char
- (?\n (case eol
- (1 "\\r\\n") (2 "\\r") (t "\\n")))
- (?\t "\\t")
- (t (char-to-string char)))
- "\" "
- (mapconcat 'identity (nreverse chars) " ")))
- (if arg
- (when (interactive-p)
- (if (fboundp 'describe-char)
- (describe-char (point))
- (describe-char-after))
- (message "%s" chars))
- (message "%s" chars))
- chars))
-
- (defun what-char-update ()
- (when what-char-mode
- (let ((char (following-char)))
- (unless (eq what-char-current-char char)
- (setq what-char-current-char char)
- (setq what-char-current-string
- (what-coding-char char (or what-char-mode-line-coding-system
- buffer-file-coding-system)))
- (force-mode-line-update)))))
-
- (defun what-char-mode (&optional arg)
- "Toggle `what-char-mode'.
-
- With prefix ARG, turn `what-char-mode' on if ARG is positive or off
- otherwise."
- (interactive "P")
- (if what-char-idle-timer
- (cancel-timer what-char-idle-timer))
- (setq what-char-mode
- (if arg (< 0 (prefix-numeric-value arg))
- (not what-char-mode)))
- (setq what-char-idle-timer
- (if what-char-mode
- (run-with-idle-timer what-char-idle-delay t 'what-char-update)))
- (force-mode-line-update)
- (if (interactive-p)
- (message "what-char-mode is %s" (if what-char-mode "on" "off"))))
-
- (defun what-char-mouse-show (event)
- "Show the current character codes in response to a mouse event.
- See also `what-char'."
- (interactive "@e")
- (or what-char-current-char
- (what-char-update))
- (what-char what-char-current-char 1))
-
- (defun what-char-add-to-mode-line (&optional buffer)
- "Add an entry for `what-char-mode' to `mode-line-format'.
-
- If BUFFER is given, only the value for that buffer is modified.
- Otherwise the default value is modified using `setq-default'.
-
- This function may fail if `mode-line-format' is too complex."
- (interactive)
- (let ((elem '(what-char-mode ("" what-char-mode-line-format " ")))
- format)
- (cond ((stringp mode-line-format)
- (setq format (list elem mode-line-format)))
- ((listp mode-line-format)
- (setq format (reverse mode-line-format))
- (let ((sep (member "-%-" format)))
- (if sep
- (setcdr sep (cons elem (cdr sep)))
- (setq format (cons elem format)))
- (setq format (nreverse format))))
- (t
- (error "Unsupported form of `mode-line-format'")))
- (if buffer
- (with-current-buffer buffer
- (setq mode-line-format format))
- (setq-default mode-line-format format))
- (force-mode-line-update)))
-
- (defvar what-char-mode-line-keymap
- (let ((parent-map (make-sparse-keymap))
- (child-map (make-sparse-keymap)))
- (define-key child-map [mouse-2] 'what-char-mouse-show)
- (define-key parent-map [mode-line] child-map)
- parent-map))
-
- (if (boundp 'mode-line-mode-menu)
- (define-key mode-line-mode-menu [what-char-mode]
- '(menu-item "What Character Code" what-char-mode
- :button (:toggle . what-char-mode))))
-
- (provide 'what-char)
-
- ;;; what-char.el ends here