Commit 02e91426 authored by Stefan Monnier's avatar Stefan Monnier
Browse files

(describe-coding-system): Remove unused `coding-spec' variable.

(list-input-methods): Be more careful when setting up the help buffer.
parent 3da91622
...@@ -46,7 +46,7 @@ ...@@ -46,7 +46,7 @@
(defun sort-charset-list () (defun sort-charset-list ()
(setq charset-list (setq charset-list
(sort charset-list (sort charset-list
(function (lambda (x y) (< (charset-id x) (charset-id y))))))) (lambda (x y) (< (charset-id x) (charset-id y))))))
;;; CHARSET ;;; CHARSET
...@@ -175,20 +175,19 @@ but still shows the full information." ...@@ -175,20 +175,19 @@ but still shows the full information."
;; Determine a predicate for `sort' by SORT-KEY. ;; Determine a predicate for `sort' by SORT-KEY.
(setq sort-func (setq sort-func
(cond ((eq sort-key 'id) (cond ((eq sort-key 'id)
(function (lambda (x y) (< (car x) (car y))))) (lambda (x y) (< (car x) (car y))))
((eq sort-key 'name) ((eq sort-key 'name)
(function (lambda (x y) (string< (nth 1 x) (nth 1 y))))) (lambda (x y) (string< (nth 1 x) (nth 1 y))))
((eq sort-key 'iso-spec) ((eq sort-key 'iso-spec)
;; Sort by DIMENSION CHARS FINAL-CHAR ;; Sort by DIMENSION CHARS FINAL-CHAR
(function (lambda (x y)
(lambda (x y) (or (< (nth 3 x) (nth 3 y))
(or (< (nth 3 x) (nth 3 y)) (and (= (nth 3 x) (nth 3 y))
(and (= (nth 3 x) (nth 3 y)) (or (< (nth 4 x) (nth 4 y))
(or (< (nth 4 x) (nth 4 y)) (and (= (nth 4 x) (nth 4 y))
(and (= (nth 4 x) (nth 4 y)) (< (nth 5 x) (nth 5 y))))))))
(< (nth 5 x) (nth 5 y)))))))))
(t (t
(error "Invalid charset sort key: %s" sort-key)))) (error "Invalid charset sort key: %s" sort-key))))
...@@ -353,10 +352,9 @@ DEFAULT-VALUE, if non-nil, is the default value. ...@@ -353,10 +352,9 @@ DEFAULT-VALUE, if non-nil, is the default value.
INITIAL-INPUT, if non-nil, is a string inserted in the minibuffer initially. INITIAL-INPUT, if non-nil, is a string inserted in the minibuffer initially.
See the documentation of the function `completing-read' for the See the documentation of the function `completing-read' for the
detailed meanings of these arguments." detailed meanings of these arguments."
(let* ((table (append (mapcar (function (lambda (x) (list (symbol-name x)))) (let* ((table (append (mapcar (lambda (x) (list (symbol-name x)))
charset-list) charset-list)
(mapcar (function (lambda (x) (mapcar (lambda (x) (list (symbol-name (car x))))
(list (symbol-name (car x)))))
non-iso-charset-alist))) non-iso-charset-alist)))
(charset (completing-read prompt table (charset (completing-read prompt table
nil t initial-input 'charset-history nil t initial-input 'charset-history
...@@ -586,55 +584,54 @@ PC `codepages' and other coded character sets. See `non-iso-charset-alist'." ...@@ -586,55 +584,54 @@ PC `codepages' and other coded character sets. See `non-iso-charset-alist'."
(with-output-to-temp-buffer (help-buffer) (with-output-to-temp-buffer (help-buffer)
(print-coding-system-briefly coding-system 'doc-string) (print-coding-system-briefly coding-system 'doc-string)
(princ "\n") (princ "\n")
(let ((coding-spec (coding-system-spec coding-system))) (princ "Type: ")
(princ "Type: ") (let ((type (coding-system-type coding-system))
(let ((type (coding-system-type coding-system)) (flags (coding-system-flags coding-system)))
(flags (coding-system-flags coding-system))) (princ type)
(princ type) (cond ((eq type nil)
(cond ((eq type nil) (princ " (do no conversion)"))
(princ " (do no conversion)")) ((eq type t)
((eq type t) (princ " (do automatic conversion)"))
(princ " (do automatic conversion)")) ((eq type 0)
((eq type 0) (princ " (Emacs internal multibyte form)"))
(princ " (Emacs internal multibyte form)")) ((eq type 1)
((eq type 1) (princ " (Shift-JIS, MS-KANJI)"))
(princ " (Shift-JIS, MS-KANJI)")) ((eq type 2)
((eq type 2) (princ " (variant of ISO-2022)\n")
(princ " (variant of ISO-2022)\n") (princ "Initial designations:\n")
(princ "Initial designations:\n") (print-designation flags)
(print-designation flags) (princ "Other Form: \n ")
(princ "Other Form: \n ") (princ (if (aref flags 4) "short-form" "long-form"))
(princ (if (aref flags 4) "short-form" "long-form")) (if (aref flags 5) (princ ", ASCII@EOL"))
(if (aref flags 5) (princ ", ASCII@EOL")) (if (aref flags 6) (princ ", ASCII@CNTL"))
(if (aref flags 6) (princ ", ASCII@CNTL")) (princ (if (aref flags 7) ", 7-bit" ", 8-bit"))
(princ (if (aref flags 7) ", 7-bit" ", 8-bit")) (if (aref flags 8) (princ ", use-locking-shift"))
(if (aref flags 8) (princ ", use-locking-shift")) (if (aref flags 9) (princ ", use-single-shift"))
(if (aref flags 9) (princ ", use-single-shift")) (if (aref flags 10) (princ ", use-roman"))
(if (aref flags 10) (princ ", use-roman")) (if (aref flags 11) (princ ", use-old-jis"))
(if (aref flags 11) (princ ", use-old-jis")) (if (aref flags 12) (princ ", no-ISO6429"))
(if (aref flags 12) (princ ", no-ISO6429")) (if (aref flags 13) (princ ", init-bol"))
(if (aref flags 13) (princ ", init-bol")) (if (aref flags 14) (princ ", designation-bol"))
(if (aref flags 14) (princ ", designation-bol")) (if (aref flags 15) (princ ", convert-unsafe"))
(if (aref flags 15) (princ ", convert-unsafe")) (if (aref flags 16) (princ ", accept-latin-extra-code"))
(if (aref flags 16) (princ ", accept-latin-extra-code")) (princ "."))
(princ ".")) ((eq type 3)
((eq type 3) (princ " (Big5)"))
(princ " (Big5)")) ((eq type 4)
((eq type 4) (princ " (do conversion by CCL program)"))
(princ " (do conversion by CCL program)")) ((eq type 5)
((eq type 5) (princ " (text with random binary characters)"))
(princ " (text with random binary characters)")) (t (princ ": invalid coding-system."))))
(t (princ ": invalid coding-system.")))) (princ "\nEOL type: ")
(princ "\nEOL type: ") (let ((eol-type (coding-system-eol-type coding-system)))
(let ((eol-type (coding-system-eol-type coding-system))) (cond ((vectorp eol-type)
(cond ((vectorp eol-type) (princ "Automatic selection from:\n\t")
(princ "Automatic selection from:\n\t") (princ eol-type)
(princ eol-type) (princ "\n"))
(princ "\n")) ((or (null eol-type) (eq eol-type 0)) (princ "LF\n"))
((or (null eol-type) (eq eol-type 0)) (princ "LF\n")) ((eq eol-type 1) (princ "CRLF\n"))
((eq eol-type 1) (princ "CRLF\n")) ((eq eol-type 2) (princ "CR\n"))
((eq eol-type 2) (princ "CR\n")) (t (princ "invalid\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 (when postread
(princ "After decoding text normally,") (princ "After decoding text normally,")
...@@ -800,13 +797,12 @@ Priority order for recognizing coding systems when reading files:\n") ...@@ -800,13 +797,12 @@ Priority order for recognizing coding systems when reading files:\n")
(while categories (while categories
(setq coding-system (symbol-value (car categories))) (setq coding-system (symbol-value (car categories)))
(mapcar (mapcar
(function (lambda (x)
(lambda (x) (if (and (not (eq x coding-system))
(if (and (not (eq x coding-system)) (coding-system-get x 'no-initial-designation)
(coding-system-get x 'no-initial-designation) (let ((flags (coding-system-flags x)))
(let ((flags (coding-system-flags x))) (not (or (aref flags 10) (aref flags 11)))))
(not (or (aref flags 10) (aref flags 11))))) (setq codings (cons x codings))))
(setq codings (cons x codings)))))
(get (car categories) 'coding-systems)) (get (car categories) 'coding-systems))
(if codings (if codings
(let ((max-col (frame-width)) (let ((max-col (frame-width))
...@@ -1115,9 +1111,9 @@ see the function `describe-fontset' for the format of the list." ...@@ -1115,9 +1111,9 @@ see the function `describe-fontset' for the format of the list."
;; This code is duplicated near the end of mule-diag. ;; This code is duplicated near the end of mule-diag.
(let ((fontsets (let ((fontsets
(sort (fontset-list) (sort (fontset-list)
(function (lambda (x y) (lambda (x y)
(string< (fontset-plain-name x) (string< (fontset-plain-name x)
(fontset-plain-name y))))))) (fontset-plain-name y))))))
(while fontsets (while fontsets
(if arg (if arg
(print-fontset (car fontsets) nil) (print-fontset (car fontsets) nil)
...@@ -1128,7 +1124,8 @@ see the function `describe-fontset' for the format of the list." ...@@ -1128,7 +1124,8 @@ see the function `describe-fontset' for the format of the list."
(defun list-input-methods () (defun list-input-methods ()
"Display information about all input methods." "Display information about all input methods."
(interactive) (interactive)
(with-output-to-temp-buffer "*Help*" (help-setup-xref '(list-input-methods) (interactive-p))
(with-output-to-temp-buffer (help-buffer)
(list-input-methods-1) (list-input-methods-1)
(with-current-buffer standard-output (with-current-buffer standard-output
(save-excursion (save-excursion
...@@ -1137,8 +1134,7 @@ see the function `describe-fontset' for the format of the list." ...@@ -1137,8 +1134,7 @@ see the function `describe-fontset' for the format of the list."
"^ \\([^ ]+\\) (`.*' in mode line)$" nil t) "^ \\([^ ]+\\) (`.*' in mode line)$" nil t)
(help-xref-button 1 #'help-input-method (help-xref-button 1 #'help-input-method
(match-string 1) (match-string 1)
"mouse-2: describe this method"))) "mouse-2: describe this method"))))))
(help-setup-xref '(list-input-methods) (interactive-p)))))
(defun list-input-methods-1 () (defun list-input-methods-1 ()
(if (not input-method-alist) (if (not input-method-alist)
...@@ -1150,7 +1146,7 @@ installed LEIM (Libraries of Emacs Input Methods).")) ...@@ -1150,7 +1146,7 @@ installed LEIM (Libraries of Emacs Input Methods)."))
(princ " SHORT-DESCRIPTION\n------------------------------\n") (princ " SHORT-DESCRIPTION\n------------------------------\n")
(setq input-method-alist (setq input-method-alist
(sort input-method-alist (sort input-method-alist
(function (lambda (x y) (string< (nth 1 x) (nth 1 y)))))) (lambda (x y) (string< (nth 1 x) (nth 1 y)))))
(let ((l input-method-alist) (let ((l input-method-alist)
language elt) language elt)
(while l (while l
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment