-;;; mule-diag.el --- Show diagnosis of multilingual environment (Mule)
+;;; mule-diag.el --- show diagnosis of multilingual environment (Mule)
;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
;; Licensed to the Free Software Foundation.
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
+;;; Commentary:
+
+;;; Code:
+
;;; General utility function
;; Print all arguments with single space separator in one line.
(list-character-sets-1 sort-key)
(help-setup-xref (list #'list-character-sets nil) t)))))
+(defun charset-multibyte-form-string (charset)
+ (let ((info (charset-info charset)))
+ (cond ((eq charset 'ascii)
+ "xx")
+ ((eq charset 'eight-bit-control)
+ (format "%2X Xx" (aref info 6)))
+ ((eq charset 'eight-bit-graphic)
+ "XX")
+ (t
+ (let ((str (format "%2X" (aref info 6))))
+ (if (> (aref info 7) 0)
+ (setq str (format "%s %2X"
+ str (aref info 7))))
+ (setq str (concat str " XX"))
+ (if (> (aref info 2) 1)
+ (setq str (concat str " XX")))
+ str)))))
+
;; Insert a list of character sets sorted by SORT-KEY. SORT-KEY
;; should be one of `id', `name', and `iso-spec'. If SORT-KEY is nil,
;; it defaults to `id'.
(setq charset-info-list
(cons (list (charset-id charset) ; ID-NUM
charset ; CHARSET-NAME
- (cond ((eq charset 'ascii) ; MULTIBYTE-FORM
- "xx")
- ((eq charset 'eight-bit-control)
- (format "%2X Xx" (aref info 6)))
- ((eq charset 'eight-bit-graphic)
- "XX")
- (t
- (let ((str (format "%2X" (aref info 6))))
- (if (> (aref info 7) 0)
- (setq str (format "%s %2X"
- str (aref info 7))))
- (setq str (concat str " XX"))
- (if (> (aref info 2) 1)
- (setq str (concat str " XX")))
- str)))
+ (charset-multibyte-form-string charset); MULTIBYTE-FORM
(aref info 2) ; DIMENSION
(aref info 3) ; CHARS
(aref info 8) ; FINAL-CHAR
charset)
(while l
(setq charset (car l) l (cdr l))
- (princ (format "%03d:%s:%d:%d:%d:%d:%d:%d:%d:%s\n"
+ (princ (format "%03d:%s:%d:%d:%d:%d:%d:%d:%d:%s\n"
(charset-id charset)
charset
(charset-dimension charset)
CHARSET-LIST is a list of Emacs' charsets into which characters of
NON-ISO-CHARSET are mapped.
-TRANSLATION-METHOD is a translatin table (symbol) to translate a
+TRANSLATION-METHOD is a translation table (symbol) to translate a
character code of NON-ISO-CHARSET to the corresponding Emacs character
code. It can also be a function to call with one argument, a
character code in NON-ISO-CHARSET.
default-value)))
(if (> (length charset) 0)
(intern charset))))
-
+
;; List characters of the range MIN and MAX of CHARSET. If dimension
;; of CHARSET is two (i.e. 2-byte charset), ROW is the first byte
(if (= dim 1)
(list-block-of-chars charset 0 min max)
(let ((i min))
- (while (< i max)
+ (while (<= i max)
(list-block-of-chars charset i min max)
(setq i (1+ i)))))))
(while row-range
(setq row (car row-range) row-max (nth 1 row-range)
row-range (nthcdr 2 row-range))
- (while (< row row-max)
+ (while (<= row row-max)
(setq col-range (cdr range))
(while col-range
(setq col (car col-range) col-max (nth 1 col-range)
(error "Invalid charset %s" charset))))))
+;;;###autoload
+(defun describe-character-set (charset)
+ "Display information about character set CHARSET."
+ (interactive (list (let ((non-iso-charset-alist nil))
+ (read-charset "Charset: "))))
+ (or (charsetp charset)
+ (error "Invalid charset: %S" charset))
+ (let ((info (charset-info charset)))
+ (with-output-to-temp-buffer "*Help*"
+ (save-excursion
+ (set-buffer standard-output)
+ (insert "Character set: " (symbol-name charset)
+ (format " (ID:%d)\n\n" (aref info 0)))
+ (insert (aref info 13) "\n\n") ; description
+ (insert "number of contained characters: "
+ (if (= (aref info 2) 1)
+ (format "%d\n" (aref info 3))
+ (format "%dx%d\n" (aref info 3) (aref info 3))))
+ (insert "the final char of ISO2022's designation sequence: ")
+ (if (>= (aref info 8) 0)
+ (insert (format "`%c'\n" (aref info 8)))
+ (insert "not assigned\n"))
+ (insert (format "width (how many columns on screen): %d\n"
+ (aref info 4)))
+ (insert (format "internal multibyte sequence: %s\n"
+ (charset-multibyte-form-string charset)))
+ (let ((coding (plist-get (aref info 14) 'preferred-coding-system)))
+ (when coding
+ (insert (format "preferred coding system: %s\n" coding))
+ (search-backward (symbol-name coding))
+ (help-xref-button 0 #'describe-coding-system coding
+ "mouse-2, RET: describe this coding system")))
+ (help-setup-xref (list #'describe-character-set charset)
+ (interactive-p))
+ ))))
+
;;;###autoload
(defun describe-char-after (&optional pos)
- "Display information of in current buffer at position POS.
+ "Display information about the character at POS in the current buffer.
+POS defaults to point.
The information includes character code, charset and code points in it,
syntax, category, how the character is encoded in a file,
which font is being used for displaying the character."
(composition (find-composition (point) nil nil t))
(composed (if composition (buffer-substring (car composition)
(nth 1 composition))))
+ (multibyte-p enable-multibyte-characters)
item-list max-width)
(if (eq charset 'unknown)
(setq item-list
(with-output-to-temp-buffer "*Help*"
(save-excursion
(set-buffer standard-output)
+ (set-buffer-multibyte multibyte-p)
(let ((formatter (format "%%%ds:" max-width)))
(dolist (elt item-list)
(insert (format formatter (car elt)))
(insert " " clm))
(insert "\n")))
(when composition
- (insert "\nComposed with the following characerter(s) "
+ (insert "\nComposed with the following character(s) "
(mapconcat (lambda (x) (format "`%c'" x))
(substring composed 1)
", ")
(car charset)
(charset-description (car charset)))))
(t
- "invalid designation information"))
+ "invalid designation information"))
(setq charset (cdr charset))))
(setq graphic-register (1+ graphic-register)))))
(t (princ "invalid\n")))))
(let ((postread (coding-system-get coding-system 'post-read-conversion)))
(when postread
- (princ "After decoding a text normally,")
- (princ " perform post-conversion by the function: ")
+ (princ "After decoding text normally,")
+ (princ " perform post-conversion using the function: ")
(princ "\n ")
(princ postread)
(princ "\n")))
(let ((prewrite (coding-system-get coding-system 'pre-write-conversion)))
(when prewrite
- (princ "Before encoding a text normally,")
- (princ " perform pre-conversion by the function: ")
+ (princ "Before encoding text normally,")
+ (princ " perform pre-conversion using the function: ")
(princ "\n ")
(princ prewrite)
(princ "\n")))
- (let ((charsets (coding-system-get coding-system 'safe-charsets)))
- (when charsets
- (if (eq charsets t)
- (princ "This coding system can encode all charsets.\n")
- (princ "This coding system encode the following charsets:\n")
- (princ " ")
- (while charsets
- (princ " ")
- (princ (car charsets))
- (setq charsets (cdr charsets))))))
(save-excursion
(set-buffer standard-output)
- (help-mode)))))
+ (let ((charsets (coding-system-get coding-system 'safe-charsets)))
+ (when (and (not (memq (coding-system-base coding-system)
+ '(raw-text emacs-mule)))
+ charsets)
+ (if (eq charsets t)
+ (insert "This coding system can encode all charsets except for
+eight-bit-control and eight-bit-graphic.\n")
+ (insert "This coding system encodes the following charsets:\n ")
+ (while charsets
+ (insert " " (symbol-name (car charsets)))
+ (search-backward (symbol-name (car charsets)))
+ (help-xref-button 0 #'describe-character-set (car charsets))
+ (goto-char (point-max))
+ (setq charsets (cdr charsets))))))
+ (help-setup-xref (list #'describe-coding-system coding-system)
+ (interactive-p))))))
+
;;;###autoload
(defun describe-current-coding-system-briefly ()
The format is \"F[..],K[..],T[..],P>[..],P<[..], default F[..],P<[..],P<[..]\",
where mnemonics of the following coding systems come in this order
at the place of `..':
- `buffer-file-coding-system` (of the current buffer)
- eol-type of buffer-file-coding-system (of the current buffer)
+ `buffer-file-coding-system' (of the current buffer)
+ eol-type of `buffer-file-coding-system' (of the current buffer)
Value returned by `keyboard-coding-system'
- eol-type of (keyboard-coding-system)
- Value returned by `terminal-coding-system.
- eol-type of (terminal-coding-system)
+ eol-type of `keyboard-coding-system'
+ Value returned by `terminal-coding-system'.
+ eol-type of `terminal-coding-system'
`process-coding-system' for read (of the current buffer, if any)
- eol-type of process-coding-system for read (of the current buffer, if any)
+ eol-type of `process-coding-system' for read (of the current buffer, if any)
`process-coding-system' for write (of the current buffer, if any)
- eol-type of process-coding-system for write (of the current buffer, if any)
+ eol-type of `process-coding-system' for write (of the current buffer, if any)
`default-buffer-file-coding-system'
- eol-type of default-buffer-file-coding-system
+ eol-type of `default-buffer-file-coding-system'
`default-process-coding-system' for read
- eol-type of default-process-coding-system for read
+ eol-type of `default-process-coding-system' for read
`default-process-coding-system' for write
- eol-type of default-process-coding-system"
+ eol-type of `default-process-coding-system'"
(interactive)
(let* ((proc (get-buffer-process (current-buffer)))
(process-coding-systems (if proc (process-coding-system proc))))
(beginning-of-line)
(insert "Fontset: " fontset "\n")
(insert "CHARSET or CHAR RANGE")
- (indent-to 25)
+ (indent-to 24)
(insert "FONT NAME\n")
(insert "---------------------")
- (indent-to 25)
+ (indent-to 24)
(insert "---------")
(insert "\n")
(while tail
(make-char charset (nth 1 split)
(if (= (charset-chars charset) 94) 126 127))))
(insert to))))
- (indent-to 25)
+ (indent-to 24)
(if (stringp font-spec)
(insert font-spec)
(if (car font-spec)
(interactive
(if (not (and window-system (fboundp 'fontset-list)))
(error "No fontsets being used")
- (let ((fontset-list (append
+ (let ((fontset-list (nconc
(mapcar 'list (fontset-list))
(mapcar (lambda (x) (list (cdr x)))
fontset-alias-alist)))
(insert-section 1 "General Information")
(insert "Version of this emacs:\n " (emacs-version) "\n\n")
+ (insert "Configuration options:\n " system-configuration-options "\n\n")
+ (insert "Multibyte characters awareness:\n"
+ (format " default: %S\n" default-enable-multibyte-characters)
+ (format " current-buffer: %S\n\n" enable-multibyte-characters))
+ (insert "Current language environment: " current-language-environment
+ "\n\n")
(insert-section 2 "Display")
(if window-system