Mercurial > hg > xemacs-beta

comparison lisp/iso8859-1.el @ 4369:ef9eb714f0e4

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Add ascii-case-table, #'with-case-table; make iso8859-1.el more comprehensible. 2007-12-30 Aidan Kehoe <kehoea@parhasard.net> * subr.el (with-case-table): New. Idea and implementation taken from GNU's code of April 2007, before GPL V3 was implied. Thank you GNU. * iso8859-1.el (ascii-case-table): New. Idea taken from GNU. * iso8859-1.el : Change Jamie's implicit compile-time call to a macro literal into something comprehensible to and maintainable by mortals, using to cl.el's #'loop. * iso8859-1.el (ctl-arrow): Initialise it to something more comprehensible.
author Aidan Kehoe <kehoea@parhasard.net>
date Sun, 30 Dec 2007 16:18:33 +0100
parents b4f4e0cc90f1
children 9fdac4a4ae62
comparison
equal deleted inserted replaced
4356:cc293ef846d2 4369:ef9eb714f0e4
26 26
27 ;;; Synched up with: Not in FSF. 27 ;;; Synched up with: Not in FSF.
28 28
29 ;;; Commentary: 29 ;;; Commentary:
30 30
31 ;; created by jwz, 19-aug-92.
32 ;; Sets the case table for the ISO-8859/1 character set. 31 ;; Sets the case table for the ISO-8859/1 character set.
33 ;; Used to set the syntax table. 32 ;; Provides ascii-case-table, for use in environments where multilingual
33 ;; case-insensitive processing is inappropriate.
34 34
35 ;;; Code: 35 ;;; Code:
36 36
37 (defconst iso8859/1-case-table nil 37 (defvar ascii-case-table
38 "The case table for ISO-8859/1 characters.") 38 (loop
39 for lower from (char-int ?a) to (char-int ?z)
40 and upper from (char-int ?A) to (char-int ?Z)
41 with table = (make-case-table)
42 do (put-case-table-pair (coerce lower 'character)
43 (coerce upper 'character)
44 table)
45 finally return table)
46 "Case table for the ASCII character set.")
39 47
40 ;;; This macro expands into 48 (loop
41 ;;; (setq iso8859/1-case-table (purecopy '("..." nil nil nil))) 49 for (upper lower)
42 ;;; doing the computation of the case table at compile-time. 50 in '((?\xC0 ?\xE0) ;; A WITH GRAVE
51 (?\xC1 ?\xE1) ;; A WITH ACUTE
52 (?\xC2 ?\xE2) ;; A WITH CIRCUMFLEX
53 (?\xC3 ?\xE3) ;; A WITH TILDE
54 (?\xC4 ?\xE4) ;; A WITH DIAERESIS
55 (?\xC5 ?\xE5) ;; A WITH RING ABOVE
56 (?\xC6 ?\xE6) ;; AE
57 (?\xC7 ?\xE7) ;; C WITH CEDILLA
58 (?\xC8 ?\xE8) ;; E WITH GRAVE
59 (?\xC9 ?\xE9) ;; E WITH ACUTE
60 (?\xCA ?\xEA) ;; E WITH CIRCUMFLEX
61 (?\xCB ?\xEB) ;; E WITH DIAERESIS
62 (?\xCC ?\xEC) ;; I WITH GRAVE
63 (?\xCD ?\xED) ;; I WITH ACUTE
64 (?\xCE ?\xEE) ;; I WITH CIRCUMFLEX
65 (?\xCF ?\xEF) ;; I WITH DIAERESIS
66 (?\xD0 ?\xF0) ;; ETH
67 (?\xD1 ?\xF1) ;; N WITH TILDE
68 (?\xD2 ?\xF2) ;; O WITH GRAVE
69 (?\xD3 ?\xF3) ;; O WITH ACUTE
70 (?\xD4 ?\xF4) ;; O WITH CIRCUMFLEX
71 (?\xD5 ?\xF5) ;; O WITH TILDE
72 (?\xD6 ?\xF6) ;; O WITH DIAERESIS
73 (?\xD8 ?\xF8) ;; O WITH STROKE
74 (?\xD9 ?\xF9) ;; U WITH GRAVE
75 (?\xDA ?\xFA) ;; U WITH ACUTE
76 (?\xDB ?\xFB) ;; U WITH CIRCUMFLEX
77 (?\xDC ?\xFC) ;; U WITH DIAERESIS
78 (?\xDD ?\xFD) ;; Y WITH ACUTE
79 (?\xDE ?\xFE)) ;; THORN
80 with case-table = (standard-case-table)
81 do (put-case-table-pair upper lower case-table))
43 82
44 ((macro 83 ;; Everything Latin-1 and above should be displayed as its character value
45 . (lambda (&rest pairs) 84 ;; by default.
46 (let ((downcase (make-string 256 0)) 85 (setq-default ctl-arrow #xA0)
47 (i 0))
48 (while (< i 256)
49 (aset downcase i (if (and (>= i ?A) (<= i ?Z)) (+ i 32) i))
50 (setq i (1+ i)))
51 (while pairs
52 (aset downcase (car (car pairs)) (car (cdr (car pairs))))
53 (setq pairs (cdr pairs)))
54 (cons 'setq
55 (cons 'iso8859/1-case-table
56 (list
57 (list 'quote
58 (list downcase nil nil nil))))))))
59
60 (?\300 ?\340) ; Agrave
61 (?\301 ?\341) ; Aacute
62 (?\302 ?\342) ; Acircumflex
63 (?\303 ?\343) ; Atilde
64 (?\304 ?\344) ; Adiaeresis
65 (?\305 ?\345) ; Aring
66 (?\306 ?\346) ; AE
67 (?\307 ?\347) ; Ccedilla
68 (?\310 ?\350) ; Egrave
69 (?\311 ?\351) ; Eacute
70 (?\312 ?\352) ; Ecircumflex
71 (?\313 ?\353) ; Ediaeresis
72 (?\314 ?\354) ; Igrave
73 (?\315 ?\355) ; Iacute
74 (?\316 ?\356) ; Icircumflex
75 (?\317 ?\357) ; Idiaeresis
76 (?\320 ?\360) ; ETH
77 (?\321 ?\361) ; Ntilde
78 (?\322 ?\362) ; Ograve
79 (?\323 ?\363) ; Oacute
80 (?\324 ?\364) ; Ocircumflex
81 (?\325 ?\365) ; Otilde
82 (?\326 ?\366) ; Odiaeresis
83 (?\330 ?\370) ; Ooblique
84 (?\331 ?\371) ; Ugrave
85 (?\332 ?\372) ; Uacute
86 (?\333 ?\373) ; Ucircumflex
87 (?\334 ?\374) ; Udiaeresis
88 (?\335 ?\375) ; Yacute
89 (?\336 ?\376) ; THORN
90 )
91
92 (set-standard-case-table (mapcar 'copy-sequence iso8859/1-case-table))
93
94 (setq-default ctl-arrow 'iso-8859/1)
95
96 (provide 'iso8859-1)
97 86
98 ;;; iso8859-1.el ends here 87 ;;; iso8859-1.el ends here