;;; mule-diag.el --- show diagnosis of multilingual environment (Mule)
-;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
-;; Licensed to the Free Software Foundation.
-;; Copyright (C) 2001, 2002 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1998, 2000, 2001, 2002, 2003
+;; Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1997, 1999, 2000, 2001, 2002, 2003
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H14PRO021
;; Keywords: multilingual, charset, coding system, fontset, diagnosis, i18n
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
'help-function #'list-charset-chars
'help-echo "mouse-2, RET: show table of characters for this character set")
+;;;###autoload
+(defvar non-iso-charset-alist
+ `((mac-roman
+ (ascii latin-iso8859-1 mule-unicode-2500-33ff
+ mule-unicode-0100-24ff mule-unicode-e000-ffff)
+ mac-roman-decoder
+ ((0 255)))
+ (viscii
+ (ascii vietnamese-viscii-lower vietnamese-viscii-upper)
+ viet-viscii-nonascii-translation-table
+ ((0 255)))
+ (vietnamese-tcvn
+ (ascii vietnamese-viscii-lower vietnamese-viscii-upper)
+ viet-tcvn-nonascii-translation-table
+ ((0 255)))
+ (koi8-r
+ (ascii cyrillic-iso8859-5)
+ cyrillic-koi8-r-nonascii-translation-table
+ ((32 255)))
+ (alternativnyj
+ (ascii cyrillic-iso8859-5)
+ cyrillic-alternativnyj-nonascii-translation-table
+ ((32 255)))
+ (koi8-u
+ (ascii cyrillic-iso8859-5 mule-unicode-0100-24ff)
+ cyrillic-koi8-u-nonascii-translation-table
+ ((32 255)))
+ (big5
+ (ascii chinese-big5-1 chinese-big5-2)
+ decode-big5-char
+ ((32 127)
+ ((?\xA1 ?\xFE) . (?\x40 ?\x7E ?\xA1 ?\xFE))))
+ (sjis
+ (ascii katakana-jisx0201 japanese-jisx0208)
+ decode-sjis-char
+ ((32 127 ?\xA1 ?\xDF)
+ ((?\x81 ?\x9F ?\xE0 ?\xEF) . (?\x40 ?\x7E ?\x80 ?\xFC)))))
+ "Alist of charset names vs the corresponding information.
+This is mis-named for historical reasons. The charsets are actually
+non-built-in ones. They correspond to Emacs coding systems, not Emacs
+charsets, i.e. what Emacs can read (or write) by mapping to (or
+from) Emacs internal charsets that typically correspond to a limited
+set of ISO charsets.
+
+Each element has the following format:
+ (CHARSET CHARSET-LIST TRANSLATION-METHOD [ CODE-RANGE ])
+
+CHARSET is the name (symbol) of the charset.
+
+CHARSET-LIST is a list of Emacs charsets into which characters of
+CHARSET are mapped.
+
+TRANSLATION-METHOD is a translation table (symbol) to translate a
+character code of CHARSET to the corresponding Emacs character
+code. It can also be a function to call with one argument, a
+character code in CHARSET.
+
+CODE-RANGE specifies the valid code ranges of CHARSET.
+It is a list of RANGEs, where each RANGE is of the form:
+ (FROM1 TO1 FROM2 TO2 ...)
+or
+ ((FROM1-1 TO1-1 FROM1-2 TO1-2 ...) . (FROM2-1 TO2-1 FROM2-2 TO2-2 ...))
+In the first form, valid codes are between FROM1 and TO1, or FROM2 and
+TO2, or...
+The second form is used for 2-byte codes. The car part is the ranges
+of the first byte, and the cdr part is the ranges of the second byte.")
;;;###autoload
(defun list-character-sets (arg)
(charset-iso-graphic-plane charset)
(charset-description charset))))))
-(defvar non-iso-charset-alist
- `((mac-roman
- (ascii latin-iso8859-1 mule-unicode-2500-33ff
- mule-unicode-0100-24ff mule-unicode-e000-ffff)
- mac-roman-decoder
- ((0 255)))
- (viscii
- (ascii vietnamese-viscii-lower vietnamese-viscii-upper)
- viet-viscii-nonascii-translation-table
- ((0 255)))
- (koi8-r
- (ascii cyrillic-iso8859-5)
- cyrillic-koi8-r-nonascii-translation-table
- ((32 255)))
- (alternativnyj
- (ascii cyrillic-iso8859-5)
- cyrillic-alternativnyj-nonascii-translation-table
- ((32 255)))
- (big5
- (ascii chinese-big5-1 chinese-big5-2)
- decode-big5-char
- ((32 127)
- ((?\xA1 ?\xFE) . (?\x40 ?\x7E ?\xA1 ?\xFE))))
- (sjis
- (ascii katakana-jisx0201 japanese-jisx0208)
- decode-sjis-char
- ((32 127 ?\xA1 ?\xDF)
- ((?\x81 ?\x9F ?\xE0 ?\xEF) . (?\x40 ?\x7E ?\x80 ?\xFC)))))
- "Alist of charset names vs the corresponding information.
-This is mis-named for historical reasons. The charsets are actually
-non-built-in ones. They correspond to Emacs coding systems, not Emacs
-charsets, i.e. what Emacs can read (or write) by mapping to (or
-from) Emacs internal charsets that typically correspond to a limited
-set of ISO charsets.
-
-Each element has the following format:
- (CHARSET CHARSET-LIST TRANSLATION-METHOD [ CODE-RANGE ])
-
-CHARSET is the name (symbol) of the charset.
-
-CHARSET-LIST is a list of Emacs charsets into which characters of
-CHARSET are mapped.
-
-TRANSLATION-METHOD is a translation table (symbol) to translate a
-character code of CHARSET to the corresponding Emacs character
-code. It can also be a function to call with one argument, a
-character code in CHARSET.
-
-CODE-RANGE specifies the valid code ranges of CHARSET.
-It is a list of RANGEs, where each RANGE is of the form:
- (FROM1 TO1 FROM2 TO2 ...)
-or
- ((FROM1-1 TO1-1 FROM1-2 TO1-2 ...) . (FROM2-1 TO2-1 FROM2-2 TO2-2 ...))
-In the first form, valid codes are between FROM1 and TO1, or FROM2 and
-TO2, or...
-The second form is used for 2-byte codes. The car part is the ranges
-of the first byte, and the cdr part is the ranges of the second byte.")
-
-
(defun decode-codepage-char (codepage code)
"Decode a character that has code CODE in CODEPAGE.
Return a decoded character string. Each CODEPAGE corresponds to a
(string-to-char
(decode-coding-string (char-to-string code) coding-system))))
-
-;; Add DOS codepages to `non-iso-charset-alist'.
-
-(let ((tail (cp-supported-codepages))
- elt)
- (while tail
- (setq elt (car tail) tail (cdr tail))
- ;; Now ELT is (CODEPAGE . CHARSET), where CODEPAGE is a string
- ;; (e.g. "850"), CHARSET is a charset that characters in CODEPAGE
- ;; are mapped to.
- (unless (assq (intern (concat "cp" (car elt))) non-iso-charset-alist)
- (setq non-iso-charset-alist
- (cons (list (intern (concat "cp" (car elt)))
- (list 'ascii (cdr elt))
- `(lambda (code)
- (decode-codepage-char ,(string-to-int (car elt))
- code))
- (list (list 0 255)))
- non-iso-charset-alist)))))
-
-
;; A variable to hold charset input history.
(defvar charset-history nil)
charset (charset-description charset)))
((listp charset)
(if (charsetp (car charset))
- (format "%s:%s, and also used by the followings:"
+ (format "%s:%s, and also used by the following:"
(car charset)
(charset-description (car charset)))
- "no initial designation, and used by the followings:"))
+ "no initial designation, and used by the following:"))
(t
"invalid designation information"))))
(when (listp charset)
;;;###autoload
(defun describe-coding-system (coding-system)
"Display information about CODING-SYSTEM."
- (interactive "zDescribe coding system (default, current choices): ")
+ (interactive "zDescribe coding system (default current choices): ")
(if (null coding-system)
(describe-current-coding-system)
(help-setup-xref (list #'describe-coding-system coding-system)
(with-output-to-temp-buffer (help-buffer)
(print-coding-system-briefly coding-system 'doc-string)
(princ "\n")
+ (let ((vars (coding-system-get coding-system 'dependency)))
+ (when vars
+ (princ "See also the documentation of these customizable variables
+which alter the behavior of this coding system.\n")
+ (dolist (v vars)
+ (princ " `")
+ (princ v)
+ (princ "'\n"))
+ (princ "\n")))
+
(princ "Type: ")
(let ((type (coding-system-type coding-system))
(flags (coding-system-flags coding-system)))
)))
;; Print symbol name and mnemonic letter of CODING-SYSTEM with `princ'.
+;; If DOC-STRING is non-nil, print also the docstring of CODING-SYSTEM.
+;; If DOC-STRING is `tightly', don't print an empty line before the
+;; docstring, and print only the first line of the docstring.
+
(defun print-coding-system-briefly (coding-system &optional doc-string)
(if (not coding-system)
(princ "nil\n")
(not (eq coding-system (aref base-eol-type eol-type))))
(princ (format " (alias of %s)"
(aref base-eol-type eol-type))))))))
- (princ "\n\n")
- (if (and doc-string
- (setq doc-string (coding-system-doc-string coding-system)))
- (princ (format "%s\n" doc-string)))))
+ (princ "\n")
+ (or (eq doc-string 'tightly)
+ (princ "\n"))
+ (if doc-string
+ (let ((doc (or (coding-system-doc-string coding-system) "")))
+ (when (eq doc-string 'tightly)
+ (if (string-match "\n" doc)
+ (setq doc (substring doc 0 (match-beginning 0))))
+ (setq doc (concat " " doc)))
+ (princ (format "%s\n" doc))))))
;;;###autoload
(defun describe-current-coding-system ()
(setq codings (cons x codings))))
(get (car categories) 'coding-systems))
(if codings
- (let ((max-col (frame-width))
+ (let ((max-col (window-width))
pos)
(princ (format "\
The following are decoded correctly but recognized as %s:\n "
###############################################
# List of coding systems in the following format:
# MNEMONIC-LETTER -- CODING-SYSTEM-NAME
-# DOC-STRING
+# DOC-STRING
")
(princ "\
#########################
## EOL = 0 (LF), 1 (CRLF), 2 (CR), or 3 (Automatic detection)
## FLAGS =
## if TYPE = 2 then
-## comma (`,') separated data of the followings:
+## comma (`,') separated data of the following:
## G0, G1, G2, G3, SHORT-FORM, ASCII-EOL, ASCII-CNTL, SEVEN,
## LOCKING-SHIFT, SINGLE-SHIFT, USE-ROMAN, USE-OLDJIS, NO-ISO6429
## else if TYPE = 4 then
## POST-READ-CONVERSION, PRE-WRITE-CONVERSION = function name to be called
##
"))
- (let ((bases (coding-system-list 'base-only))
- coding-system)
- (while bases
- (setq coding-system (car bases))
- (if (null arg)
- (print-coding-system-briefly coding-system 'doc-string)
- (print-coding-system coding-system))
- (setq bases (cdr bases)))))
+ (dolist (coding-system (sort-coding-systems (coding-system-list 'base-only)))
+ (if (null arg)
+ (print-coding-system-briefly coding-system 'tightly)
+ (print-coding-system coding-system)))
+ (let ((first t))
+ (dolist (elt coding-system-alist)
+ (unless (memq (intern (car elt)) coding-system-list)
+ (when first
+ (princ "\
+####################################################
+# The following coding systems are not yet loaded. #
+####################################################
+")
+ (setq first nil))
+ (princ-list (car elt))))))
;;;###autoload
(defun list-coding-categories ()
;;;###autoload
(defun describe-font (fontname)
"Display information about fonts which partially match FONTNAME."
- (interactive "sFontname (default, current choice for ASCII chars): ")
+ (interactive "sFontname (default current choice for ASCII chars): ")
(or (and window-system (fboundp 'fontset-list))
(error "No fontsets being used"))
(when (or (not fontname) (= (length fontname) 0))
(defun print-fontset (fontset &optional print-fonts)
"Print information about FONTSET.
+If FONTSET is nil, print information about the default fontset.
If optional arg PRINT-FONTS is non-nil, also print names of all opened
fonts for FONTSET. This function actually inserts the information in
the current buffer."
+ (or fontset
+ (setq fontset (query-fontset "fontset-default")))
(let ((tail (aref (fontset-info fontset) 2))
elt chars font-spec opened prev-charset charset from to)
(beginning-of-line)
(mapcar 'cdr fontset-alias-alist)))
(completion-ignore-case t))
(list (completing-read
- "Fontset (default, used by the current frame): "
+ "Fontset (default used by the current frame): "
fontset-list nil t)))))
(if (= (length fontset) 0)
- (setq fontset (cdr (assq 'font (frame-parameters)))))
- (if (not (setq fontset (query-fontset fontset)))
- (error "Current frame is using font, not fontset"))
+ (setq fontset (frame-parameter nil 'font)))
+ (setq fontset (query-fontset fontset))
(help-setup-xref (list #'describe-fontset fontset) (interactive-p))
(with-output-to-temp-buffer (help-buffer)
(with-current-buffer standard-output
(goto-char (point-min))
(while (re-search-forward
"^ \\([^ ]+\\) (`.*' in mode line)$" nil t)
- (help-xref-button 1 #'help-input-method
- (match-string 1)
- "mouse-2: describe this method"))))))
+ (help-xref-button 1 'help-input-method (match-string 1)))))))
(defun list-input-methods-1 ()
(if (not input-method-alist)
(setq fontsets (cdr fontsets)))))
(print-help-return-message))))
+(provide 'mule-diag)
+
+;;; arch-tag: cd3b607c-2893-45a0-a4fa-a6535754dbee
;;; mule-diag.el ends here