Add 2012 to FSF copyright years for Emacs files

[bpt/emacs.git] / lisp / international / mule-diag.el

diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el
index 50b8022..bd7257b 100644 (file)
--- a/lisp/international/mule-diag.el
+++ b/lisp/international/mule-diag.el
@@ -1,9 +1,8 @@
 ;;; mule-diag.el --- show diagnosis of multilingual environment (Mule)
 
 ;;; mule-diag.el --- show diagnosis of multilingual environment (Mule)
 

-;; Copyright (C) 1997, 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
-;;   2007, 2008, 2009  Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2000-2012  Free Software Foundation, Inc.

 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,

-;;   2005, 2006, 2007, 2008, 2009
+;;   2005, 2006, 2007, 2008, 2009, 2010, 2011

 ;;   National Institute of Advanced Industrial Science and Technology (AIST)
 ;;   Registration Number H14PRO021
 ;; Copyright (C) 2003
 ;;   National Institute of Advanced Industrial Science and Technology (AIST)
 ;;   Registration Number H14PRO021
 ;; Copyright (C) 2003


@@ -32,7 +31,7 @@
 ;;; Code:
 
 ;; Make sure the help-xref button type is defined.
 ;;; Code:
 
 ;; Make sure the help-xref button type is defined.

-(require 'help-fns)
+(require 'help-mode)

 
 ;;; General utility function
 
 
 ;;; General utility function
 


@@ -60,13 +59,15 @@
 
 The D column contains the dimension of this character set.  The CH
 column contains the number of characters in a block of this character
 
 The D column contains the dimension of this character set.  The CH
 column contains the number of characters in a block of this character

-set.  The FINAL-CHAR column contains an ISO-2022 <final-char> to use
-for designating this character set in ISO-2022-based coding systems.
+set.  The FINAL-BYTE column contains an ISO-2022 <final-byte> to use
+in the designation escape sequence for this character set in
+ISO-2022-based coding systems.

 
 With prefix ARG, the output format gets more cryptic,
 but still shows the full information."
   (interactive "P")
 
 With prefix ARG, the output format gets more cryptic,
 but still shows the full information."
   (interactive "P")

-  (help-setup-xref (list #'list-character-sets arg) (interactive-p))
+  (help-setup-xref (list #'list-character-sets arg)
+                  (called-interactively-p 'interactive))

   (with-output-to-temp-buffer "*Character Set List*"
     (with-current-buffer standard-output
       (if arg
   (with-output-to-temp-buffer "*Character Set List*"
     (with-current-buffer standard-output
       (if arg


@@ -85,7 +86,7 @@ but still shows the full information."
        (indent-to 48)
        (insert "| +--CHARS\n")
        (let ((columns '(("CHARSET-NAME" . name) "\t\t\t\t\t"
        (indent-to 48)
        (insert "| +--CHARS\n")
        (let ((columns '(("CHARSET-NAME" . name) "\t\t\t\t\t"

-                        ("D CH  FINAL-CHAR" . iso-spec)))
+                        ("D CH  FINAL-BYTE" . iso-spec)))

              pos)
          (while columns
            (if (stringp (car columns))
              pos)
          (while columns
            (if (stringp (car columns))


@@ -151,7 +152,14 @@ SORT-KEY should be `name' or `iso-spec' (default `name')."
     ;; Insert information of character sets.
     (dolist (elt (append charset-info-list (list t) supplementary-list))
       (if (eq elt t)
     ;; Insert information of character sets.
     (dolist (elt (append charset-info-list (list t) supplementary-list))
       (if (eq elt t)

-         (insert "-------------- Supplementary Character Sets --------------")
+         (progn
+           (insert "\n-------------- ")
+           (insert-text-button "Supplementary Character Sets"
+                               'type 'help-info
+                               'help-args '("(emacs)Charsets"))
+           (insert " --------------
+Character sets for defining other charsets, or for backward compatibility
+"))

        (insert-text-button (symbol-name (car elt)) ; NAME
                            :type 'list-charset-chars
                            'help-args (list (car elt)))
        (insert-text-button (symbol-name (car elt)) ; NAME
                            :type 'list-charset-chars
                            'help-args (list (car elt)))


@@ -306,7 +314,8 @@ meanings of these arguments."
   (interactive (list (read-charset "Charset: ")))
   (or (charsetp charset)
       (error "Invalid charset: %S" charset))
   (interactive (list (read-charset "Charset: ")))
   (or (charsetp charset)
       (error "Invalid charset: %S" charset))

-  (help-setup-xref (list #'describe-character-set charset) (interactive-p))
+  (help-setup-xref (list #'describe-character-set charset)
+                  (called-interactively-p 'interactive))

   (with-output-to-temp-buffer (help-buffer)
     (with-current-buffer standard-output
       (insert "Character set: " (symbol-name charset))
   (with-output-to-temp-buffer (help-buffer)
     (with-current-buffer standard-output
       (insert "Character set: " (symbol-name charset))


@@ -324,8 +333,6 @@ meanings of these arguments."
        (when (> char 0)
          (insert "Final char of ISO2022 designation sequence: ")
          (insert (format "`%c'\n" char))))
        (when (> char 0)
          (insert "Final char of ISO2022 designation sequence: ")
          (insert (format "`%c'\n" char))))

-      (insert (format "Width (how many columns on screen): %d\n"
-                     (aref char-width-table (make-char charset))))

       (let (aliases)
        (dolist (c charset-list)
          (if (and (not (eq c charset))
       (let (aliases)
        (dolist (c charset-list)
          (if (and (not (eq c charset))


@@ -360,7 +367,8 @@ meanings of these arguments."
          (when val
            (if (cadr elt) (insert (cadr elt)))
            (if (nth 2 elt)
          (when val
            (if (cadr elt) (insert (cadr elt)))
            (if (nth 2 elt)

-               (insert (funcall (nth 2 elt) val)))
+               (let ((print-length 10) (print-level 2))
+                 (princ (funcall (nth 2 elt) val) (current-buffer))))

            (insert ?\n)))))))
 \f
 ;;; CODING-SYSTEM
            (insert ?\n)))))))
 \f
 ;;; CODING-SYSTEM


@@ -413,7 +421,7 @@ meanings of these arguments."
   (if (null coding-system)
       (describe-current-coding-system)
     (help-setup-xref (list #'describe-coding-system coding-system)
   (if (null coding-system)
       (describe-current-coding-system)
     (help-setup-xref (list #'describe-coding-system coding-system)

-                    (interactive-p))
+                    (called-interactively-p 'interactive))

     (with-output-to-temp-buffer (help-buffer)
       (print-coding-system-briefly coding-system 'doc-string)
       (let ((type (coding-system-type coding-system))
     (with-output-to-temp-buffer (help-buffer)
       (print-coding-system-briefly coding-system 'doc-string)
       (let ((type (coding-system-type coding-system))


@@ -448,6 +456,7 @@ meanings of these arguments."
               (princ " (text with random binary characters)"))
              ((eq type 'emacs-mule)
               (princ " (Emacs 21 internal encoding)"))
               (princ " (text with random binary characters)"))
              ((eq type 'emacs-mule)
               (princ " (Emacs 21 internal encoding)"))

+             ((eq type 'big5))

              (t (princ ": invalid coding-system.")))
        (princ "\nEOL type: ")
        (let ((eol-type (coding-system-eol-type coding-system)))
              (t (princ ": invalid coding-system.")))
        (princ "\nEOL type: ")
        (let ((eol-type (coding-system-eol-type coding-system)))


@@ -509,8 +518,8 @@ in place of `..':
   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 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)

-  `default-buffer-file-coding-system'
-  eol-type of `default-buffer-file-coding-system'
+  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
   `default-process-coding-system' for write
   `default-process-coding-system' for read
   eol-type of `default-process-coding-system' for read
   `default-process-coding-system' for write


@@ -530,8 +539,9 @@ in place of `..':
      (coding-system-eol-type-mnemonic (car process-coding-systems))
      (coding-system-mnemonic (cdr process-coding-systems))
      (coding-system-eol-type-mnemonic (cdr process-coding-systems))
      (coding-system-eol-type-mnemonic (car process-coding-systems))
      (coding-system-mnemonic (cdr process-coding-systems))
      (coding-system-eol-type-mnemonic (cdr process-coding-systems))

-     (coding-system-mnemonic default-buffer-file-coding-system)
-     (coding-system-eol-type-mnemonic default-buffer-file-coding-system)
+     (coding-system-mnemonic (default-value 'buffer-file-coding-system))
+     (coding-system-eol-type-mnemonic
+      (default-value 'buffer-file-coding-system))

      (coding-system-mnemonic (car default-process-coding-system))
      (coding-system-eol-type-mnemonic (car default-process-coding-system))
      (coding-system-mnemonic (cdr default-process-coding-system))
      (coding-system-mnemonic (car default-process-coding-system))
      (coding-system-eol-type-mnemonic (car default-process-coding-system))
      (coding-system-mnemonic (cdr default-process-coding-system))


@@ -585,7 +595,7 @@ docstring, and print only the first line of the docstring."
          (print-coding-system-briefly buffer-file-coding-system)
        (princ "Not set locally, use the default.\n"))
       (princ "Default coding system (for new files):\n  ")
          (print-coding-system-briefly buffer-file-coding-system)
        (princ "Not set locally, use the default.\n"))
       (princ "Default coding system (for new files):\n  ")

-      (print-coding-system-briefly default-buffer-file-coding-system)
+      (print-coding-system-briefly (default-value 'buffer-file-coding-system))

       (princ "Coding system for keyboard input:\n  ")
       (print-coding-system-briefly (keyboard-coding-system))
       (princ "Coding system for terminal output:\n  ")
       (princ "Coding system for keyboard input:\n  ")
       (print-coding-system-briefly (keyboard-coding-system))
       (princ "Coding system for terminal output:\n  ")


@@ -810,8 +820,9 @@ but still contains full information about each coding system."
 
 (declare-function font-info "font.c" (name &optional frame))
 
 
 (declare-function font-info "font.c" (name &optional frame))
 

-(defun describe-font-internal (font-info &optional verbose)
-  "Print information about a font in FONT-INFO."
+(defun describe-font-internal (font-info &optional ignored)
+  "Print information about a font in FONT-INFO.
+The IGNORED argument is ignored."

   (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)))
   (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)))


@@ -839,7 +850,7 @@ The font must be already used by Emacs."
            (message "No information about \"%s\"" (font-xlfd-name fontname))
          (message "No matching font found"))
       (with-output-to-temp-buffer "*Help*"
            (message "No information about \"%s\"" (font-xlfd-name fontname))
          (message "No matching font found"))
       (with-output-to-temp-buffer "*Help*"

-       (describe-font-internal font-info 'verbose)))))
+       (describe-font-internal font-info)))))

 
 (defun print-fontset-element (val)
   ;; VAL has this format:
 
 (defun print-fontset-element (val)
   ;; VAL has this format:


@@ -907,23 +918,52 @@ The font must be already used by Emacs."
 
 (defun print-fontset (fontset &optional print-opened)
   "Print information about FONTSET.
 
 (defun print-fontset (fontset &optional print-opened)
   "Print information about FONTSET.

-If FONTSET is nil, print information about the default fontset.
+FONTSET nil means the fontset of the selected frame, t means the
+default fontset.

 If optional arg PRINT-OPENED is non-nil, also print names of all opened
 fonts for FONTSET.  This function actually inserts the information in
 the current buffer."
 If optional arg PRINT-OPENED 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")))
+  (if (eq fontset t)
+      (setq fontset (query-fontset "fontset-default"))
+    (if (eq fontset nil)
+       (setq fontset (face-attribute 'default :fontset))))

   (beginning-of-line)
   (beginning-of-line)

+  (narrow-to-region (point) (point))

   (insert "Fontset: " fontset "\n")
   (insert (propertize "CHAR RANGE" 'face 'underline)
           " (" (propertize "CODE RANGE" 'face 'underline) ")\n")
   (insert "    " (propertize "FONT NAME" 'face 'underline)
          " (" (propertize "REQUESTED" 'face 'underline)
          " and [" (propertize "OPENED" 'face 'underline) "])")
   (insert "Fontset: " fontset "\n")
   (insert (propertize "CHAR RANGE" 'face 'underline)
           " (" (propertize "CODE RANGE" 'face 'underline) ")\n")
   (insert "    " (propertize "FONT NAME" 'face 'underline)
          " (" (propertize "REQUESTED" 'face 'underline)
          " and [" (propertize "OPENED" 'face 'underline) "])")

-  (let ((info (fontset-info fontset)))
+  (let* ((info (fontset-info fontset))
+        (default-info (char-table-extra-slot info 0))
+        start1 end1 start2 end2)

     (describe-vector info 'print-fontset-element)
     (describe-vector info 'print-fontset-element)

-    (insert "\n  ---<fallback to the default fontset>---")
-    (describe-vector (char-table-extra-slot info 0) 'print-fontset-element)))
+    (when (char-table-range info nil)
+      ;; The default of FONTSET is described.
+      (setq start1 (re-search-backward "^default"))
+      (delete-region (point) (line-end-position))
+      (insert "\n  ---<fallback to the default of the specified fontset>---")
+      (put-text-property (line-beginning-position) (point) 'face 'highlight)
+      (goto-char (point-max))
+      (setq end1 (setq start2 (point))))
+    (when default-info
+      (insert "\n  ---<fallback to the default fontset>---")
+      (put-text-property (line-beginning-position) (point) 'face 'highlight)
+      (describe-vector default-info 'print-fontset-element)
+      (when (char-table-range default-info nil)
+       ;; The default of the default fontset is described.
+       (setq end2 (re-search-backward "^default"))
+       (delete-region (point) (line-end-position))
+       (insert "\n  ---<fallback to the default of the default fontset>---")
+       (put-text-property (line-beginning-position) (point) 'face 'highlight)))
+      (if (and start1 end2)
+         ;; Reorder the printed information to match with the font
+         ;; searching strategy; i.e. FONTSET, the default fontset,
+         ;; default of FONTSET, default of the default fontset.
+         (transpose-regions start1 end1 start2 end2))
+      (goto-char (point-max)))
+  (widen))

 
 (defvar fontset-alias-alist)
 (declare-function fontset-list "fontset.c" ())
 
 (defvar fontset-alias-alist)
 (declare-function fontset-list "fontset.c" ())


@@ -943,9 +983,10 @@ This shows which font is used for which character(s)."
              "Fontset (default used by the current frame): "
              fontset-list nil t)))))
   (if (= (length fontset) 0)
              "Fontset (default used by the current frame): "
              fontset-list nil t)))))
   (if (= (length fontset) 0)

-      (setq fontset (frame-parameter nil 'font)))
-  (setq fontset (query-fontset fontset))
-  (help-setup-xref (list #'describe-fontset fontset) (interactive-p))
+      (setq fontset (face-attribute 'default :fontset))
+    (setq fontset (query-fontset fontset)))
+  (help-setup-xref (list #'describe-fontset fontset)
+                  (called-interactively-p 'interactive))

   (with-output-to-temp-buffer (help-buffer)
     (with-current-buffer standard-output
       (print-fontset fontset t))))
   (with-output-to-temp-buffer (help-buffer)
     (with-current-buffer standard-output
       (print-fontset fontset t))))


@@ -961,7 +1002,8 @@ see the function `describe-fontset' for the format of the list."
   (interactive "P")
   (if (not (and window-system (fboundp 'fontset-list)))
       (error "No fontsets being used")
   (interactive "P")
   (if (not (and window-system (fboundp 'fontset-list)))
       (error "No fontsets being used")

-    (help-setup-xref (list #'list-fontsets arg) (interactive-p))
+    (help-setup-xref (list #'list-fontsets arg)
+                    (called-interactively-p 'interactive))

     (with-output-to-temp-buffer (help-buffer)
       (with-current-buffer standard-output
        ;; This code is duplicated near the end of mule-diag.
     (with-output-to-temp-buffer (help-buffer)
       (with-current-buffer standard-output
        ;; This code is duplicated near the end of mule-diag.


@@ -980,7 +1022,8 @@ see the function `describe-fontset' for the format of the list."
 (defun list-input-methods ()
   "Display information about all input methods."
   (interactive)
 (defun list-input-methods ()
   "Display information about all input methods."
   (interactive)

-  (help-setup-xref '(list-input-methods) (interactive-p))
+  (help-setup-xref '(list-input-methods)
+                  (called-interactively-p 'interactive))

   (with-output-to-temp-buffer (help-buffer)
     (list-input-methods-1)
     (with-current-buffer standard-output
   (with-output-to-temp-buffer (help-buffer)
     (list-input-methods-1)
     (with-current-buffer standard-output


@@ -1013,7 +1056,10 @@ installed LEIM (Libraries of Emacs Input Methods).")
                         (if (and (consp title) (stringp (car title)))
                             (car title)
                           title))
                         (if (and (consp title) (stringp (car title)))
                             (car title)
                           title))

-                      (nth 4 elt)))))))
+                      ;; If the doc is multi-line, indent all
+                      ;; non-blank lines. (Bug#8066)
+                      (replace-regexp-in-string "\n\\(.\\)" "\n    \\1"
+                                                (or (nth 4 elt) ""))))))))

 \f
 ;;; DIAGNOSIS
 
 \f
 ;;; DIAGNOSIS
 


@@ -1050,7 +1096,8 @@ system which uses fontsets)."
       (insert "Version of this emacs:\n  " (emacs-version) "\n\n")
       (insert "Configuration options:\n  " system-configuration-options "\n\n")
       (insert "Multibyte characters awareness:\n"
       (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 "  default: %S\n" (default-value
+                                         'enable-multibyte-characters))

              (format "  current-buffer: %S\n\n" enable-multibyte-characters))
       (insert "Current language environment: " current-language-environment
              "\n\n")
              (format "  current-buffer: %S\n\n" enable-multibyte-characters))
       (insert "Current language environment: " current-language-environment
              "\n\n")


@@ -1064,9 +1111,9 @@ system which uses fontsets)."
 
       (if window-system
          (let ((font (cdr (assq 'font (frame-parameters)))))
 
       (if window-system
          (let ((font (cdr (assq 'font (frame-parameters)))))

-           (insert "The selected frame is using the "
-                   (if (query-fontset font) "fontset" "font")
-                   ":\n\t" font))
+           (insert "The font and fontset of the selected frame are:\n"
+                   "     font: " font "\n"
+                   "  fontset: " (face-attribute 'default :fontset) "\n"))

        (insert "Coding system of the terminal: "
                (symbol-name (terminal-coding-system))))
       (insert "\n\n")
        (insert "Coding system of the terminal: "
                (symbol-name (terminal-coding-system))))
       (insert "\n\n")


@@ -1092,8 +1139,9 @@ system which uses fontsets)."
        (insert "Fontset-Name\t\t\t\t\t\t  WDxHT Style\n")
        (insert "------------\t\t\t\t\t\t  ----- -----\n")
        (dolist (fontset (fontset-list))
        (insert "Fontset-Name\t\t\t\t\t\t  WDxHT Style\n")
        (insert "------------\t\t\t\t\t\t  ----- -----\n")
        (dolist (fontset (fontset-list))

-         (print-fontset fontset t)))
-      (print-help-return-message))))
+         (print-fontset fontset t)
+         (insert "\n")))
+      (help-print-return-message))))

 
 ;;;###autoload
 (defun font-show-log (&optional limit)
 
 ;;;###autoload
 (defun font-show-log (&optional limit)


@@ -1124,5 +1172,4 @@ The default is 20.  If LIMIT is negative, do not limit the listing."
 
 (provide 'mule-diag)
 
 
 (provide 'mule-diag)
 

-;; arch-tag: cd3b607c-2893-45a0-a4fa-a6535754dbee

 ;;; mule-diag.el ends here
 ;;; mule-diag.el ends here