changeset 88534:27fb0f57ffe3

Doc fixes. (sort-charset-list, charset-multibyte-form-string): Removed. (list-character-sets, list-character-sets-1) (list-character-sets-2): Re-written. (non-iso-charset-alist): Set to nil and made obsolete. (decode-codepage-char): Re-written and made obsolete. (read-charset, describe-character-set): Don't use non-iso-charset-alist. (describe-coding-system): Use keyword properties.

--- a/lisp/international/mule-diag.el	Thu May 16 19:12:52 2002 +0000
+++ b/lisp/international/mule-diag.el	Thu May 16 19:23:55 2002 +0000
@@ -35,8 +35,8 @@
 
 ;;; General utility function
 
-;; Print all arguments with single space separator in one line.
 (defun print-list (&rest args)
+  "Print all arguments with single space separator in one line."
   (while (cdr args)
     (when (car args)
       (princ (car args))
@@ -45,12 +45,6 @@
   (princ (car args))
   (princ "\n"))
 
-;; Re-order the elements of charset-list.
-(defun sort-charset-list ()
-  (setq charset-list
-	(sort charset-list
-	      (function (lambda (x y) (< (charset-id x) (charset-id y)))))))
-
 ;;; CHARSET
 
 (define-button-type 'sort-listed-character-sets
@@ -98,15 +92,13 @@
 		  (if (display-mouse-p) "\\[help-follow-mouse] or ")
 		  "\\[help-follow]:\n")))
 	(insert "  on a column title to sort by that title,")
-	(indent-to 56)
+	(indent-to 48)
 	(insert "+----DIMENSION\n")
 	(insert "  on a charset name to list characters.")
-	(indent-to 56)
+	(indent-to 48)
 	(insert "| +--CHARS\n")
-	(let ((columns '(("ID-NUM" . id) "\t"
-			 ("CHARSET-NAME" . name) "\t\t\t"
-			 ("MULTIBYTE-FORM" . id) "\t"
-			 ("D CH FINAL-CHAR" . iso-spec)))
+	(let ((columns '(("CHARSET-NAME" . name) "\t\t\t\t\t"
+			 ("D CH  FINAL-CHAR" . iso-spec)))
 	      pos)
 	  (while columns
 	    (if (stringp (car columns))
@@ -117,10 +109,10 @@
 	      (goto-char (point-max)))
 	    (setq columns (cdr columns)))
 	  (insert "\n"))
-	(insert "------\t------------\t\t\t--------------\t- -- ----------\n")
+	(insert "------------\t\t\t\t\t- --- ----------\n")
 
 	;; Insert body sorted by charset IDs.
-	(list-character-sets-1 'id)))))
+	(list-character-sets-1 'name)))))
 
 (defun sort-listed-character-sets (sort-key)
   (if sort-key
@@ -133,65 +125,35 @@
 	  (delete-region (point) (point-max))
 	  (list-character-sets-1 sort-key)))))
 
-(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'.
-
 (defun list-character-sets-1 (sort-key)
+  "Insert a list of character sets sorted by SORT-KEY.
+SORT-KEY should be `name' or `iso-spec' (default `name')."
   (or sort-key
-      (setq sort-key 'id))
-  (let ((tail (charset-list))
-	charset-info-list elt charset info sort-func)
-    (while tail
-      (setq charset (car tail) tail (cdr tail)
-	    info (charset-info charset))
-
+      (setq sort-key 'name))
+  (let ((tail charset-list)
+	charset-info-list charset sort-func)
+    (dolist (charset charset-list)
       ;; Generate a list that contains all information to display.
-      (setq charset-info-list
-	    (cons (list (charset-id charset)	; ID-NUM
-			charset			; CHARSET-NAME
-			(charset-multibyte-form-string charset); MULTIBYTE-FORM
-			(aref info 2)		; DIMENSION
-			(aref info 3)		; CHARS
-			(aref info 8)		; FINAL-CHAR
-			)
-		  charset-info-list)))
+      (push (list charset
+		  (charset-dimension charset)
+		  (charset-chars charset)
+		  (charset-iso-final-char charset))
+	    charset-info-list))
 
     ;; Determine a predicate for `sort' by SORT-KEY.
     (setq sort-func
-	  (cond ((eq sort-key 'id)
-		 (function (lambda (x y) (< (car x) (car y)))))
-
-		((eq sort-key 'name)
-		 (function (lambda (x y) (string< (nth 1 x) (nth 1 y)))))
+	  (cond ((eq sort-key 'name)
+		 (lambda (x y) (string< (car x) (car y))))
 
 		((eq sort-key 'iso-spec)
 		 ;; Sort by DIMENSION CHARS FINAL-CHAR
 		 (function
 		  (lambda (x y)
-		    (or (< (nth 3 x) (nth 3 y))
-			(and (= (nth 3 x) (nth 3 y))
-			     (or (< (nth 4 x) (nth 4 y))
-				 (and (= (nth 4 x) (nth 4 y))
-				      (< (nth 5 x) (nth 5 y)))))))))
+		    (or (< (nth 1 x) (nth 1 y))
+			(and (= (nth 1 x) (nth 1 y))
+			     (or (< (nth 2 x) (nth 2 y))
+				 (and (= (nth 2 x) (nth 2 y))
+				      (< (nth 3 x) (nth 3 y)))))))))
 		(t
 		 (error "Invalid charset sort key: %s" sort-key))))
 
@@ -201,18 +163,18 @@
     (while charset-info-list
       (setq elt (car charset-info-list)
 	    charset-info-list (cdr charset-info-list))
-      (insert (format "%03d(%02X)" (car elt) (car elt))) ; ID-NUM
-      (indent-to 8)
-      (insert-text-button (symbol-name (nth 1 elt))
+      (insert-text-button (symbol-name (car elt))
 			  :type 'list-charset-chars
-			  'help-args (list (nth 1 elt)))
+			  'help-args (list (car elt)))
       (goto-char (point-max))
       (insert "\t")
-      (indent-to 40)
-      (insert (nth 2 elt))		; MULTIBYTE-FORM
-      (indent-to 56)
-      (insert (format "%d %2d " (nth 3 elt) (nth 4 elt)) ; DIMENSION and CHARS
-	      (if (< (nth 5 elt) 0) "none" (nth 5 elt))) ; FINAL-CHAR
+      ;;       (indent-to 40)
+      ;;       (insert (nth 2 elt))		; MULTIBYTE-FORM
+      (indent-to 48)
+      (insert (format "%d %3d " (nth 1 elt) (nth 2 elt)) ; DIMENSION and CHARS
+	      (if (< (nth 3 elt) 0)
+		  "none"
+		(nth 3 elt)))		; FINAL-CHAR
       (insert "\n"))))
 
 
@@ -224,11 +186,9 @@
 ## Each line corresponds to one charset.
 ## The following attributes are listed in this order
 ## separated by a colon `:' in one line.
-##	CHARSET-ID,
 ##	CHARSET-SYMBOL-NAME,
 ##	DIMENSION (1 or 2)
 ##	CHARS (94 or 96)
-##	BYTES (of multibyte form: 1, 2, 3, or 4),
 ##	WIDTH (occupied column numbers: 1 or 2),
 ##	DIRECTION (0:left-to-right, 1:right-to-left),
 ##	ISO-FINAL-CHAR (character code of ISO-2022's final character)
@@ -239,106 +199,27 @@
 	charset)
     (while l
       (setq charset (car l) l (cdr l))
-      (princ (format "%03d:%s:%d:%d:%d:%d:%d:%d:%d:%s\n"
-		     (charset-id charset)
+      (princ (format "%s:%d:%d:%d:%d:%s\n"
 		     charset
 		     (charset-dimension charset)
 		     (charset-chars charset)
 		     (charset-bytes charset)
-		     (charset-width charset)
-		     (charset-direction charset)
+		     (aref char-width-table (make-char charset))
+;;; 		     (charset-direction charset)
 		     (charset-iso-final-char charset)
-		     (charset-iso-graphic-plane charset)
+;;;		     (charset-iso-graphic-plane charset)
 		     (charset-description charset))))))
 
-(defvar non-iso-charset-alist
-  `((mac-roman
-     nil
-     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.")
-
+(defvar non-iso-charset-alist nil
+  "Obsolete.")
+(make-obsolete-variable 'non-iso-charset-alist "no longer relevant" "22.1")
 
 (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
-coding system cpCODEPAGE."
-  (let ((coding-system (intern (format "cp%d" codepage))))
-    (or (coding-system-p coding-system)
-	(codepage-setup codepage))
-    (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)))))
-
+coding system cpCODEPAGE.  This function is obsolete."
+  (decode-char (intern (format "cp%d" codepage)) code))
+(make-obsolete 'decode-codepage-char 'decode-char "22.1")
 
 ;; A variable to hold charset input history.
 (defvar charset-history nil)
@@ -347,20 +228,14 @@
 ;;;###autoload
 (defun read-charset (prompt &optional default-value initial-input)
   "Read a character set from the minibuffer, prompting with string PROMPT.
-It must be an Emacs character set listed in the variable `charset-list'
-or a non-ISO character set listed in the variable
-`non-iso-charset-alist'.
+It must be an Emacs character set listed in the variable `charset-list'.
 
 Optional arguments are DEFAULT-VALUE and INITIAL-INPUT.
 DEFAULT-VALUE, if non-nil, is the default value.
 INITIAL-INPUT, if non-nil, is a string inserted in the minibuffer initially.
 See the documentation of the function `completing-read' for the
 detailed meanings of these arguments."
-  (let* ((table (append (mapcar (function (lambda (x) (list (symbol-name x))))
-				charset-list)
-			(mapcar (function (lambda (x)
-					    (list (symbol-name (car x)))))
-				non-iso-charset-alist)))
+  (let* ((table (mapcar (lambda (x) (list (symbol-name x))) charset-list))
 	 (charset (completing-read prompt table
 				   nil t initial-input 'charset-history
 				   default-value)))
@@ -487,10 +362,10 @@
 
 ;;;###autoload
 (defun list-charset-chars (charset)
-  "Display a list of characters in the specified character set.
+  "Display a list of characters in character set CHARSET.
 This can list both Emacs `official' (ISO standard) charsets and the
 characters encoded by various Emacs coding systems which correspond to
-PC `codepages' and other coded character sets.  See `non-iso-charset-alist'."
+PC `codepages' and other coded character sets."
   (interactive (list (read-charset "Character set: ")))
   (with-output-to-temp-buffer "*Help*"
     (with-current-buffer standard-output
@@ -498,8 +373,6 @@
       (set-buffer-multibyte t)
       (cond ((charsetp charset)
 	     (list-iso-charset-chars charset))
-	    ((assq charset non-iso-charset-alist)
-	     (list-non-iso-charset-chars charset))
 	    (t
 	     (error "Invalid character set %s" charset))))))
 
@@ -507,8 +380,7 @@
 ;;;###autoload
 (defun describe-character-set (charset)
   "Display information about built-in character set CHARSET."
-  (interactive (list (let ((non-iso-charset-alist nil))
-		       (read-charset "Charset: "))))
+  (interactive (list (read-charset "Charset: ")))
   (or (charsetp charset)
       (error "Invalid charset: %S" charset))
   (let ((info (charset-info charset)))
@@ -693,6 +565,7 @@
       (let ((reg (cdr elt)))
 	(nconc (aref gr reg) (list (car elt)))))
     (dotimes (i 4)
+      ;; Fixme:
       (setq charset (aref flags graphic-register))
       (princ (format
 	      "  G%d -- %s\n"
@@ -747,7 +620,8 @@
     (with-output-to-temp-buffer (help-buffer)
       (print-coding-system-briefly coding-system 'doc-string)
       (let* ((type (coding-system-type coding-system))
-	     (extra-spec (coding-system-extra-spec coding-system)))
+	     ;; Fixme: use this
+	     (extra-spec (coding-system-plist coding-system)))
 	(princ "Type: ")
 	(princ type)
 	(cond ((eq type 'undecided)
@@ -780,14 +654,14 @@
 		((eq eol-type 1) (princ "CRLF\n"))
 		((eq eol-type 2) (princ "CR\n"))
 		(t (princ "invalid\n")))))
-      (let ((postread (coding-system-get coding-system 'post-read-conversion)))
+      (let ((postread (coding-system-get coding-system :post-read-conversion)))
 	(when postread
 	  (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)))
+      (let ((prewrite (coding-system-get coding-system :pre-write-conversion)))
 	(when prewrite
 	  (princ "Before encoding text normally,")
 	  (princ " perform pre-conversion using the function: ")
@@ -795,7 +669,7 @@
 	  (princ prewrite)
 	  (princ "\n")))
       (with-current-buffer standard-output
-	(let ((charsets (coding-system-get coding-system 'safe-charsets)))
+	(let ((charsets (coding-system-get coding-system :charset-list)))
 	  (when (and (not (memq (coding-system-base coding-system)
 				'(raw-text emacs-mule)))
 		     charsets)
@@ -857,8 +731,8 @@
      (coding-system-eol-type-mnemonic (cdr default-process-coding-system))
      )))
 
-;; Print symbol name and mnemonic letter of CODING-SYSTEM with `princ'.
 (defun print-coding-system-briefly (coding-system &optional doc-string)
+  "Print symbol name and mnemonic letter of CODING-SYSTEM with `princ'."
   (if (not coding-system)
       (princ "nil\n")
     (princ (format "%c -- %s"
@@ -914,6 +788,7 @@
 	  (let ((aliases (coding-system-aliases elt)))
 	    (if (eq elt (car aliases))
 		(if (cdr aliases)
+		    ;; Fixme:
 		    (princ (cons 'alias: (cdr base-aliases))))
 	      (princ (list 'alias 'of (car aliases))))
 	    (terpri)
@@ -977,8 +852,8 @@
 	(funcall func "Network I/O" network-coding-system-alist))
       (help-mode))))
 
-;; Print detailed information on CODING-SYSTEM.
 (defun print-coding-system (coding-system)
+  "Print detailed information on CODING-SYSTEM."
   (let ((type (coding-system-type coding-system))
 	(eol-type (coding-system-eol-type coding-system))
 	(flags (coding-system-flags coding-system))
@@ -1112,8 +987,8 @@
 
 ;;; FONT
 
-;; Print information of a font in FONTINFO.
 (defun describe-font-internal (font-info &optional verbose)
+  "Print information about a font in FONT-INFO."
   (print-list "name (opened by):" (aref font-info 0))
   (print-list "       full name:" (aref font-info 1))
   (print-list "            size:" (format "%2d" (aref font-info 2)))