/[emacs]/emacs/lisp/descr-text.el
ViewVC logotype

Diff of /emacs/lisp/descr-text.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.11 by fx, Wed May 21 22:00:01 2003 UTC revision 1.12 by rms, Wed May 28 11:14:07 2003 UTC
# Line 218  otherwise." Line 218  otherwise."
218          (newline)          (newline)
219          (widget-insert "There are text properties here:\n")          (widget-insert "There are text properties here:\n")
220          (describe-property-list properties)))))          (describe-property-list properties)))))
221    
222    ;;; We cannot use the UnicodeData.txt file as such; it is not free.
223    ;;; We can turn that info a different format and release the result
224    ;;; as free data.  When that is done, we could reinstate the code below.
225    ;;; For the mean time, here is a dummy placeholder.
226    ;;;  -- rms
227    (defun describe-char-unicode-data (char) nil)
228    
229  (defcustom unicodedata-file nil  ;;; (defcustom describe-char-unicodedata-file nil
230    "Location of Unicode data file.  ;;;   "Location of Unicode data file.
231  This is the UnicodeData.txt file from the Unicode consortium, used for  ;;; This is the UnicodeData.txt file from the Unicode consortium, used for
232  diagnostics.  If it is non-nil `describe-char-after' will print data  ;;; diagnostics.  If it is non-nil `describe-char-after' will print data
233  looked up from it.  This facility is mostly of use to people doing  ;;; looked up from it.  This facility is mostly of use to people doing
234  multilingual development.  ;;; multilingual development.
235    
236  This is a fairly large file, not typically present on GNU systems.  At  ;;; This is a fairly large file, not typically present on GNU systems.  At
237  the time of writing it is at  ;;; the time of writing it is at
238  <URL:ftp://www.unicode.org/Public/UNIDATA/UnicodeData.txt>."  ;;; <URL:ftp://www.unicode.org/Public/UNIDATA/UnicodeData.txt>."
239    :group 'mule  ;;;   :group 'mule
240    :version "21.5"  ;;;   :version "21.5"
241    :type '(choice (const :tag "None" nil)  ;;;   :type '(choice (const :tag "None" nil)
242                   file))  ;;;              file))
243    
244  ;; We could convert the unidata file into a Lispy form once-for-all  ;;; ;; We could convert the unidata file into a Lispy form once-for-all
245  ;; and distribute it for loading on demand.  It might be made more  ;;; ;; and distribute it for loading on demand.  It might be made more
246  ;; space-efficient by splitting strings word-wise and replacing them  ;;; ;; space-efficient by splitting strings word-wise and replacing them
247  ;; with lists of symbols interned in a private obarray, e.g.  ;;; ;; with lists of symbols interned in a private obarray, e.g.
248  ;; "LATIN SMALL LETTER A" => '(LATIN SMALL LETTER A).  ;;; ;; "LATIN SMALL LETTER A" => '(LATIN SMALL LETTER A).
   
 ;; Fixme: Check whether this needs updating for Unicode 4.  
 (defun unicode-data (char)  
   "Return a list of Unicode data for unicode CHAR.  
 Each element is a list of a property description and the property value.  
 The list is null if CHAR isn't found in `unicodedata-file'."  
   (when unicodedata-file  
     (unless (file-exists-p unicodedata-file)  
       (error "`unicodedata-file' %s not found" unicodedata-file))  
     (save-excursion  
       ;; Find file in fundamental mode to avoid, e.g. flyspell turned  
       ;; on for .txt.  Don't use RAWFILE arg in case of DOS line endings.  
       (set-buffer (let ((auto-mode-alist))  
                     (find-file-noselect unicodedata-file)))  
       (goto-char (point-min))  
       (let ((hex (format "%04X" char))  
             found first last)  
         (if (re-search-forward (concat "^" hex) nil t)  
             (setq found t)  
           ;; It's not listed explicitly.  Look for ranges, e.g. CJK  
           ;; ideographs, and check whether it's in one of them.  
           (while (and (re-search-forward "^\\([^;]+\\);[^;]+First>;" nil t)  
                       (>= char (setq first  
                                      (string-to-number (match-string 1) 16)))  
                       (progn  
                         (forward-line 1)  
                         (looking-at "^\\([^;]+\\);[^;]+Last>;")  
                         (> char  
                            (setq last  
                                  (string-to-number (match-string 1) 16))))))  
           (if (and (>= char first)  
                    (<= char last))  
               (setq found t)))  
         (if found  
             (let ((fields (mapcar (lambda (elt)  
                                     (if (> (length elt) 0)  
                                         elt))  
                                   (cdr (split-string  
                                         (buffer-substring  
                                          (line-beginning-position)  
                                          (line-end-position))  
                                         ";")))))  
               ;; The length depends on whether the last field was empty.  
               (unless (or (= 13 (length fields))  
                           (= 14 (length fields)))  
                 (error "Invalid contents in %s" unicodedata-file))  
               ;; The field names and values lists are slightly  
               ;; modified from Mule-UCS unidata.el.  
               (list  
                (list "Name" (let ((name (nth 0 fields)))  
                               ;; Check for <..., First>, <..., Last>  
                               (if (string-match "\\`\\(<[^,]+\\)," name)  
                                   (concat (match-string 1 name) ">")  
                                 name)))  
                (list "Category"  
                      (cdr (assoc  
                            (nth 1 fields)  
                            '(("Lu" . "uppercase letter")  
                              ("Ll" . "lowercase letter")  
                              ("Lt" . "titlecase letter")  
                              ("Mn" . "non-spacing mark")  
                              ("Mc" . "spacing-combining mark")  
                              ("Me" . "enclosing mark")  
                              ("Nd" . "decimal digit")  
                              ("Nl" . "letter number")  
                              ("No" . "other number")  
                              ("Zs" . "space separator")  
                              ("Zl" . "line separator")  
                              ("Zp" . "paragraph separator")  
                              ("Cc" . "other control")  
                              ("Cf" . "other format")  
                              ("Cs" . "surrogate")  
                              ("Co" . "private use")  
                              ("Cn" . "not assigned")  
                              ("Lm" . "modifier letter")  
                              ("Lo" . "other letter")  
                              ("Pc" . "connector punctuation")  
                              ("Pd" . "dash punctuation")  
                              ("Ps" . "open punctuation")  
                              ("Pe" . "close punctuation")  
                              ("Pi" . "initial-quotation punctuation")  
                              ("Pf" . "final-quotation punctuation")  
                              ("Po" . "other punctuation")  
                              ("Sm" . "math symbol")  
                              ("Sc" . "currency symbol")  
                              ("Sk" . "modifier symbol")  
                              ("So" . "other symbol")))))  
                (list "Combining class"  
                      (cdr (assoc  
                            (string-to-number (nth 2 fields))  
                            '((0 . "Spacing")  
                              (1 . "Overlays and interior")  
                              (7 . "Nuktas")  
                              (8 . "Hiragana/Katakana voicing marks")  
                              (9 . "Viramas")  
                              (10 . "Start of fixed position classes")  
                              (199 . "End of fixed position classes")  
                              (200 . "Below left attached")  
                              (202 . "Below attached")  
                              (204 . "Below right attached")  
                              (208 . "Left attached (reordrant around \  
 single base character)")  
                              (210 . "Right attached")  
                              (212 . "Above left attached")  
                              (214 . "Above attached")  
                              (216 . "Above right attached")  
                              (218 . "Below left")  
                              (220 . "Below")  
                              (222 . "Below right")  
                              (224 . "Left (reordrant around single base \  
 character)")  
                              (226 . "Right")  
                              (228 . "Above left")  
                              (230 . "Above")  
                              (232 . "Above right")  
                              (233 . "Double below")  
                              (234 . "Double above")  
                              (240 . "Below (iota subscript)")))))  
                (list "Bidi category"  
                      (cdr (assoc  
                            (nth 3 fields)  
                            '(("L" . "Left-to-Right")  
                              ("LRE" . "Left-to-Right Embedding")  
                              ("LRO" . "Left-to-Right Override")  
                              ("R" . "Right-to-Left")  
                              ("AL" . "Right-to-Left Arabic")  
                              ("RLE" . "Right-to-Left Embedding")  
                              ("RLO" . "Right-to-Left Override")  
                              ("PDF" . "Pop Directional Format")  
                              ("EN" . "European Number")  
                              ("ES" . "European Number Separator")  
                              ("ET" . "European Number Terminator")  
                              ("AN" . "Arabic Number")  
                              ("CS" . "Common Number Separator")  
                              ("NSM" . "Non-Spacing Mark")  
                              ("BN" . "Boundary Neutral")  
                              ("B" . "Paragraph Separator")  
                              ("S" . "Segment Separator")  
                              ("WS" . "Whitespace")  
                              ("ON" . "Other Neutrals")))))  
                (list  
                 "Decomposition"  
                 (if (nth 4 fields)  
                     (let* ((parts (split-string (nth 4 fields)))  
                            (info (car parts)))  
                       (if (string-match "\\`<\\(.+\\)>\\'" info)  
                           (setq info (match-string 1 info))  
                         (setq info nil))  
                       (if info (setq parts (cdr parts)))  
                       ;; Maybe printing ? for unrepresentable unicodes  
                       ;; here and below should be changed?  
                       (setq parts (mapconcat  
                                    (lambda (arg)  
                                      (string (or (decode-char  
                                                   'ucs  
                                                   (string-to-number arg 16))  
                                                  ??)))  
                                    parts " "))  
                       (concat info parts))))  
                (list "Decimal digit value"  
                      (nth 5 fields))  
                (list "Digit value"  
                      (nth 6 fields))  
                (list "Numeric value"  
                      (nth 7 fields))  
                (list "Mirrored"  
                      (if (equal "Y" (nth 8 fields))  
                          "yes"))  
                (list "Old name" (nth 9 fields))  
                (list "ISO 10646 comment" (nth 10 fields))  
                (list "Uppercase" (and (nth 11 fields)  
                                       (string (or (decode-char  
                                                    'ucs  
                                                    (string-to-number  
                                                     (nth 11 fields) 16))  
                                                   ??))))  
                (list "Lowercase" (and (nth 12 fields)  
                                       (string (or (decode-char  
                                                    'ucs  
                                                    (string-to-number  
                                                     (nth 12 fields) 16))  
                                                   ??))))  
                (list "Titlecase" (and (nth 13 fields)  
                                       (string (or (decode-char  
                                                    'ucs  
                                                    (string-to-number  
                                                     (nth 13 fields) 16))  
                                                   ??)))))))))))  
249    
250    ;;; ;; Fixme: Check whether this needs updating for Unicode 4.
251    ;;; (defun describe-char-unicode-data (char)
252    ;;;   "Return a list of Unicode data for unicode CHAR.
253    ;;; Each element is a list of a property description and the property value.
254    ;;; The list is null if CHAR isn't found in `describe-char-unicodedata-file'."
255    ;;;   (when describe-char-unicodedata-file
256    ;;;     (unless (file-exists-p describe-char-unicodedata-file)
257    ;;;       (error "`unicodedata-file' %s not found" describe-char-unicodedata-file))
258    ;;;     (save-excursion
259    ;;;       ;; Find file in fundamental mode to avoid, e.g. flyspell turned
260    ;;;       ;; on for .txt.  Don't use RAWFILE arg in case of DOS line endings.
261    ;;;       (set-buffer (let ((auto-mode-alist))
262    ;;;                 (find-file-noselect describe-char-unicodedata-file)))
263    ;;;       (goto-char (point-min))
264    ;;;       (let ((hex (format "%04X" char))
265    ;;;         found first last)
266    ;;;     (if (re-search-forward (concat "^" hex) nil t)
267    ;;;         (setq found t)
268    ;;;       ;; It's not listed explicitly.  Look for ranges, e.g. CJK
269    ;;;       ;; ideographs, and check whether it's in one of them.
270    ;;;       (while (and (re-search-forward "^\\([^;]+\\);[^;]+First>;" nil t)
271    ;;;                   (>= char (setq first
272    ;;;                                  (string-to-number (match-string 1) 16)))
273    ;;;                   (progn
274    ;;;                     (forward-line 1)
275    ;;;                     (looking-at "^\\([^;]+\\);[^;]+Last>;")
276    ;;;                     (> char
277    ;;;                        (setq last
278    ;;;                              (string-to-number (match-string 1) 16))))))
279    ;;;       (if (and (>= char first)
280    ;;;                (<= char last))
281    ;;;           (setq found t)))
282    ;;;     (if found
283    ;;;         (let ((fields (mapcar (lambda (elt)
284    ;;;                                 (if (> (length elt) 0)
285    ;;;                                     elt))
286    ;;;                               (cdr (split-string
287    ;;;                                     (buffer-substring
288    ;;;                                      (line-beginning-position)
289    ;;;                                      (line-end-position))
290    ;;;                                     ";")))))
291    ;;;           ;; The length depends on whether the last field was empty.
292    ;;;           (unless (or (= 13 (length fields))
293    ;;;                       (= 14 (length fields)))
294    ;;;             (error "Invalid contents in %s" describe-char-unicodedata-file))
295    ;;;           ;; The field names and values lists are slightly
296    ;;;           ;; modified from Mule-UCS unidata.el.
297    ;;;           (list
298    ;;;            (list "Name" (let ((name (nth 0 fields)))
299    ;;;                           ;; Check for <..., First>, <..., Last>
300    ;;;                           (if (string-match "\\`\\(<[^,]+\\)," name)
301    ;;;                               (concat (match-string 1 name) ">")
302    ;;;                             name)))
303    ;;;            (list "Category"
304    ;;;                  (cdr (assoc
305    ;;;                        (nth 1 fields)
306    ;;;                        '(("Lu" . "uppercase letter")
307    ;;;                          ("Ll" . "lowercase letter")
308    ;;;                          ("Lt" . "titlecase letter")
309    ;;;                          ("Mn" . "non-spacing mark")
310    ;;;                          ("Mc" . "spacing-combining mark")
311    ;;;                          ("Me" . "enclosing mark")
312    ;;;                          ("Nd" . "decimal digit")
313    ;;;                          ("Nl" . "letter number")
314    ;;;                          ("No" . "other number")
315    ;;;                          ("Zs" . "space separator")
316    ;;;                          ("Zl" . "line separator")
317    ;;;                          ("Zp" . "paragraph separator")
318    ;;;                          ("Cc" . "other control")
319    ;;;                          ("Cf" . "other format")
320    ;;;                          ("Cs" . "surrogate")
321    ;;;                          ("Co" . "private use")
322    ;;;                          ("Cn" . "not assigned")
323    ;;;                          ("Lm" . "modifier letter")
324    ;;;                          ("Lo" . "other letter")
325    ;;;                          ("Pc" . "connector punctuation")
326    ;;;                          ("Pd" . "dash punctuation")
327    ;;;                          ("Ps" . "open punctuation")
328    ;;;                          ("Pe" . "close punctuation")
329    ;;;                          ("Pi" . "initial-quotation punctuation")
330    ;;;                          ("Pf" . "final-quotation punctuation")
331    ;;;                          ("Po" . "other punctuation")
332    ;;;                          ("Sm" . "math symbol")
333    ;;;                          ("Sc" . "currency symbol")
334    ;;;                          ("Sk" . "modifier symbol")
335    ;;;                          ("So" . "other symbol")))))
336    ;;;            (list "Combining class"
337    ;;;                  (cdr (assoc
338    ;;;                        (string-to-number (nth 2 fields))
339    ;;;                        '((0 . "Spacing")
340    ;;;                          (1 . "Overlays and interior")
341    ;;;                          (7 . "Nuktas")
342    ;;;                          (8 . "Hiragana/Katakana voicing marks")
343    ;;;                          (9 . "Viramas")
344    ;;;                          (10 . "Start of fixed position classes")
345    ;;;                          (199 . "End of fixed position classes")
346    ;;;                          (200 . "Below left attached")
347    ;;;                          (202 . "Below attached")
348    ;;;                          (204 . "Below right attached")
349    ;;;                          (208 . "Left attached (reordrant around \
350    ;;; single base character)")
351    ;;;                          (210 . "Right attached")
352    ;;;                          (212 . "Above left attached")
353    ;;;                          (214 . "Above attached")
354    ;;;                          (216 . "Above right attached")
355    ;;;                          (218 . "Below left")
356    ;;;                          (220 . "Below")
357    ;;;                          (222 . "Below right")
358    ;;;                          (224 . "Left (reordrant around single base \
359    ;;; character)")
360    ;;;                          (226 . "Right")
361    ;;;                          (228 . "Above left")
362    ;;;                          (230 . "Above")
363    ;;;                          (232 . "Above right")
364    ;;;                          (233 . "Double below")
365    ;;;                          (234 . "Double above")
366    ;;;                          (240 . "Below (iota subscript)")))))
367    ;;;            (list "Bidi category"
368    ;;;                  (cdr (assoc
369    ;;;                        (nth 3 fields)
370    ;;;                        '(("L" . "Left-to-Right")
371    ;;;                          ("LRE" . "Left-to-Right Embedding")
372    ;;;                          ("LRO" . "Left-to-Right Override")
373    ;;;                          ("R" . "Right-to-Left")
374    ;;;                          ("AL" . "Right-to-Left Arabic")
375    ;;;                          ("RLE" . "Right-to-Left Embedding")
376    ;;;                          ("RLO" . "Right-to-Left Override")
377    ;;;                          ("PDF" . "Pop Directional Format")
378    ;;;                          ("EN" . "European Number")
379    ;;;                          ("ES" . "European Number Separator")
380    ;;;                          ("ET" . "European Number Terminator")
381    ;;;                          ("AN" . "Arabic Number")
382    ;;;                          ("CS" . "Common Number Separator")
383    ;;;                          ("NSM" . "Non-Spacing Mark")
384    ;;;                          ("BN" . "Boundary Neutral")
385    ;;;                          ("B" . "Paragraph Separator")
386    ;;;                          ("S" . "Segment Separator")
387    ;;;                          ("WS" . "Whitespace")
388    ;;;                          ("ON" . "Other Neutrals")))))
389    ;;;            (list
390    ;;;             "Decomposition"
391    ;;;             (if (nth 4 fields)
392    ;;;                 (let* ((parts (split-string (nth 4 fields)))
393    ;;;                        (info (car parts)))
394    ;;;                   (if (string-match "\\`<\\(.+\\)>\\'" info)
395    ;;;                       (setq info (match-string 1 info))
396    ;;;                     (setq info nil))
397    ;;;                   (if info (setq parts (cdr parts)))
398    ;;;                   ;; Maybe printing ? for unrepresentable unicodes
399    ;;;                   ;; here and below should be changed?
400    ;;;                   (setq parts (mapconcat
401    ;;;                                (lambda (arg)
402    ;;;                                  (string (or (decode-char
403    ;;;                                               'ucs
404    ;;;                                               (string-to-number arg 16))
405    ;;;                                              ??)))
406    ;;;                                parts " "))
407    ;;;                   (concat info parts))))
408    ;;;            (list "Decimal digit value"
409    ;;;                  (nth 5 fields))
410    ;;;            (list "Digit value"
411    ;;;                  (nth 6 fields))
412    ;;;            (list "Numeric value"
413    ;;;                  (nth 7 fields))
414    ;;;            (list "Mirrored"
415    ;;;                  (if (equal "Y" (nth 8 fields))
416    ;;;                      "yes"))
417    ;;;            (list "Old name" (nth 9 fields))
418    ;;;            (list "ISO 10646 comment" (nth 10 fields))
419    ;;;            (list "Uppercase" (and (nth 11 fields)
420    ;;;                                   (string (or (decode-char
421    ;;;                                                'ucs
422    ;;;                                                (string-to-number
423    ;;;                                                 (nth 11 fields) 16))
424    ;;;                                               ??))))
425    ;;;            (list "Lowercase" (and (nth 12 fields)
426    ;;;                                   (string (or (decode-char
427    ;;;                                                'ucs
428    ;;;                                                (string-to-number
429    ;;;                                                 (nth 12 fields) 16))
430    ;;;                                               ??))))
431    ;;;            (list "Titlecase" (and (nth 13 fields)
432    ;;;                                   (string (or (decode-char
433    ;;;                                                'ucs
434    ;;;                                                (string-to-number
435    ;;;                                                 (nth 13 fields) 16))
436    ;;;                                               ??)))))))))))
437    
438  ;;;###autoload  ;;;###autoload
439  (defun describe-char (pos)  (defun describe-char (pos)
440    "Describe the character after POS (interactively, the character after point).    "Describe the character after POS (interactively, the character after point).
# Line 517  as well as widgets, buttons, overlays, a Line 524  as well as widgets, buttons, overlays, a
524                               (encoded-string-description encoded coding)                               (encoded-string-description encoded coding)
525                             "not encodable"))))                             "not encodable"))))
526                ,@(let ((unicodedata (and unicode                ,@(let ((unicodedata (and unicode
527                                         (unicode-data unicode))))                                          (describe-char-unicode-data unicode))))
528                    (if unicodedata                    (if unicodedata
529                        (cons (list "Unicode data" " ") unicodedata))))))                        (cons (list "Unicode data" " ") unicodedata))))))
530      (setq max-width (apply #'max (mapcar #'(lambda (x) (length (car x)))      (setq max-width (apply #'max (mapcar #'(lambda (x) (length (car x)))

Legend:
Removed from v.1.11  
changed lines
  Added in v.1.12

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26